Network Similarity Tests

# Libraries
pacman::p_load(janitor, tidyverse, BDgraph, corpcor, lsa, igraph)

# Frobenius norm-based measure
normFr <- function(n1, n2, p){
  return(1/(1 + (norm(n1 - n2, type = "F")/sqrt(p/2))))
}

set.seed(94305)

get_sim <- function(nodecount, density, multiplicand) {
  
  net1 <- erdos.renyi.game(nodecount, density, type = "gnp", directed = FALSE)
  E(net1)$weight <- runif(length(E(net1)), -1, 1)
  net2 <- net1
  
  # uncomment below line if wish to see baseline network
  # plot(net1, edge.width = E(net1)$weight, main = "Baseline network")
  
  df <- tibble(
    nodes = rep(nodecount, gsize(net2) + 1),
    density = rep(density, gsize(net2) + 1),
    multiplicand = rep(multiplicand, gsize(net2) + 1)
  )
  
  edges_changed <- c()
  sfrob_values <- c()
  scor_values <- c()
  
  for (i in 0:gsize(net2)) {
    
    E(net2)[0:i]$weight <- E(net2)[0:i]$weight * multiplicand # edge weights altered here
    
    sfrob <- normFr(
      as_adjacency_matrix(net1, attr = "weight", sparse = F), 
      as_adjacency_matrix(net2, attr = "weight", sparse = F), 
      gorder(net1)
    )
    scor <- cor(
      c(as_adjacency_matrix(net1, type = "lower", attr = "weight", sparse = F)),
      c(as_adjacency_matrix(net2, type = "lower", attr = "weight", sparse = F)),
    )
    
    edges_changed <- c(edges_changed, i)
    sfrob_values <- c(sfrob_values, sfrob)
    scor_values <- c(scor_values, scor)
  }
  
  df$prop_edges_changed <- edges_changed/gsize(net2)
  df$sfrob <- sfrob_values
  df$scor <- scor_values
  return(df)
}

bind_rows(
  get_sim(10, 0.1, 0),
  get_sim(10, 0.3, 0),
  get_sim(10, 0.5, 0),
  get_sim(10, 0.7, 0),
  get_sim(10, 0.9, 0),
  get_sim(20, 0.1, 0),
  get_sim(20, 0.3, 0),
  get_sim(20, 0.5, 0),
  get_sim(20, 0.7, 0),
  get_sim(20, 0.9, 0)
) %>% 
  pivot_longer(cols = c(sfrob, scor), names_to = "metric", values_to = "similarity") %>% 
  ggplot(aes(prop_edges_changed, similarity)) +
  geom_smooth(aes(color = metric), se = F) +
  facet_grid(vars(density), vars(nodes)) +
  scale_color_brewer(palette = "Set1") +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme_minimal() +
  labs(
    x = "Proportion of edges changed",
    y = "Network similarity",
    title = "Network similarity with edges dropped",
    subtitle = "Rows are density values, columns are node counts",
    color = "Metric"
  )

bind_rows(
  get_sim(10, 0.1, -1),
  get_sim(10, 0.3, -1),
  get_sim(10, 0.5, -1),
  get_sim(10, 0.7, -1),
  get_sim(10, 0.9, -1),
  get_sim(20, 0.1, -1),
  get_sim(20, 0.3, -1),
  get_sim(20, 0.5, -1),
  get_sim(20, 0.7, -1),
  get_sim(20, 0.9, -1)
) %>% 
  pivot_longer(cols = c(sfrob, scor), names_to = "metric", values_to = "similarity") %>% 
  ggplot(aes(prop_edges_changed, similarity)) +
  geom_smooth(aes(color = metric), se = F) +
  facet_grid(vars(density), vars(nodes)) +
  scale_color_brewer(palette = "Set1") +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme_minimal() +
  labs(
    x = "Proportion of edges inverted",
    y = "Network similarity",
    title = "Network similarity with edges dropped",
    subtitle = "Rows are density values, columns are node counts",
    color = "Metric"
  )

bind_rows(
  get_sim(10, 0.1, 0.5),
  get_sim(10, 0.3, 0.5),
  get_sim(10, 0.5, 0.5),
  get_sim(10, 0.7, 0.5),
  get_sim(10, 0.9, 0.5),
  get_sim(20, 0.1, 0.5),
  get_sim(20, 0.3, 0.5),
  get_sim(20, 0.5, 0.5),
  get_sim(20, 0.7, 0.5),
  get_sim(20, 0.9, 0.5)
) %>% 
  pivot_longer(cols = c(sfrob, scor), names_to = "metric", values_to = "similarity") %>% 
  ggplot(aes(prop_edges_changed, similarity)) +
  geom_smooth(aes(color = metric), se = F) +
  facet_grid(vars(density), vars(nodes)) +
  scale_color_brewer(palette = "Set1") +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  theme_minimal() +
  labs(
    x = "Proportion of edges inverted",
    y = "Network similarity",
    title = "Network similarity with edges halved",
    subtitle = "Rows are density values, columns are node counts",
    color = "Metric"
  )