Professor Aven



1 R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.

This R markdown script will help you analyze and visualize the social networks (Trust, Advice, and Communication) for your MBA class.

In the class networks (communication, trust, and advice) what are your centrality measures and how do they compare to those of your classmates (i.e., where are you in the distribution?). Please refer both from both tables and network graph.

#Install the following packages prior to running the code
package.names <- c(
  "tidyverse",   
  "igraph",
  "qgraph",
  "knitr",
  "DT", 
  "visNetwork", 
  "ggplot2", 
  "gridExtra", 
  "RColorBrewer",
  "rstudioapi"
  
)

check.packages <- function(package.names) {
  for (package in package.names) {
    if (!require(package, character.only = TRUE)) {
      install.packages(package)
    }
    library(package, character.only = TRUE)
  }
}

# Load packages
check.packages(package.names)

2 Take a look at our section level network data.

2.1 Network Size

# Create a data frame to store section sizes
section_sizes <- data.frame(
  Section = c("A", "B", "C"),
  Trust  = c(vcount(trust_graph_A), vcount(trust_graph_B), vcount(trust_graph_C)),
  Advice = c(vcount(advice_graph_A), vcount(advice_graph_B), vcount(advice_graph_C)),
  Communication = c(vcount(comm_graph_A), vcount(comm_graph_B), vcount(comm_graph_C))
)

# Display table
kable(section_sizes, caption = "Network Size by Section", align = "c")
Network Size by Section
Section Trust Advice Communication
A 39 39 39
B 49 49 49
C 55 55 55

2.2 Density

Density refers to proportion of possible ties that actually realized in the network. It is calculated by dividing the number of observed connections in the network by the total number of possible connections. A high edge density indicates that many connections exist among nodes in the network, while a low edge density indicates that there are relatively few connections. In networks with high edge density, information and resources are more likely to flow freely among nodes, On the other hand, networks with low edge density may be more fragmented or concentrated.

# Create a data frame to store section densities
section_densities <- data.frame(
  Section = c("A", "B", "C"),
  Trust = c(edge_density(trust_graph_A, loops = FALSE), 
                    edge_density(trust_graph_B, loops = FALSE), 
                    edge_density(trust_graph_C, loops = FALSE)),
  Advice = c(edge_density(advice_graph_A, loops = FALSE), 
                     edge_density(advice_graph_B, loops = FALSE), 
                     edge_density(advice_graph_C, loops = FALSE)),
  Communication = c(edge_density(comm_graph_A, loops = FALSE), 
                            edge_density(comm_graph_B, loops = FALSE), 
                            edge_density(comm_graph_C, loops = FALSE))
)

# Display table
kable(section_densities, caption = "Network Density by Section", align = "c", digits = 3)
Network Density by Section
Section Trust Advice Communication
A 0.139 0.142 0.570
B 0.174 0.108 0.504
C 0.114 0.089 0.427 
# Create a bar plot to visualize densities
section_densities_long <- pivot_longer(section_densities, cols = -Section, 
                                      names_to = "Network_Type", 
                                      values_to = "Density")

ggplot(section_densities_long, aes(x = Section, y = Density, fill = Network_Type)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Network Density Comparison by Section",
       x = "Section", y = "Density") +
  theme_minimal() +
  scale_fill_brewer(palette = "Set2", name = "Network Type",
                    labels = c("Advice", "Communication", "Trust"))

2.3 Diameter

Diameter refers to the maximum shortest path length between any two nodes in the network. It is a measure of the longest distance between any two nodes in the network.

# Create a data frame to store section diameters
section_diameter <- data.frame(
  Section = c("A", "B", "C"),
  Trust = c(diameter(trust_graph_A, directed = TRUE), 
                     diameter(trust_graph_B, directed = TRUE), 
                     diameter(trust_graph_C, directed = TRUE)),
  Advice = c(diameter(advice_graph_A, directed = TRUE), 
                      diameter(advice_graph_B, directed = TRUE), 
                      diameter(advice_graph_C, directed = TRUE)),
  Communication = c(diameter(comm_graph_A, directed = FALSE), 
                             diameter(comm_graph_B, directed = FALSE), 
                             diameter(comm_graph_C, directed = FALSE))
)

# Display table
kable(section_diameter, caption = "Network Diameter by Section", align = "c")
Network Diameter by Section
Section Trust Advice Communication
A 15 7 6
B 12 6 5
C 14 7 6 
# Create a bar plot to visualize diameters
section_diameter_long <- pivot_longer(section_diameter, cols = -Section, 
                                     names_to = "Network_Type", 
                                     values_to = "Diameter")

ggplot(section_diameter_long, aes(x = Section, y = Diameter, fill = Network_Type)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Network Diameter Comparison by Section",
       x = "Section", y = "Diameter") +
  theme_minimal() +
  scale_fill_brewer(palette = "Set2", name = "Network Type",
                    labels = c("Advice", "Communication", "Trust"))

2.4 Average Path Length

Average path length is calculated as the average of all shortest path lengths between any two nodes in the network. Both diameter and average path length provides information on the overall efficiency and connectivity of the network.A small average path length indicates that nodes in the network are closely connected and can easily communicate and share information with one another.

trust_apl_a <- mean_distance(trust_graph_A, directed = TRUE)
trust_apl_b <- mean_distance(trust_graph_B, directed = TRUE)
trust_apl_c <- mean_distance(trust_graph_C, directed = TRUE)

# Advice networks
advice_apl_a <- mean_distance(advice_graph_A, directed = TRUE)
advice_apl_b <- mean_distance(advice_graph_B, directed = TRUE)
advice_apl_c <- mean_distance(advice_graph_C, directed = TRUE)

# Communication networks
comm_apl_a <- mean_distance(comm_graph_A, directed = FALSE)
comm_apl_b <- mean_distance(comm_graph_B, directed = FALSE)
comm_apl_c <- mean_distance(comm_graph_C, directed = FALSE)

# Create a data frame for visualization
apl_df <- data.frame(
  Section = rep(c("A", "B", "C"), 3),
  Network = rep(c("Trust", "Advice", "Communication"), each = 3),
  APL = c(trust_apl_a, trust_apl_b, trust_apl_c,
         advice_apl_a, advice_apl_b, advice_apl_c,
         comm_apl_a, comm_apl_b, comm_apl_c)
)

# Create a table of average path lengths
apl_table <- apl_df %>%
  pivot_wider(names_from = Section, values_from = APL) %>%
  mutate(across(where(is.numeric), ~round(., 3)))

# Display the table
kable(apl_table, caption = "Average Path Length Comparison Across Sections")
Average Path Length Comparison Across Sections
Network A B C
Trust 5.407 4.494 6.015
Advice 2.408 2.712 2.869
Communication 2.870 2.602 3.271 
# Create a visualization of average path length by section and network
ggplot(apl_df, aes(x = Section, y = APL, fill = Network)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Average Path Length Comparison Across Sections",
       x = "Section", 
       y = "Average Path Length") +
  theme_minimal() +
  scale_fill_brewer(palette = "Set2", name = "Network Type",
                    labels = c("Advice", "Communication", "Trust"))

3 Network Centrality Statistics for each Section

3.1 Degree centrality

Degree centrality measures the number of ties an node has in a UNDIRECTED network . In-degree centrality measures the number of incoming ties an node has in a DIRECTED network.Out-degree centrality measures the number of outgoing ties an individual has in a DIRECTED network.

Trust In-Degree Summary by Section
Section Mean Median Min Max
A 0.139 0.079 0 0.842
B 0.174 0.083 0 1.021
C 0.114 0.037 0 1.019
Advice In-Degree Summary by Section
Section Mean Median Min Max
A 0.142 0.132 0.000 0.342
B 0.108 0.104 0.021 0.271
C 0.089 0.074 0.000 0.222
Communication Degree Summary by Section
Section Mean Median Min Max
A 0.570 0.632 0.158 1.000
B 0.504 0.479 0.167 1.000
C 0.427 0.370 0.111 0.833

3.2 Betweenness centrality

Betweenness centrality measures the extent to which an individual lies on the shortest path between other pairs of individuals in the network. Individuals with high betweenness centrality are more likely to have access to diverse sources of information. Individuals with low betweenness centrality are less central to the flow of information and may be more isolated.

# Function to calculate betweenness centrality for a network
calculate_betweenness <- function(graph) {
  betweenness <- betweenness(graph, normalized = TRUE)
  return(betweenness)
}

# Calculate betweenness centrality for each section
trust_between_a <- calculate_betweenness(trust_graph_A)
trust_between_b <- calculate_betweenness(trust_graph_B)
trust_between_c <- calculate_betweenness(trust_graph_C)

advice_between_a <- calculate_betweenness(advice_graph_A)
advice_between_b <- calculate_betweenness(advice_graph_B)
advice_between_c <- calculate_betweenness(advice_graph_C)

comm_between_a <- calculate_betweenness(comm_graph_A)
comm_between_b <- calculate_betweenness(comm_graph_B)
comm_between_c <- calculate_betweenness(comm_graph_C)

# Create dataframes for plotting
trust_between_df <- data.frame(
  Section = factor(c(rep("A", length(trust_between_a)), 
                    rep("B", length(trust_between_b)), 
                    rep("C", length(trust_between_c)))),
  Centrality = c(trust_between_a, trust_between_b, trust_between_c)
)

advice_between_df <- data.frame(
  Section = factor(c(rep("A", length(advice_between_a)), 
                    rep("B", length(advice_between_b)), 
                    rep("C", length(advice_between_c)))),
  Centrality = c(advice_between_a, advice_between_b, advice_between_c)
)

comm_between_df <- data.frame(
  Section = factor(c(rep("A", length(comm_between_a)), 
                    rep("B", length(comm_between_b)), 
                    rep("C", length(comm_between_c)))),
  Centrality = c(comm_between_a, comm_between_b, comm_between_c)
)

trust_between_plot <- ggplot(trust_between_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  labs(title = "Trust",
       y = NULL) +  # Remove y-axis label from individual plots
  theme_minimal() +
  theme(legend.position = "none") +  # Remove individual legends
  scale_fill_brewer(palette = "Set1") +
  ylim(0, max(c(trust_between_df$Centrality, advice_between_df$Centrality, comm_between_df$Centrality)))  # Set same y-axis limits

advice_between_plot <- ggplot(advice_between_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  labs(title = "Advice",
       y = NULL) +
  theme_minimal() +
  theme(legend.position = "none") +
  scale_fill_brewer(palette = "Set1") +
  ylim(0, max(c(trust_between_df$Centrality, advice_between_df$Centrality, comm_between_df$Centrality)))

comm_between_plot <- ggplot(comm_between_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  labs(title = "Communication",
       y = NULL) +
  theme_minimal() +
  theme(legend.position = "none") +
  scale_fill_brewer(palette = "Set1") +
  ylim(0, max(c(trust_between_df$Centrality, advice_between_df$Centrality, comm_between_df$Centrality)))

# Create a plot just for the legend
legend_plot <- ggplot(trust_between_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  scale_fill_brewer(palette = "Set1") +
  theme(legend.position = "bottom")

get_legend <- function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)
}
# Extract the legend
shared_legend <- get_legend(legend_plot)

# Create a shared y-axis label
y_label <- grid::textGrob("Normalized Betweenness", rot = 90, gp = grid::gpar(fontsize = 12))

# Arrange the plots with shared y-axis label and legend
gridExtra::grid.arrange(
  gridExtra::arrangeGrob(
    y_label,
    gridExtra::arrangeGrob(trust_between_plot, advice_between_plot, comm_between_plot, ncol = 3),
    widths = c(1, 30), 
    nrow = 1
  ),
  shared_legend,
  heights = c(10, 1),
  nrow = 2,
  top = "Betweenness Centrality Comparison by Section"
)

# Calculate and display summary statistics
trust_between_summary <- trust_between_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

advice_between_summary <- advice_between_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

comm_between_summary <- comm_between_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

kable(trust_between_summary, caption = "Trust Betweenness Centrality ", digits = 3)
Trust Betweenness Centrality
Section Mean Median Min Max
A 0.029 0.007 0 0.213
B 0.026 0.006 0 0.370
C 0.028 0.005 0 0.301 
kable(advice_between_summary, caption = "Advice Betweenness Centrality ", digits = 3)
Advice Betweenness Centrality
Section Mean Median Min Max
A 0.028 0.009 0 0.289
B 0.033 0.014 0 0.339
C 0.030 0.012 0 0.159 
kable(comm_between_summary, caption = "Communication Betweenness Centrality", digits = 3)
Communication Betweenness Centrality
Section Mean Median Min Max
A 0.022 0.004 0 0.293
B 0.019 0.004 0 0.182
C 0.017 0.008 0 0.118

3.3 Eigenvector centrality

Eigenvector centrality measures the extent to which an individual is connected to other well-connected individuals in the network. Individuals with high eigenvector centrality are well-connected to other well-connected individuals in the network, and thus are more likely to have influence over others in the network (i.e., greater power and/or status).

# Function to calculate eigenvector centrality for a network
calculate_eigenvector <- function(graph) {
  eigen <- eigen_centrality(graph, scale = TRUE)$vector
  return(eigen)
}

# Calculate eigenvector centrality for each section
trust_eigen_a <- calculate_eigenvector(trust_graph_A)
trust_eigen_b <- calculate_eigenvector(trust_graph_B)
trust_eigen_c <- calculate_eigenvector(trust_graph_C)

advice_eigen_a <- calculate_eigenvector(advice_graph_A)
advice_eigen_b <- calculate_eigenvector(advice_graph_B)
advice_eigen_c <- calculate_eigenvector(advice_graph_C)

comm_eigen_a <- calculate_eigenvector(comm_graph_A)
comm_eigen_b <- calculate_eigenvector(comm_graph_B)
comm_eigen_c <- calculate_eigenvector(comm_graph_C)

# Create dataframes for plotting
trust_eigen_df <- data.frame(
  Section = factor(c(rep("A", length(trust_eigen_a)), 
                    rep("B", length(trust_eigen_b)), 
                    rep("C", length(trust_eigen_c)))),
  Centrality = c(trust_eigen_a, trust_eigen_b, trust_eigen_c)
)

advice_eigen_df <- data.frame(
  Section = factor(c(rep("A", length(advice_eigen_a)), 
                    rep("B", length(advice_eigen_b)), 
                    rep("C", length(advice_eigen_c)))),
  Centrality = c(advice_eigen_a, advice_eigen_b, advice_eigen_c)
)

comm_eigen_df <- data.frame(
  Section = factor(c(rep("A", length(comm_eigen_a)), 
                    rep("B", length(comm_eigen_b)), 
                    rep("C", length(comm_eigen_c)))),
  Centrality = c(comm_eigen_a, comm_eigen_b, comm_eigen_c)
)

# Create plots
trust_eigen_plot <- ggplot(trust_eigen_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  labs(title = "Trust Network ",
       y = NULL) +
  theme_minimal() +
  theme(legend.position = "none") +  # Remove individual legends
  scale_fill_brewer(palette = "Set1") + 
  ylim(0, max(c(trust_eigen_df$Centrality, advice_eigen_df$Centrality, comm_eigen_df$Centrality)))  # Set same y-axis limits

advice_eigen_plot <- ggplot(advice_eigen_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  labs(title = "Advice Network ",
       y = NULL) +
  theme_minimal() +
  theme(legend.position = "none") +  # Remove individual legends
  scale_fill_brewer(palette = "Set1") + 
  ylim(0, max(c(trust_eigen_df$Centrality, advice_eigen_df$Centrality, comm_eigen_df$Centrality)))  # Set same y-axis limits

comm_eigen_plot <- ggplot(comm_eigen_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  labs(title = "Communication Network ",
       y = NULL) +
  theme_minimal() +
  theme(legend.position = "none") +  # Remove individual legends
  scale_fill_brewer(palette = "Set1") + 
  ylim(0, max(c(trust_eigen_df$Centrality, advice_eigen_df$Centrality, comm_eigen_df$Centrality)))  # Set same y-axis limits

# Create a plot just for the legend
legend_plot <- ggplot(trust_eigen_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  scale_fill_brewer(palette = "Set1") +
  theme(legend.position = "bottom")

get_legend <- function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)
}

# Extract the legend
shared_legend <- get_legend(legend_plot)

# Create a shared y-axis label
y_label <- grid::textGrob("Normalized EigenVector", rot = 90, gp = grid::gpar(fontsize = 12))

# Arrange the plots with shared y-axis label and legend
gridExtra::grid.arrange(
  gridExtra::arrangeGrob(
    y_label,
    gridExtra::arrangeGrob(trust_eigen_plot, advice_eigen_plot, comm_eigen_plot, ncol = 3),
    widths = c(1, 30), 
    nrow = 1
  ),
  shared_legend,
  heights = c(10, 1),
  nrow = 2,
  top = "Eigenvector Centrality Comparison by Section")

# Calculate and display summary statistics
trust_eigen_summary <- trust_eigen_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

advice_eigen_summary <- advice_eigen_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

comm_eigen_summary <- comm_eigen_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

kable(trust_eigen_summary, caption = "Trust Eigenvector Summary by Section", digits = 3)
Trust Eigenvector Summary by Section
Section Mean Median Min Max
A 0.317 0.227 0.018 1
B 0.362 0.287 0.032 1
C 0.269 0.222 0.073 1 
kable(advice_eigen_summary, caption = "Advice Eigenvector Summary by Section", digits = 3)
Advice Eigenvector Summary by Section
Section Mean Median Min Max
A 0.333 0.252 0.009 1
B 0.263 0.221 0.042 1
C 0.306 0.269 0.017 1 
kable(comm_eigen_summary, caption = "Communication Eigenvector Summary by Section", digits = 3)
Communication Eigenvector Summary by Section
Section Mean Median Min Max
A 0.597 0.611 0.105 1
B 0.494 0.482 0.120 1
C 0.549 0.543 0.081 1

3.4 Closeness centrality

Closeness centrality measures the extent to which an individual is close to other individuals in the network, in terms of the shortest path length.Individuals with high closeness centrality can more easily access information and resources from others in the network.

# Function to calculate closeness centrality for a network
calculate_closeness <- function(graph) {
  # For directed graphs, using mode="total" considers both in and out connections
  closeness <- closeness(graph, mode = "total", normalized = TRUE)
  return(closeness)
}

# Calculate closeness centrality for each section
trust_closeness_a <- calculate_closeness(trust_graph_A)
trust_closeness_b <- calculate_closeness(trust_graph_B)
trust_closeness_c <- calculate_closeness(trust_graph_C)

advice_closeness_a <- calculate_closeness(advice_graph_A)
advice_closeness_b <- calculate_closeness(advice_graph_B)
advice_closeness_c <- calculate_closeness(advice_graph_C)

comm_closeness_a <- calculate_closeness(comm_graph_A)
comm_closeness_b <- calculate_closeness(comm_graph_B)
comm_closeness_c <- calculate_closeness(comm_graph_C)

# Create dataframes for plotting
trust_closeness_df <- data.frame(
  Section = factor(c(rep("A", length(trust_closeness_a)), 
                    rep("B", length(trust_closeness_b)), 
                    rep("C", length(trust_closeness_c)))),
  Centrality = c(trust_closeness_a, trust_closeness_b, trust_closeness_c)
)

advice_closeness_df <- data.frame(
  Section = factor(c(rep("A", length(advice_closeness_a)), 
                    rep("B", length(advice_closeness_b)), 
                    rep("C", length(advice_closeness_c)))),
  Centrality = c(advice_closeness_a, advice_closeness_b, advice_closeness_c)
)

comm_closeness_df <- data.frame(
  Section = factor(c(rep("A", length(comm_closeness_a)), 
                    rep("B", length(comm_closeness_b)), 
                    rep("C", length(comm_closeness_c)))),
  Centrality = c(comm_closeness_a, comm_closeness_b, comm_closeness_c)
)

# Create plots
trust_closeness_plot <- ggplot(trust_closeness_df, aes(x = Section, y = Centrality, fill = Section)) +
    geom_boxplot() +
  labs(title = "Trust Network ",
       y = NULL) +
  theme_minimal() +
  theme(legend.position = "none") +  # Remove individual legends
  scale_fill_brewer(palette = "Set1") + 
  ylim(0, max(c(trust_closeness_df$Centrality, advice_closeness_df$Centrality, comm_closeness_df$Centrality)))  # Set same y-axis limits

advice_closeness_plot <- ggplot(advice_closeness_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  labs(title = "Advice Network ",
       y = NULL) +
  theme_minimal() +
  theme(legend.position = "none") +  # Remove individual legends
  scale_fill_brewer(palette = "Set1") + 
  ylim(0, max(c(trust_closeness_df$Centrality, advice_closeness_df$Centrality, comm_closeness_df$Centrality)))  # Set same y-axis limits

comm_closeness_plot <- ggplot(comm_closeness_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  labs(title = "Communication Network ",
       y = NULL) +
  theme_minimal() +
  theme(legend.position = "none") +  # Remove individual legends
  scale_fill_brewer(palette = "Set1") + 
  ylim(0, max(c(trust_closeness_df$Centrality, advice_closeness_df$Centrality, comm_closeness_df$Centrality)))  # Set same y-axis limits

# Create a plot just for the legend
legend_plot <- ggplot(trust_closeness_df, aes(x = Section, y = Centrality, fill = Section)) +
  geom_boxplot() +
  scale_fill_brewer(palette = "Set1") +
  theme(legend.position = "bottom")

get_legend <- function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)
}

# Extract the legend
shared_legend <- get_legend(legend_plot)

# Create a shared y-axis label
y_label <- grid::textGrob("Normalized Closeness Centrality", rot = 90, gp = grid::gpar(fontsize = 12))

# Arrange the plots with shared y-axis label and legend
gridExtra::grid.arrange(
  gridExtra::arrangeGrob(
    y_label,
    gridExtra::arrangeGrob(trust_closeness_plot, advice_closeness_plot, comm_closeness_plot, ncol = 3),
    widths = c(1, 30), 
    nrow = 1
  ),
  shared_legend,
  heights = c(10, 1),
  nrow = 2,
  top = "Closeness Centrality Comparison by Section")

# Calculate and display summary statistics
trust_closeness_summary <- trust_closeness_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

advice_closeness_summary <- advice_closeness_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

comm_closeness_summary <- comm_closeness_df %>%
  group_by(Section) %>%
  summarize(
    Mean = mean(Centrality),
    Median = median(Centrality),
    Min = min(Centrality),
    Max = max(Centrality)
  )

kable(trust_closeness_summary, caption = "Trust Closeness Summary by Section", digits = 3)
Trust Closeness Summary by Section
Section Mean Median Min Max
A 0.264 0.259 0.155 0.409
B 0.531 0.511 0.505 1.000
C 0.355 0.378 0.243 0.587 
kable(advice_closeness_summary, caption = "Advice Closeness Summary by Section", digits = 3)
Advice Closeness Summary by Section
Section Mean Median Min Max
A 0.541 0.535 0.349 0.927
B 0.509 0.505 0.381 0.787
C 0.458 0.466 0.295 0.684 
kable(comm_closeness_summary, caption = "Communication Closeness Summary by Section", digits = 3)
Communication Closeness Summary by Section
Section Mean Median Min Max
A 0.356 0.355 0.248 0.497
B 0.393 0.400 0.277 0.516
C 0.310 0.310 0.232 0.394

#Function For Network Measures

#This function makes a data frame of individual statistics/network measures 
calculate_individual_measures <- function(graph, is_directed = TRUE) {
  if(is_directed) {
    # For directed networks (Trust, Advice)
    indegree <- degree(graph, mode = "in", normalized = TRUE)
    outdegree <- degree(graph, mode = "out", normalized = TRUE)
    betweenness <- betweenness(graph, normalized = TRUE)
    closeness <- closeness(graph, mode = "total", normalized = TRUE)
    eigenvector <- eigen_centrality(graph, scale = TRUE)$vector
    
    # Combine into a data frame
    measures <- data.frame(
      id = V(graph)$name,
      in_degree = indegree,
      out_degree = outdegree,
      betweenness = betweenness,
      closeness = closeness,
      eigenvector = eigenvector
    )
    
  } else {
    # For undirected networks (Communication)
    degree <- degree(graph, normalized = TRUE)
    betweenness <- betweenness(graph, normalized = TRUE)
    closeness <- closeness(graph, normalized = TRUE)
    eigenvector <- eigen_centrality(graph, scale = TRUE)$vector
    
    # Combine into a data frame
    measures <- data.frame(
      id = V(graph)$name,
      degree = degree,
      betweenness = betweenness,
      closeness = closeness,
      eigenvector = eigenvector
    )
  }
  
  # Add section information if available
  if("section" %in% vertex_attr_names(graph)) {
    measures$section <- V(graph)$section
  }
  
  return(measures)
}

# Calculate measures for each section separately
# Trust network
trust_measures_a <- calculate_individual_measures(trust_graph_A, is_directed = TRUE)
trust_measures_b <- calculate_individual_measures(trust_graph_B, is_directed = TRUE)
trust_measures_c <- calculate_individual_measures(trust_graph_C, is_directed = TRUE)

# Advice network
advice_measures_a <- calculate_individual_measures(advice_graph_A, is_directed = TRUE)
advice_measures_b <- calculate_individual_measures(advice_graph_B, is_directed = TRUE)
advice_measures_c <- calculate_individual_measures(advice_graph_C, is_directed = TRUE)

# Communication network
comm_measures_a <- calculate_individual_measures(comm_graph_A, is_directed = FALSE)
comm_measures_b <- calculate_individual_measures(comm_graph_B, is_directed = FALSE)
comm_measures_c <- calculate_individual_measures(comm_graph_C, is_directed = FALSE)

4 Advice Network Graph

Where are you in the class advice network? Do you have a large or small size of node? Do you know your centrality score? (Hint: by selecting your node id from the drop down box and click on your own node)
NOTE: You can resize the graphs and relocate individual nodes.

visualize_advice_section_standardized <- function(graph, measures, section_letter) {
  # Add centrality measures as node attributes
  V(graph)$betweenness <- measures$betweenness
  V(graph)$indegree <- measures$in_degree
  V(graph)$outdegree <- measures$out_degree
  V(graph)$eigenvector <- measures$eigenvector
  V(graph)$closeness <- measures$closeness
  
  # Use consistent node sizing based on indegree (advice sought from)
  V(graph)$value <- measures$in_degree * 30 + 5  
  
  # Set consistent layout seed for comparable visualizations
  set.seed(123)
  graph <- set_graph_attr(graph, "layout", layout_with_fr)
  
  # Convert to visNetwork format
  data <- toVisNetworkData(graph)
  node_df <- as.data.frame(data$nodes)
  node_df <- node_df %>%
    mutate(id = as.numeric(id)) %>%  
    arrange(id)
  
  # Create tooltips with standardized formatting
  node_df$title <- paste0("<b>Node ID:</b> ", node_df$id,
                        "<br><b>Section:</b> ", section_letter,
                        "<br><b>In-degree:</b> ", round(node_df$indegree, 3), 
                        "<br><b>Out-degree:</b> ", round(node_df$outdegree, 3),
                        "<br><b>Betweenness:</b> ", round(node_df$betweenness, 3), 
                        "<br><b>Closeness:</b> ", round(node_df$closeness, 3),
                        "<br><b>Eigenvector:</b> ", round(node_df$eigenvector, 3))
  
  # Create visNetwork with consistent parameters
  vn <- visNetwork(node_df, edges = data$edges, 
                 height = "500px", width = "100%",
                 main = paste("Advice Network - Section", section_letter)) %>%
    visPhysics(stabilization = TRUE, 
              solver = "forceAtlas2Based",
              forceAtlas2Based = list(gravitationalConstant = -50)) %>%
    visOptions(
      highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE),
      nodesIdSelection = list(enabled = TRUE,
                             style = 'width: 150px; height: 26px; background: #f8f8f8; color: #1a1a1a; border:none;')
    ) %>%
    visNodes(
      borderWidth = 2,
      borderWidthSelected = 4,
      scaling = list(min = 10, max = 30),
      color = list(
        background = "#FFA07A",  # Light salmon color for advice networks
        border = "#E9692B",      # Darker orange border
        highlight = list(
          background = "#FFD2B8", # Lighter highlight
          border = "#E9692B"
        )
      )
    ) %>%
    visEdges(
      arrows = 'to',  # Arrows point to the person giving advice
      color = list(color = "#E9692B", highlight = "#2B7CE9", opacity = 0.6),
      smooth = list(enabled = TRUE, type = "dynamic")
    ) %>%
    visLayout(randomSeed = 123) # Consistent layout across networks
  
  return(vn)
}

# Create the advice network visualizations
advice_viz_a <- visualize_advice_section_standardized(advice_graph_A, advice_measures_a, "A")
advice_viz_b <- visualize_advice_section_standardized(advice_graph_B, advice_measures_b, "B") 
advice_viz_c <- visualize_advice_section_standardized(advice_graph_C, advice_measures_c, "C")

# Display sections with consistent formatting
library(htmltools)
div(
  h2("Advice Networks by Section"),
  p("Node size represents in-degree centrality (how often a person is sought for advice). Arrows point to the advisor."),
  h3("Section M"),
  advice_viz_a,
  hr(),
  h3("Section O"),
  advice_viz_b,
  hr(),
  h3("Section P"),
  advice_viz_c
)

Advice Networks by Section

Node size represents in-degree centrality (how often a person is sought for advice). Arrows point to the advisor.

Section M

Section O

Section P

5 Trust Network Graph

# add node network attributes from network graph stats data fram generated above
visualize_trust_section_standardized <- function(graph, measures, section_letter) {
  # Add centrality measures as node attributes
  V(graph)$betweenness <- measures$betweenness
  V(graph)$indegree <- measures$in_degree
  V(graph)$outdegree <- measures$out_degree
  V(graph)$eigenvector <- measures$eigenvector
  V(graph)$closeness <- measures$closeness
  
  # Use consistent node sizing based on indegree (trust received)
  V(graph)$value <- measures$in_degree * 30 + 5  
  
  # Set consistent layout seed for comparable visualizations
  set.seed(123)
  graph <- set_graph_attr(graph, "layout", layout_with_fr)
  
  # Convert to visNetwork format
  data <- toVisNetworkData(graph)
  node_df <- as.data.frame(data$nodes)
  node_df <- node_df %>%
    mutate(id = as.numeric(id)) %>%  
    arrange(id)
  
  # Create tooltips with standardized formatting
  node_df$title <- paste0("<b>Node ID:</b> ", node_df$id,
                        "<br><b>Section:</b> ", section_letter,
                        "<br><b>In-degree:</b> ", round(node_df$indegree, 3), 
                        "<br><b>Out-degree:</b> ", round(node_df$outdegree, 3),
                        "<br><b>Betweenness:</b> ", round(node_df$betweenness, 3), 
                        "<br><b>Closeness:</b> ", round(node_df$closeness, 3),
                        "<br><b>Eigenvector:</b> ", round(node_df$eigenvector, 3))
  
  # Create visNetwork with consistent parameters
  vn <- visNetwork(node_df, edges = data$edges, 
                 height = "500px", width = "100%",
                 main = paste("Trust Network - Section", section_letter)) %>%
    visPhysics(stabilization = TRUE, 
              solver = "forceAtlas2Based",
              forceAtlas2Based = list(gravitationalConstant = -50)) %>%
    visOptions(
      highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE),
      nodesIdSelection = list(enabled = TRUE,
                             style = 'width: 150px; height: 26px; background: #f8f8f8; color: #1a1a1a; border:none;')
    ) %>%
    visNodes(
      borderWidth = 2,
      borderWidthSelected = 4,
      scaling = list(min = 10, max = 30),
      color = list(
        background = "#FFA07A",  # Light salmon color for advice networks
        border = "#E9692B",      # Darker orange border
        highlight = list(
          background = "#FFD2B8", # Lighter highlight
          border = "#E9692B"
        )
      )
    ) %>%
    visEdges(
      arrows = 'to',  # Arrows point to the person giving advice
      color = list(color = "#E9692B", highlight = "#2B7CE9", opacity = 0.6),
      smooth = list(enabled = TRUE, type = "dynamic")
    ) %>%
    visLayout(randomSeed = 123) # Consistent layout across networks
  
  return(vn)
}

# Create visualization tabs for each section
library(htmltools)

# Create the visualizations
trust_viz_a <- visualize_trust_section_standardized(trust_graph_A, trust_measures_a, "A")
trust_viz_b <- visualize_trust_section_standardized(trust_graph_B, trust_measures_b, "B") 
trust_viz_c <- visualize_trust_section_standardized(trust_graph_C, trust_measures_c, "C")

# Display sections with consistent formatting
div(
  h2("Trust Networks by Section"),
  p("Node size represents in-degree centrality (how trusted a person is). Arrows point to the person who is trusted."),
  h3("Section M"),
  trust_viz_a,
  hr(),
  h3("Section O"),
  trust_viz_b,
  hr(),
  h3("Section P"),
  trust_viz_c
)

Trust Networks by Section

Node size represents in-degree centrality (how trusted a person is). Arrows point to the person who is trusted.

Section M

Section O

Section P

6 Communication Network Graph

visualize_comm_section_standardized <- function(graph, measures, section_letter) {
  # Add centrality measures as node attributes
  V(graph)$betweenness <- measures$betweenness
  V(graph)$degree <- measures$degree
  V(graph)$eigenvector <- measures$eigenvector
  V(graph)$closeness <- measures$closeness
  
  # Use consistent node sizing based on degree (communication frequency)
  V(graph)$value <- measures$degree * 30 + 5  
  
  # Set consistent layout seed for comparable visualizations
  set.seed(123)
  graph <- set_graph_attr(graph, "layout", layout_with_fr)
  
  # Convert to visNetwork format
  data <- toVisNetworkData(graph)
  node_df <- as.data.frame(data$nodes)
  node_df <- node_df %>%
    mutate(id = as.numeric(id)) %>%  
    arrange(id)
  
  # Create tooltips with standardized formatting
  node_df$title <- paste0("<b>Node ID:</b> ", node_df$id,
                        "<br><b>Section:</b> ", section_letter,
                        "<br><b>Degree:</b> ", round(node_df$degree, 3), 
                        "<br><b>Betweenness:</b> ", round(node_df$betweenness, 3), 
                        "<br><b>Closeness:</b> ", round(node_df$closeness, 3),
                        "<br><b>Eigenvector:</b> ", round(node_df$eigenvector, 3))
  
  # Create visNetwork with consistent parameters
  vn <- visNetwork(node_df, edges = data$edges, 
                 height = "500px", width = "100%",
                 main = paste("Communication Network - Section", section_letter)) %>%
    visPhysics(stabilization = TRUE, 
              solver = "forceAtlas2Based",
              forceAtlas2Based = list(gravitationalConstant = -50)) %>%
    visOptions(
      highlightNearest = list(enabled = TRUE, degree = 1, hover = TRUE),
      nodesIdSelection = list(enabled = TRUE,
                             style = 'width: 150px; height: 26px; background: #f8f8f8; color: #1a1a1a; border:none;')
    ) %>%
    visNodes(
      borderWidth = 2,
      borderWidthSelected = 4,
      scaling = list(min = 10, max = 30),
      color = list(
        background = "#FFA07A",  # Light salmon color for advice networks
        border = "#E9692B",      # Darker orange border
        highlight = list(
          background = "#FFD2B8", # Lighter highlight
          border = "#E9692B"
        )
      )
    ) %>%
    visEdges(
      arrows = 'to',  # Arrows point to the person giving advice
      color = list(color = "#E9692B", highlight = "#2B7CE9", opacity = 0.6),
      smooth = list(enabled = TRUE, type = "dynamic")
    ) %>%
    visLayout(randomSeed = 123) # Consistent layout across networks
  
  return(vn)
}

# Create the communication network visualizations
comm_viz_a <- visualize_comm_section_standardized(comm_graph_A, comm_measures_a, "A")
comm_viz_b <- visualize_comm_section_standardized(comm_graph_B, comm_measures_b, "B") 
comm_viz_c <- visualize_comm_section_standardized(comm_graph_C, comm_measures_c, "C")

# Display sections with consistent formatting
library(htmltools)
div(
  h2("Communication Networks by Section"),
  p("Node size represents degree centrality (how frequently a person communicates with others). Edges represent communication between individuals."),
  h3("Section M"),
  comm_viz_a,
  hr(),
  h3("Section O"),
  comm_viz_b,
  hr(),
  h3("Section P"),
  comm_viz_c
)

Communication Networks by Section

Node size represents degree centrality (how frequently a person communicates with others). Edges represent communication between individuals.

Section M

Section O

Section P



Last updated on the 07/2025