---
title: "Assignment 1"
author: "Hanniu Sun & Thomas Haase"
date: last-modified
date-format: long
 
execute:
  warning: false
  echo: false
  error: false  
format: 
  pdf: 
    toc: true
    geometry:
     - top=2cm
     - left=2cm
     - right=2cm
     - bottom=3cm
    fig-pos: 'h'
    fig-cap-location: bottom
    tbl-cap-location: bottom
    include-in-header:
    - text: |
        \usepackage{placeins}

    
bibliography: citations.bib
    
editor_options: 
  chunk_output_type: console
---

------------------------------------------------------------------------

```{r}
#| warning: false
#| echo: false
#| error: false
#| output: false

library(tidyverse) # for easy data-wrangling
library(glue) # nice text outputs
library(knitr) # convert outputs to markdown
library(gt) # nice tables (see https://themockup.blog/static/resources/gt-cookbook.html)
library(modelsummary) # Task 5 summary

#install.packages("harrypotter")
library(harrypotter) # harrypotter themes for ggplot

# read network libraries
library(igraph)    # basic graphlibrary
library(sna)       # useful functions
library(tidygraph) # tidy-style beautiful graphs
library(ggraph)    # tidy-style beautiful graphs

library(tidygraph) # task 6 nice visualization
library(graphlayouts) # more layouts for task 6
library(netrankr)  # more network statistics for task 6
```

\newpage

::: callout-note
## **Dataset**

The chosen data contains information of support between 64 characters in the Harry Potter books, made available by Goele Bossaert and Nadine Meidert. It was downloaded on the [RSiena](https://www.stats.ox.ac.uk/~snijders/siena/) webpage.
:::

# Task 1

> *Write an R-script that reads your data. Transform your data into a format that you will uselater. Argue about the format you have chosen.*

The used data is accessable in the format of adjacency matrices. For each book the directed network of the support of one character for another is represented in the form of an adjacency matrix. Besides the 6 matrices 2 tables with the characternames and some characterattributes (schoolyear, gender, house) are made available.

For this assignment the available data of all books is going to be combined into one dataset. To achieve this the adjacencymatrices are added to create a weighted adjacency matrix of the support that the characters give each other throughout the whole story from book one until book six.

In the article of the dataset support between the characters is defined as emotional support, instrumental help, giving information that will help others and praising each other [@bossaert2013]. Based on this self-connections are nonsensical as they do not represent how characters help each other. Therefore the diagonal is going to be removed.

```{r}
# read network data
hpbook1 <- read.table("data/hpbook1.txt") %>% as.matrix() 
hpbook2 <- read.table("data/hpbook2.txt") %>% as.matrix()  
hpbook3 <- read.table("data/hpbook3.txt") %>% as.matrix() 
hpbook4 <- read.table("data/hpbook4.txt") %>% as.matrix() 
hpbook5 <- read.table("data/hpbook5.txt") %>% as.matrix() 
hpbook6 <- read.table("data/hpbook6.txt") %>% as.matrix() 

# read property data
hpnames <- read.delim("data/hpnames.txt")
hpattributes <- read.delim("data/hpattributes.txt")
```

```{r}
hp_all <- hpbook1 + hpbook2 + hpbook3 + hpbook4 + hpbook5 + hpbook6

graph_all <- graph_from_adjacency_matrix(hp_all, diag = F, weighted=T)
```

```{r}
# Match the format of the 
V(graph_all)$name <- gsub("V", "", V(graph_all)$name) %>% as.numeric()

# Add attributes to the graph object
V(graph_all)$character_names <- hpnames[match(V(graph_all)$name, hpnames$id),]$name
V(graph_all)$schoolyear <- hpattributes[match(V(graph_all)$name, hpattributes$id),]$schoolyear
V(graph_all)$gender     <- hpattributes[match(V(graph_all)$name, hpattributes$id),]$gender
V(graph_all)$house      <- hpattributes[match(V(graph_all)$name, hpattributes$id),]$house

# Inspect
#graph_all

#V(graph_all)$schoolyear %>% table() %>% barplot(main="Barplot of schoolyears")
#V(graph_all)$house %>% table() %>% barplot(main="Barplot of houses", sub="Gryffindor very overrepresented")
```

\newpage
\FloatBarrier

# Task 2

> *Justify what you do with isolates and multiple components if there are any.*

An isolate is a node that is not connected to other components. A component is a connected subgraph that is not part of any other connected subgraph. A component is weakly connected if nodes are reachable without taking the direction of edges into account. In contrast a strongly connected component is reachable even when taking the direction of edges into account.

```{r}
# isolated vertices
cat(glue("The graph contains {sum(igraph::degree(graph_all)==0)} isolated vertices."))

# components
components_w <- igraph::components(graph_all, mode = "weak" )
components_s <- igraph::components(graph_all, mode = "strong" )


tibble::tribble(
     ~"Statistic",  ~"Weakly Connected",                                 ~"Strongly Connected", 
     "N components",         components_w$no - sum(igraph::degree(graph_all)==0), components_s$no - sum(igraph::degree(graph_all)==0),
     "Min. size", min(components_w$csize[components_w$csize > 1]),     min(components_s$csize[components_s$csize > 1]),
     "Mean size", mean(components_w$csize[components_w$csize > 1]),    mean(components_s$csize[components_s$csize > 1]),
     "Max. size", max(components_w$csize[components_w$csize > 1]),     max(components_s$csize[components_s$csize > 1])
     )  %>%
     gt::gt() %>% 
     tab_header(title = "Component Summarystatistics",
                subtitle = "Without Isolates") %>% 
     fmt_number(decimals = 0) %>% 
     fmt_number(rows = 3, decimals = 2) 
```

The high number of isolated vertices distorts the summarystatistics as most of them seem to consists of only a singular node. Therefore they have been filtered out for the calculation of the summarystatistics. We do not delete them from the graph because it is valuable for interpreting to keep the high number of isolated characters in mind.

The weakly connected portion of the network contains 2 components. Within these components, the size varies considerably, with the smallest component having 5 characters and the largest having 32 characters. The strongly connected portion contains 7 components. These components tend to be smaller, with sizes ranging from 2 to 26 characters, and an average size of 11 characters per component. The support structure of Harry Potter therefore consists of several tightly-knit groups (the strongly connected components) and a couple of larger, more loosely connected groups (the weakly connected components). The strongly connected components likely represent close-knit groups of characters who consistently support each other, while the weakly connected components might represent broader social circles with less consistent mutual support.

\newpage
\FloatBarrier

# Task 3

> *Report and interpret the density of your network. Create a table that contains further descriptive network statistics. Please include average degree (in-degree and out-degree if both are relevant), standard deviation of degree (in-degrees and out-degrees), reciprocity, and transitivity.*

```{r}
#| include: false

#density
density_percentage<-igraph::edge_density(graph_all)*100
cat(glue("The density percentage of the network is {density_percentage}%,illustrating that the number of edges that actually exist in the network accounts for 15% of the maximum possible number of edges."))

#in&out degree
aind <-  mean(igraph::degree(graph_all, mode = "in"))
aoutd <- mean(igraph::degree(graph_all,mode = "out"))
sd_aind<- sd(igraph::degree(graph_all, mode='out'))
sd_aoutd<- sd(igraph::degree(graph_all, mode='in'))

#reciprocity&transitivity
rec <- igraph::reciprocity(graph_all)
tran<-igraph::transitivity(graph_all)

#integrated table
integrated<-rbind(aind,aoutd,sd_aind,sd_aoutd,rec,tran)
result_table <- data.frame(
  parameters = c("average_in_degree", "average_out_degree", "reciprocity", "transtivity","standard deviation of in-degree","standard deviation of out_degree"),
  value = c(aind, aoutd, rec, tran, sd_aind, sd_aoutd)
)|>
  as.tibble()|>
  gt::gt() |> 
  tab_header(title = "Density Summarystatistics")

```

```{r}
# calculate density
density <- igraph::edge_density(graph_all) %>% # use igraph
     round(2) %>%  # round for readability
     as.character() # because of formatting from in/out degree the whole Table Column needs to be character variables

# calculate indegree int he format: "average ± standard deviation"
indegree <- str_c(
     graph_all %>% # calculate average indegree
          igraph::degree(mode = "in") %>% 
          mean() %>% 
          round(1),
     " ± ", # ... plus-minus the ...
     graph_all %>% # ...standard deviation of indegree
          igraph::degree(mode = "in") %>% 
          sd() %>% 
          round(1)
     )

# calculate out-degree
outdegree <- str_c(
     graph_all %>% 
          igraph::degree(mode = "out") %>% 
          mean() %>% 
          round(1),
     " ± ",
     graph_all %>% 
          igraph::degree(mode = "out") %>% 
          sd() %>% 
          round(1)
     )
     
# calculate reciprocity
reciprocity <- igraph::reciprocity(graph_all) %>% 
     round(2) %>% 
     as.character()

# calculate transitivity
transitivity <- igraph::transitivity(graph_all) %>% 
     round(2) %>% 
     as.character()

# print a nice summary-table
tibble::tribble(
     ~"Parameter",   ~"Value (AVG ± SD)", 
     "Density",      density,
     "In-Degree",    indegree,
     "Out-Degree",   outdegree,
     "Reciprocity",  reciprocity,
     "Transitivity", transitivity
     )  %>%
     gt::gt() %>% 
     tab_header(title = "Density Summarystatistics") 
```

Network density is defined as the proportion of actually observed ties among the potentially observable ones. The observed density of \~`{r} as.numeric(density)*100`% indicates a sparsely connected network. Support therefore seems to be really selecive in the Harry Potter universe. An explanation is the high amount of isolate nodes which are probably the main reason for the low observed density.

The average in- and out-degree are the same because for every character who gives support another character needs to be the receiving support, otherwise no support could have been given in the first place. The higher in-degree standard deviation shows a higher spread in the distribution of support characters are receiving. There are some characters receiving no support and some who receive support from many characters. The standard deviation of out-degree is a bit lower than the standard deviation of in-degrees, indicating underlining that more characters give similar amount of support while some characters receives more support than others.

Reciprocity is defined as the proportion of actually reciprocated ties among the potentially reciprocable ones. The reciprocity value of `{r} reciprocity` indicates that support is usually mutual in the Harry Potter universe, suggesting strong bonds between connected characters. This makes sense because the focus of the books lies on a view main characters, on whose interaction all 6 books are focusing.

The transitivity is the proportion of actually observed transitively closed triples of nodes among the count of all potentially closed triples in the network. It shows how likely a character B who gets support by character A is willing to support a supporter of character A. The chance of this happening is \~`{r} as.numeric(transitivity)*100`%.

These metrics paint a picture of a network where support relationships, while selective, tend to be strong and mutual when they do exist, with a moderate clustering among connected characters. This aligns well with the narrative structure of Harry Potter, where distinct groups of a few main and secondary characters forming strong, reciprocal support systems.

\newpage
\FloatBarrier

# Task 4

> *Create a graph of the degree (out-degree and in-degree if they are relevant) distributions in your network. What do you observe? What do you imply from the observed degree distributions?*

```{r}
#| fig.align: center
#| layout-ncol: 2
#| layout-nrow: 2
#| height: 0.8

# plot Out-Degree Distribution including Isolates
graph_all %>% 
     igraph::degree(mode="out") %>%
     as.tibble() %>%  
  ggplot(aes(x = value)) +
     geom_bar(fill = "#006F91") +
     labs(title = "Out-Degree Distribution",
          subtitle = "Including Isolates",
          x = "Out-Degree",
          y = "Count") +
     scale_x_continuous(limits = c(-1,30), breaks = seq(0,30,5))+
     scale_y_continuous(limits = c(0,31)) +
     theme_minimal()

# plot In-Degree Distribution Including Isolates
graph_all %>% 
     igraph::degree(mode="in") %>%
     as.tibble() %>%  
  ggplot(aes(x = value)) +
     geom_bar(fill = "#006F91") +
     labs(title = "In-Degree Distribution",
          subtitle = "Including Isolates",
          x = "In-Degree",
          y = "") +
     scale_x_continuous(limits = c(-1,30), breaks = seq(0,30,5)) +
     scale_y_continuous(limits = c(0,31)) +
     theme_minimal()

# plot outdegree distribution without isolates
graph_all %>% 
     igraph::degree(mode="out") %>%
     as.tibble() %>%  
     filter(value != 0) %>% 
  ggplot(aes(x = value)) +
     geom_bar(fill = "#006F91") +
     labs(title = "Out-Degree Distribution",
          subtitle = "Without Isolates",
          x = "In-Degree",
          y = "Count") +
     scale_x_continuous(limits = c(0,30), breaks = c(1,seq(5,30,5))) +
     scale_y_continuous(limits = c(0,6)) +
     theme_minimal()

# plot indegree distribution without isolates
graph_all %>% 
     igraph::degree(mode="in") %>%
     as.tibble() %>%  
     filter(value != 0) %>% 
  ggplot(aes(x = value)) +
     geom_bar(fill = "#006F91") +
     labs(title = "In-Degree Distribution",
          subtitle = "Without Isolates",
          x = "In-Degree",
          y = "") +
     scale_x_continuous(limits = c(0,30), breaks = c(1,seq(5,30,5))) +
     scale_y_continuous(limits = c(0,6)) +
     theme_minimal()
```

Degree distribution is defined as the probability distribution of degrees across all nodes in the network. The high count of nodes with degree 1 in the upper plot are an artifact of the high amount of isolates in the network. Therefore the lower plots are being created. There are 3 different groups visible in the Out-degree distribution. Group one consists of characters supporting less than 5 persons, Group two consists of characters supporting between 5 and 10 characters while three characters support more than 10 characters. The In-degree distribution looks more even. There are almost all the time 4 charaacters who get support from 1-10 characters. Outliers are also visible here, especially one extreme one that gets support from over 25 characters.

In conclusion the network seems to have a core group of mutually supporting characters where a few characters (likely the main protagonists) serve as major support hubs. Many peripheral characters exist who have minimal involvement in the support network (filtered isolates and high amount of vaguely connected characters).



\newpage
\FloatBarrier

# Task 5

> *Create a formatted table that contains descriptive information for node level variables.*

```{r}
#| fig.align: center
#| layout-ncol: 2

# ---- add node level variables to nodes ----

# add characternames
hpattributes$name <- hpnames$name

# add degrees
hpattributes$Indegree <- igraph::degree(graph_all, mode="in")
hpattributes$Outdegree <- igraph::degree(graph_all, mode="out")
hpattributes$totaldegree <- igraph::degree(graph_all, mode="all")


# add weighted, normalized Betweennesscentrality 
hpattributes$Betweenness <- igraph::betweenness(graph_all, 
                                                directed = TRUE,  
                                                weights = E(graph_all)$weight,  
                                                normalized = T) %>% 
                              round(3)

# add eigenvectorcentrality
hpattributes$Eigenvector <- eigen_centrality(
  graph_all,
  directed = TRUE,
  scale = TRUE,
  weights = E(graph_all)$weight,
  options = arpack_defaults
)$vector %>% 
  round(3)

# add Betweenness, Eigenvectorcentrality,indegree, outdegree
node_level_variables <- hpattributes %>%
  filter(totaldegree != 0) %>% # filter isolates out
  select(-id, -totaldegree, -name) %>% #remove unnecessary variables
  rename(Schoolyear = schoolyear,  #rename variables
         Gender = gender,
         House = house) %>%
  mutate(Gender = ifelse(Gender == 1,"Male",Gender), #recode category-variables
         Gender = ifelse(Gender == 2,"Female",Gender),
         Gender = fct_infreq(Gender),
         House = ifelse(House == 1,"Gryffindor",House),
         House = ifelse(House == 2,"Hufflepuff",House),
         House = ifelse(House == 3,"Ravenclaw", House),
         House = ifelse(House == 4,"Slytherin",House),
         House = fct_infreq(House))


# ---- create summarystatistics ----

datasummary(Indegree + Outdegree + Eigenvector + Betweenness ~ Mean + Median + SD,
            data = node_level_variables,
            output = "latex",
            fmt = 2,
            title = "Descriptive Statistics of metric Harry Potter Character Variables",
            notes = c("Centralitymeasures are normalized","Isolates removed")
          )

datasummary(Gender + House ~ N + Percent(),
            data = node_level_variables,
            output = "latex",
            fmt = 0,
            title = "Descriptive Statistics of nominal Harry Potter Character Variables",
            notes = c("Isolates removed")
          ) 
```

Table 1 presents key network metrics that describe how characters support one another. The indegree and outdegree measures both average 5.43, but show substantial variation with standard deviations of 4.95 and 4.18 respectively. This indicates that while characters typically have around 5-6 supportive connections, there is considerable spread - some characters may have very few connections while others maintain extensive support networks. 

The eigenvectorcentrality weights the degree measures with the degree measures of the directly connected nodes. The eigenvector centrality measures show a mean of 0.20 with a standard deviation of 0.27. The standard deviation being larger than the mean indicates significant variation in characters' influence within the network, suggesting the presence of both highly central figures and more peripheral characters. 

Betweennesscentrality measures brokerage by the sum of fractions of shortest paths between any 2 nodes that pass through a given node. The betweenness centrality in the network displays a very low mean of 0.01 with a small standard deviation of 0.02, indicating that across the network, very few characters serve as crucial bridges between different groups - most support relationships appear to be direct rather than requiring intermediaries.

Table 2 provides demographic information about the character network. The gender distribution is relatively balanced, with 59% male and 41% female characters (keep in mind that the isolates are removed for these statistics!). Regarding house affiliations, Gryffindor represents the largest group at 57% of characters, which aligns with the books' narrative focus. The remaining houses - Hufflepuff (16%), Ravenclaw (14%), and Slytherin (14%) - have roughly equal representation in the support network.

The following plots shed light on demographic information including isolates.
\FloatBarrier

```{r}
#| fig.align: center
#| layout-ncol: 2
#| fig-width: 4
#| fig-height: 3

# Check who belongs to which house
# cbind(vertex.attributes(graph_all)$house,vertex.attributes(graph_all)$character_name) %>%  tibble() %>%  view()

# Check gender
#cbind(vertex.attributes(graph_all)$gender,vertex.attributes(graph_all)$character_name) %>%  tibble() %>%  view()


# Barplot for Houses
vertex.attributes(graph_all)$house %>% 
    as.tibble() %>%
    rename(House = value) %>%
    mutate(House = ifelse(House == 1,"Gryffindor",House),
           House = ifelse(House == 2,"Hufflepuff",House),
           House = ifelse(House == 3,"Ravenclaw", House),
           House = ifelse(House == 4,"Slytherin",House),
           House = fct_infreq(House)) %>% 
  ggplot(aes(x = House, fill = House)) +
    geom_bar() +
    labs(title = "Count of Characters per House",
          y = "Count of Characters",
          x = "") +
    scale_fill_manual(values = c("Gryffindor" = "#B83A3A", 
                                 "Hufflepuff" = "#FFD84D", 
                                 "Ravenclaw" = "#3A4F8C",  
                                 "Slytherin" = "#4F8C6A")) +
     scale_y_continuous(breaks = seq(0,35,5)) +
     theme_minimal() +
     theme(panel.grid.minor.x = element_blank(),
           panel.grid.minor.y = element_blank(),
           legend.position = "none")


# Barplot for Gender
vertex.attributes(graph_all)$gender %>% 
    as.tibble() %>%
    rename(Gender = value) %>%
    mutate(Gender = ifelse(Gender == 1,"Male",Gender),
           Gender = ifelse(Gender == 2,"Female",Gender),
           Gender = fct_infreq(Gender)) %>% 
  ggplot(aes(x = Gender, fill = Gender)) +
    geom_bar() +
    labs(title = "Count of Characters per Gender",
          y = "",
          x = "") +
    scale_fill_manual(values = c("Male" = "lightblue", 
                                 "Female" = "pink")) +
     scale_y_continuous(breaks = seq(0,50,5)) +
     theme_minimal() +
     theme(panel.grid.minor.x = element_blank(),
           panel.grid.minor.y = element_blank(),
           legend.position = "none")
```

```{r}
#| fig.align: center
#| fig-width: 7
#| fig-height: 3


# Barplot for schoolyears
vertex.attributes(graph_all)$schoolyear %>% 
    as.tibble() %>%
    rename(Schoolyear = value) %>% 
  ggplot(aes(x = Schoolyear)) +
    geom_bar(fill = "#006F91") +
    labs(title = "Count of Characters per School Year at Hogwarts",
          y = "Count of Characters",
          x = "") +
     scale_x_continuous(limits = c(min(vertex.attributes(graph_all)$schoolyear)-1,max(vertex.attributes(graph_all)$schoolyear)+1), breaks = seq(min(vertex.attributes(graph_all)$schoolyear),max(vertex.attributes(graph_all)$schoolyear),1)) +
     scale_y_continuous(breaks = seq(0,35,5)) +
     theme_minimal() +
     theme(panel.grid.minor.x = element_blank(),
           panel.grid.minor.y = element_blank())
```





\FloatBarrier
\newpage
# Task 6

> *Taking into consideration network size, select a form of visualization that could be meaningful. Visualize your network and color the nodes according to a selected actorvariable or according to a selected measure of centrality.*


```{r}
#| fig.align: center
#| fig-width: 10
#| fig-height: 5


# ---- create plot of characters by measure of centrality ----

graph_all %>% 
  # igraph as tidygraph
  as_tbl_graph() %>% 
  # activate nodes for nodemanipulation
  activate("nodes") %>% 
  # add centralitymeasures
  mutate(eigenvector = eigen_centrality(graph_all,
                                   directed = TRUE,
                                   scale = TRUE,
                                   weights = E(graph_all)$weight)$vector,
         betweenness = igraph::betweenness(graph_all,
                                           directed = TRUE,
                                           weights = E(graph_all)$weight,
                                           normalized = T),
        degree = igraph::degree(graph_all, mode="all")) %>% 
  # remove isolates
  filter(degree > 0) %>% 
  # clean nominal scale variables
  rename(Schoolyear = schoolyear,  
         Gender = gender,
         House = house,
) %>%
  mutate(Gender = ifelse(Gender == 1,"Male",Gender), 
         Gender = ifelse(Gender == 2,"Female",Gender),
         Gender = fct_infreq(Gender),
         House = ifelse(House == 1,"Gryffindor",House),
         House = ifelse(House == 2,"Hufflepuff",House),
         House = ifelse(House == 3,"Ravenclaw", House),
         House = ifelse(House == 4,"Slytherin",House),
         House = fct_infreq(House),
         `Total Degree` = degree,
         Betweenness = betweenness,
         Eigenvectorcentrality = eigenvector) %>% 
  # start plot
ggraph("stress") + 
  geom_edge_link0(edge_color = "darkgray", 
                  #arrow = arrow(type = "closed", length = unit(0.15, "inches"))
                  ) +
  geom_node_point(aes(size=Betweenness,
                      fill=Eigenvectorcentrality),
                  shape = 21) +
  geom_node_text(aes(label = character_names),
                 nudge_x = -0.4, nudge_y = 0.1,
                 size = 3) +
  scale_fill_hp(discrete = F, option = "gryffindor") +
  scale_size(range = c(3,12)) +
  theme_void() +
  labs(
    title = "Support of Harry Potter Characters for each other",
    subtitle = "By Measures of Centrality",
    caption = "Isolates removed"
  ) +
  theme(plot.title = element_text(face = "bold", size = 16),
        plot.subtitle = element_text(size = 15),
        legend.position = "right",
        legend.text = element_text(size = 10),
        legend.title = element_text(size = 11, face = "bold"))

```

---

```{r}
#| fig.align: center
#| fig-width: 8
#| fig-height: 4

graph_all %>% 
  # igraph as tidygraph
  as_tbl_graph() %>% 
  # activate nodes for nodemanipulation
  activate("nodes") %>% 
  # add centralitymeasures
  mutate(eigenvector = eigen_centrality(graph_all,
                                   directed = TRUE,
                                   scale = TRUE,
                                   weights = E(graph_all)$weight)$vector,
         betweenness = igraph::betweenness(graph_all,
                                           directed = TRUE,
                                           weights = E(graph_all)$weight,
                                           normalized = T),
        degree = igraph::degree(graph_all, mode="all")) %>% 
  # remove isolates
  filter(degree > 0) %>% 
  # clean nominal scale variables
  rename(Schoolyear = schoolyear,  
         Gender = gender,
         House = house,
) %>%
  mutate(Gender = ifelse(Gender == 1,"Male",Gender), 
         Gender = ifelse(Gender == 2,"Female",Gender),
         Gender = fct_infreq(Gender),
         House = ifelse(House == 1,"Gryffindor",House),
         House = ifelse(House == 2,"Hufflepuff",House),
         House = ifelse(House == 3,"Ravenclaw", House),
         House = ifelse(House == 4,"Slytherin",House),
         House = fct_infreq(House),
         `Total Degree` = degree,
         Betweenness = betweenness,
         Eigenvectorcentrality = eigenvector) %>% 
  # start plot
ggraph("fr") + 
  geom_edge_link0(aes(edge_colour = weight, width = weight), show.legend = FALSE) +
  scale_edge_width(range = c(0.1, 2)) +
  scale_edge_colour_gradient(low = "#999999", high = "#222222") +
  geom_node_point(aes(fill=House),
                  shape = 21,
                  size = 4) +
  geom_node_text(aes(label = character_names),
                 nudge_x = -0.4, nudge_y = 0.1,
                 size = 2) +
  scale_fill_manual(values = c("Gryffindor" = "#B83A3A", 
                          "Hufflepuff" = "#FFD84D",
                          "Ravenclaw" = "#3A4F8C",
                          "Slytherin" = "#1A472A")) +
  scale_size(range = c(3,12)) +
  theme_void() +
  labs(
    title = "Support of Harry Potter Characters for each other",
    subtitle = "By Houses, Edges colored by Weight",
    caption = "Isolates removed"
  ) +
  theme(plot.title = element_text(face = "bold", size = 14),
        plot.subtitle = element_text(size = 13),
        legend.position = "right",
        legend.text = element_text(size = 9),
        legend.title = element_text(size = 10, face = "bold"))
```

---

```{r}
#| include: false
#| fig.align: center
#| fig-width: 8
#| fig-height: 4

plot.igraph(graph_all,
            #label
            vertex.label.font=5,
            vertex.label.cex=0.5,
            vertex.label.color="black",
            vertex.label=V(graph_all)$schoolyear,
            #vertex
            vertex.size=10,
            vertex.color=ifelse(V(graph_all)$gender == 2,'#32CD32','orange'),# 2 means Female
            vertex.shape=ifelse(V(graph_all)$house == 1, "circle",
                         ifelse(V(graph_all)$house == 2, "csquare",
                         ifelse(V(graph_all)$house == 3, "rectangle", "sphere"))),
            vertex.frame.color = "white",
            #edge
            edge.color='lightcoral',edge.arrow.size=.2,
            layout=layout_with_graphopt(graph_all, spring.length = 100),
            edge.lty="dashed",
            edge.curved=0,
            main="Friendship network with attribute of gender \ngreen: female, orange: male\nhouse1:circle, house2：csquare\nhouse3:rectangle, house4:sphere")
```


\newpage
\FloatBarrier
# Task 7

> *Check assortativity in the network by a chosen measure of degree centrality. What do you observe? Provide an interpretation of your findings. What kind of theoretical arguments could possibly explain your results?*


```{r}
cc <- sna::closeness(as.matrix(as_adjacency_matrix(graph_all)), cmode="suminvundir")
bc <- igraph::betweenness(graph_all, directed = TRUE,  weights = NULL,  normalized = TRUE)
pr <- igraph::page_rank(graph_all, damping = 0.9, algo = "arpack")$vector

top_cc <- order(cc, decreasing = TRUE)[1:3]
`Top Closeness Centrality` <- V(graph_all)$character_names[top_cc]

top_bc <- order(bc, decreasing = TRUE)[1:3]
`Top Betweenness Centrality` <- V(graph_all)$character_names[top_bc]

top_pr <- order(pr, decreasing = TRUE)[1:3]
`Top Pagerank` <- V(graph_all)$character_names[top_pr]

tibble(`Top Closeness Centrality`,`Top Betweenness Centrality`,`Top Pagerank`)|>
  gt::gt()|>
  tab_header(title = '"Biggest man on Campus" based on different criterias')
```

```{r}
#Calculating assortativity
hpattributes<-hpattributes|>
  mutate(pagerankscore=pr)
V(graph_all)$pagerankscore<-hpattributes[match(V(graph_all)$name,hpattributes$id),]$pagerankscore

#pagerank
Pagerank <- assortativity(graph_all,V(graph_all)$pagerankscore)
#degree
Degree <- assortativity_degree(graph_all)
#gender
Gender <- assortativity_nominal(graph_all,V(graph_all)$gender)
#house
House <- assortativity(graph_all,V(graph_all)$house)
#schoolyear
Schoolyear <- assortativity(graph_all,V(graph_all)$schoolyear)

tibble(Degree,Pagerank,Gender,House,Schoolyear)|>
  gt::gt()|>
  tab_header(title = "Assortativity")|>
  fmt_number(
    columns = everything(),  
    decimals = 3 
  )
```

Closeness Centrality is a metric in network analysis used to measure the average distance between a node and all other nodes, it reflects the efficiency with which the node can transmit information or influence others across the entire network. In this case, we can see from the table that only less than 5 nodes have high closeness centrality, a major part of the nodes barely have the closeness centrality, indicating that these characters are far from the main stream of the Harry Potter novel, they do not even have connections to Harry Potter.

Betweenness Centrality is a metric in network analysis that measures the importance of a node as a bridge or intermediary, reflecting how many pairs of nodes have shortest paths passing through it. If a node lies on the shortest paths between many pairs of nodes, its betweenness centrality significantly increases. And from my perspectives, betweenness centrality describes nodes as a metro stations, highly valued stations can be regarded as the central stations or popular transfer stations. As the histogram shows, approximately 90 percent nodes fall on the value 0, which means absolutely disconnected with other. There are several observations fall on the right side, they might act like hubs in this social network.

The core idea of PageRank is: A node's importance depends not only on how many other nodes link to it but also on the importance of those linking nodes themselves. It assumes weak connectivity between disconnected components, thereby addressing inconsistent ranking metrics in non-fully connected networks.the histogram shows that a few core nodes dominate the network.

We list top 3 nodes of each centrality calculation, it seems that Harry James Potter and Hermione Granger are the most important nodes in this network.

Assortativity is a measure of how similar nodes in a network are to their neighbors based on some attribute. It tells us whether similar nodes tend to connect with each other or not. Here we calculated 5 kinds of assortativity: 1.degree 2.pagerank 3.gender 4.house 5.schoolyear. The result illustrates that: 1.characters are not likely to team up according to the degree, pagerank and gender attribute,we can say that there is no gender segregation within the network. 2.assortativity based on house is the highest among 5 assortativities, 0.709, which is approching 1, indicating that characters are prone to group up due to the house factors, people intend to have connection with people from same house. 3.assortativity based on schoolyear factor is 0.329, denoting that people have a tendency of teaming up with people who are in the same schoolyear, but the tendency is not as significant as the house one, however, stronger that degree and pagerank and gender.

\FloatBarrier
# Task 8

> *And finally, a thought exercise. Assume that the robustness or vulnerability of the network is examined. Try to come up with a measurement of robustness / vulnerability and argue for the usefulness of your measure. Speculate about some implications for the concrete network.*

```{r}
#| fig.align: center
#| layout-ncol: 2

# ---- Containing Isolates ----
lcc <- function(graph) {
  components <- igraph::components(graph)
  max(components$csize)
}


n_simulations <- 10000
lcc_ratios <- numeric(n_simulations)

for (i in 1:n_simulations) {
  random_node <- sample(1:igraph::vcount(graph_all), 1)
  graph_copy <- igraph::delete_vertices(graph_all, random_node)
  #calculate pre-removal lcc 
  lcc_ratios[i] <- lcc(graph_copy) / lcc(graph_all)  
}

lcc_ratios %>% table() %>% barplot(main="LCC Ratios of Harry Potter Support Network\n\nWith Isolates",
                                    sub = "10000 Simulations of Node Deletion")

# calculate probability
#threshold <- 0.90
#prob_unstable <- mean(lcc_ratios < threshold)  # comparison
#cat("Probability of significant stability loss is", prob_unstable, "\n")






# ---- Without Isolates ----
#create new graph without isolates
isolates <- which(igraph::degree(graph_all)==0)
graph_8 = igraph::delete_vertices(graph_all, isolates)


n_simulations <- 10000
lcc_ratios_iso <- numeric(n_simulations)

for (i in 1:n_simulations) {
  random_node <- sample(1:igraph::vcount(graph_8), 1)
  graph_copy <- igraph::delete_vertices(graph_8, random_node)
  #calculate pre-removal lcc 
  lcc_ratios_iso[i] <- lcc(graph_copy) / lcc(graph_8)  
}

lcc_ratios_iso %>% table() %>% barplot(main="LCC Ratios of Harry Potter Support Network\n\nWithout Isolates",
                                    sub = "10000 Simulations of Node Deletion")

```

In this part we evaluate the robustness of Harry Potter network with the method of simulating the random removal of nodes. After a random node is removed we calculate the sizte of the largest connected component. To get a ratio of change we divide this size by the largest connected component of the graph with the removed node by the size of the largest connected component of the original graph. This procedure is repeated 10000 times. The calculated ratio is a measure of grpah stability. In terms of the Harry Potter support network: How much does the size of the biggest component change after removing one character from the network?  

The shown diagrams present the count of ratios calculated by the simulation. In both diagrams (with and without Isolates), the most frequent ratio is around 0.97, showing that when most characters are removed, the network maintains about 97% of its original largest connected component size. This suggests the network is highly robust. In both simulations very few node removals resulted in ratios of 0.81 or 0.94, indicating that it's rare for character removals to significantly fragment the network. We theorize that in these cases one of the few main-characters was removed from the network. After removing the isolates a big drop in the ratio 1 is visible because the removal of a isolate does not change the size of the biggest component. A small amount of ratio 1 remains, because of the second component of opponents of the main characters also does not change the size of the main component.

In conclusion the supportstructure of Characters in Harry Potter is very stable and only would take significant damage in case of the removal of a main character. 


\newpage

# Bibliography
