Search code examples
rnodesigraphggraph

Remove isolated nodes from dynamic layout in ggraph plot


I have a friendship network dataset over several waves. I want to plot the friendships that persist over the waves, and keep the nodes in the same coordinates for each plot. I'm able to use ggraph and graphlayouts' dynamic layout to keep the nodes in the same positions over four waves, but I want to remove the nodes over time that lose their ties. This is an example of what I have done so far:

library(dplyr)
library(magrittr)
library(ggplot2)
library(igraph)
library(tidygraph)
library(ggraph)
library(viridis)
library(gridExtra)

set.seed(1234)

gtest <- erdos.renyi.game(100, 0.03, type = "gnp", directed = TRUE,
                 loops = FALSE) %>%
         set_vertex_attr("label", value = 1:100)

g_nodes <- get.data.frame(gtest, what = "vertices") %>%
           mutate(sex = sample(0:1, n(), replace = TRUE),
                  sex = as.character(sex))

g_edges1 <- get.edgelist(gtest) %>% as.data.frame()
g_edges2 <- sample_n(g_edges1, 130, replace = FALSE)
g_edges3 <- sample_n(g_edges2, 70, replace = FALSE)
g_edges4 <- sample_n(g_edges3, 20, replace = FALSE)


g1 <- graph_from_data_frame(d=g_edges1, vertices = g_nodes, directed = TRUE)
g2 <- graph_from_data_frame(d=g_edges2, vertices = g_nodes, directed = TRUE)
g3 <- graph_from_data_frame(d=g_edges3, vertices = g_nodes, directed = TRUE)
g4 <- graph_from_data_frame(d=g_edges4, vertices = g_nodes, directed = TRUE)

gList <- list(g1, g2, g3, g4)

xy <- graphlayouts::layout_as_dynamic(gList,alpha = 0.2)
pList <- vector("list",length(gList))

for(i in 1:length(gList)){
  pList[[i]] <- ggraph(gList[[i]],layout="manual",x=xy[[i]][,1],y=xy[[i]][,2])+
    geom_edge_link(color = "black", alpha = 0.7,
                   arrow = arrow(type = "closed",
                                 angle = 25,
                                 length = unit(1.5, 'mm')), 
                   end_cap = circle(1, 'mm'), 
                   width = 0.5, show.legend = FALSE) +   
    geom_node_point(aes(color = factor(sex)), size = 3) +
    scale_color_hue(l=40) +
    theme_graph()+
    theme(legend.position = "none")
}
Reduce("+",pList)+
  plot_annotation(title="Friendship network",theme = theme(title = element_text(family="Arial Narrow",face = "bold",size=16)))

Which gives me this plot:

enter image description here

This is what I want, except for plots 2-4 I want to delete the nodes with no edges. I've tried also deleting the isolates from the individual graph functions such as:

g1 <- graph_from_data_frame(d=g_edges1, vertices = g_nodes, directed = TRUE) 

g2 <- graph_from_data_frame(d=g_edges2, vertices = g_nodes, directed = TRUE) %>%
      delete.vertices(., which(degree(.)==0))

g3 <- graph_from_data_frame(d=g_edges3, vertices = g_nodes, directed = TRUE) %>%
      delete.vertices(., which(degree(.)==0))

g4 <- graph_from_data_frame(d=g_edges4, vertices = g_nodes, directed = TRUE) %>%
      delete.vertices(., which(degree(.)==0))

But then I get this error when I try to run the plot:

Error in data.frame(..., check.names = FALSE) : 
  arguments imply differing number of rows: 100, 98

Any ideas on how I can remove the isolates within the plot itself?


Solution

  • I think you can do something like below within your for loop

    for (i in 1:length(gList)) {
      idx <- degree(gList[[i]]) == 0
      g <- gList[[i]] %>%
        delete.vertices(names(V(.))[idx])
      XY <- xy[[i]] %>%
        subset(!idx)
      pList[[i]] <- ggraph(g, layout = "manual", x = XY[, 1], y = XY[, 2]) +
        geom_edge_link(
          color = "black", alpha = 0.7,
          arrow = arrow(
            type = "closed",
            angle = 25,
            length = unit(1.5, "mm")
          ),
          end_cap = circle(1, "mm"),
          width = 0.5, show.legend = FALSE
        ) +
        geom_node_point(aes(color = factor(sex)), size = 3) +
        scale_color_hue(l = 40) +
        theme_graph() +
        theme(legend.position = "none")
    }
    

    where g is the graph after removing isolated vertices, and XY is the corresponding coordinates after the removal. Then, you will get enter image description here