Search code examples
rgraphdata-visualizationinteractive

Converting Igraph to VisNetwork


I have this network graph that I made using the "igraph" library:

library(tidyverse)
library(igraph)


set.seed(123)
n=15
data = data.frame(tibble(d = paste(1:n)))

relations = data.frame(tibble(
  from = sample(data$d),
  to = lead(from, default=from[1]),
))

data$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )

graph = graph_from_data_frame(relations, directed=T, vertices = data) 
(edge_fac <- forcats::as_factor(get.edgelist(graph)[,1]))
n2 <- as.integer(factor(data$name,levels = levels(edge_fac)))


V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")
V(graph)$label <- paste0(data$name,"\n\n\n",n2)
plot(graph, layout=layout.circle, edge.arrow.size = 0.2, main = "my_graph")

Is it somehow possible to convert the above graph into a "visnetwork" graph, so that it looks like this?

I know there is a function ( visIgraph() ) meant for converting "igraph" graps to "visnetwork" graphs: https://www.rdocumentation.org/packages/visNetwork/versions/2.1.0/topics/visNetwork-igraph

But I am not sure if I can transform the first "igraph" graph (with both "numeric" and "text" labels) into an interactive "visnetwork" graph.

I tried to do this with the following code :

visIgraph(graph)

But this creates an interactive graph without the "number" labels.

Is it possible to do this?

Thank you!


Solution

  • You have to do a bit of manipulation to make this work because this uses base R plotting.

    Essentially, these are two different igraph objects lying on top of each other. This is the only way I could think of to have two different 'cex' sizes. It may require a bit of finesse, depending on where you go from here.

    library(tidyverse)
    library(igraph)
    library(gridGraphics)    # <--- I'm new!
    library(grid)            # <--- I'm new!
    
    #----------- from question -----------
    set.seed(123)
    n=15
    data = data.frame(tibble(d = paste(1:n)))    
    
    relations = data.frame(tibble(
      from = sample(data$d),
      to = lead(from, default=from[1]),
    ))
    
    data$name = c("new york", "chicago", "los angeles", "orlando",
                  "houston", "seattle", "washington", "baltimore", 
                  "atlanta", "las vegas", "oakland", "phoenix", 
                  "kansas", "miami", "newark" )
    
    
    graph = graph_from_data_frame(relations, 
                                  directed=T, 
                                  vertices = data) 
    (edge_fac <- forcats::as_factor(get.edgelist(graph)[,1]))
    n2 <- as.integer(factor(data$name,levels = levels(edge_fac)))
    V(graph)$color <- ifelse(data$d == relations$from[1], 
                             "red", "orange")
    

    This is where the changes begin.

    #---------- prepare the first plot -----------
    # make label text larger
    V(graph)$label.cex = 1.5
    # V(graph)$label <- paste0(data$name,"\n",n2)
    V(graph)$label <- paste0(n2) # just the number instead
    
    #---------- prepare to collect grob ----------
    # collect base plot grob
    grabber <- function(){
      grid.echo()
      grid.grab()
    }
    
    # create a copy for the top layer
    graph2 <- graph
    
    #-------------- plot and grab ----------------
    # without arrow sizes
    plot(graph, layout=layout.circle, main = "my_graph")
    
    # grab the grob
    g1 = grabber() 
    

    Now for the second graph; the top layer

    #----------- create the top layer -------------
    # with the copy, make the vertices transparent
    V(graph2)$color <- "transparent"
    
    # reset the font size
    V(graph2)$label.cex = 1 
    
    # shift the labels below (while keeping the plot design the same)
    V(graph2)$label <- paste0("\n\n\n\n", data$name)
    
    # show me
    plot(graph2, layout=layout.circle,
         main = "my_graph", 
         edge.color = "transparent") # invisible arrows/ only 1 layer of arrows
    
    # grab the grob
    g2 = grabber()
    

    Layer them!

    #-------------- redraw the plots -------------
    # make the plot background transparent on the top layer
    g2[["children"]][["graphics-background"]][["gp"]][["fill"]] <- "transparent"
    
    # draw it!
    grid.draw(g1)
    grid.draw(g2)
    

    enter image description here

    You might find it interesting that the graphs going into the grob look different than what comes out of them...grid essentially adjusts them. I thought that was kind of awesome.