simplify_graph.R

library(igraph)
library(ggraph)

mtcars_cor <- (cor(mtcars))^2
mtcars_cor <- (-1) * mtcars_cor

g <- graph_from_adjacency_matrix(mtcars_cor, weighted = TRUE, 
                                 mode = "undirected", diag = FALSE)

g_mst <- mst(g, algorithm = "prim")

threshold <- 0
avg_links_n <- FALSE

avg_links <- 4
tolerance <- 0.05

simplify_g <- function() {
  while (avg_links_n == FALSE) {
    if (threshold < 1) {
      message(sprintf("%s threshold...", threshold))
      
      g_not_in_mst <- delete.edges(g, which(abs(E(g)$weight) <= threshold))
      g_not_in_mst <- graph.difference(g_not_in_mst, g_mst)
      
      g <- graph.union(g_mst, g_not_in_mst)
      E(g)$weight <- pmin(E(g)$weight_1, E(g)$weight_2, na.rm = T)
      g <- remove.edge.attribute(g, "weight_1")
      g <- remove.edge.attribute(g, "weight_2")
      
      avg_links_n <- ifelse(mean(degree(g)) <= avg_links, TRUE, FALSE)
      threshold <- threshold + tolerance
      
      if (avg_links_n == TRUE) {
        message(sprintf("%s threshold achieves the avg number of connections", threshold))
        E(g)$weight <- (-1) * E(g)$weight
        return(g)
      }
    } else {
      warning("no threshold achieves the avg number of connections\nreturning maximum spanning tree")
      avg_links_n <- TRUE
      E(g_mst)$weight <- (-1) * E(g_mst)$weight
      return(g_mst)
    }
  }
}

g_mst_2 <- simplify_g()

ggraph(g, layout = "fr") +
  geom_edge_link(edge_colour = "#a8a8a8") +
  geom_node_point(aes(size = 5), color = "#86494d") +
  geom_node_text(aes(label = name), size = 2, vjust = 2.2) +
  ggtitle("Full g") +
  theme_void()

ggraph(g_mst_2, layout = "kk") +
  geom_edge_link(edge_colour = "#a8a8a8") +
  geom_node_point(aes(size = 5), color = "#86494d") +
  geom_node_text(aes(label = name), size = 2, vjust = 2.2) +
  ggtitle("g with avg of 4 links") +
  theme_void()