1
votes

Is it possible to plot multiple networks into 1 graph, by using forceNetwork for networkD3?

A sample (from the post Adjust background picture and title for plot from networkD3's forceNetwork) uses 1 set of nodes + edges (ie. subNodes & subLinkList). In a case when there are 4 sets of nodes + edges, and I want to put them all into 1 graph. How is it possible?

Thank you.

graph of 1 set of nodes + edges as below:

library(networkD3)
library(htmlwidgets)

subNodes <- 
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
             nodeName nodeGroup     nodeSize
             Bob      NorthAmerica  10
             Alice    NorthAmerica  10
             Tom      China         10
             John     Japan         10
             ")

subLinkList <-
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
             root  children  linkValue
             0     1         1
             0     2         1
             0     3         1
             ")

network <- forceNetwork(Links = subLinkList, Nodes = subNodes,
                        Source = "root", Target = "children",
                        Value = "linkValue", NodeID = "nodeName",
                        Group = "nodeGroup", 
                        opacity = 1, Nodesize = "nodeSize",
                        legend = TRUE)

network <- htmlwidgets::prependContent(network, htmltools::tags$h1("Title"))

network <- htmlwidgets::onRender(
  network,
  'function(el, x) { 
    d3.selectAll(".legend text").style("fill", "white");
    d3.select("body").style("background-color", "#144370");
    d3.select("h1").style("color", "red").style("font-family", "sans-serif");
    d3.select("body")
      .style("background-repeat", "no-repeat")
      .style("background-position", "right bottom");
  }'
)


network
1

1 Answers

2
votes

I believe this is what you want.

Just use function bind_rows from dplyr to merge yours set of nodes + edges

library(networkD3)
library(htmlwidgets)
library(dplyr)

subNodes <- 
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
             nodeName nodeGroup     nodeSize
             Bob      NorthAmerica  10
             Alice    NorthAmerica  10
             Tom      China         10
             John     Japan         10
             ")

subLinkList <-
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
             root  children  linkValue
             0     1         1
             0     2         1
             0     3         1
            ")

subNodes2 <- 
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
             nodeName nodeGroup     nodeSize
             A        Brazil        10
             B        NorthAmerica  10
             C        China         10
             D        Japan         10
             ")

subLinkList2 <-
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
            root  children  linkValue
             4     5         1
             4     6         1
             4     7         1
             ")

subNodes3 <- 
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
             nodeName nodeGroup     nodeSize
             E        Brazil        10
             F        NorthAmerica  10
             G        China         10
             H        Japan         10
             ")

subLinkList3 <-
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
             root  children  linkValue
             8     9         1
             8     10        1
             8     11        1
             ")


subNodes4 <- 
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
             nodeName nodeGroup     nodeSize
             I        Brazil        10
             J        NorthAmerica  10
             K        China         10
             L        Japan         10
             ")

subLinkList4 <-
  read.table(stringsAsFactors = FALSE, header = TRUE, text = "
            root  children  linkValue
            12    13        1
            12    14        1
            12    15        1
            ")


subNodesFinal <- bind_rows(subNodes, subNodes2, subNodes3, subNodes4)
subLinkListFinal <- bind_rows(subLinkList, subLinkList2, subLinkList3, 
                              subLinkList4)

network <- forceNetwork(Links = subLinkListFinal, Nodes = subNodesFinal,
                        Source = "root", Target = "children",
                        Value = "linkValue", NodeID = "nodeName",
                        Group = "nodeGroup", 
                        opacity = 1, Nodesize = "nodeSize",
                        legend = TRUE)

network <- htmlwidgets::prependContent(network, htmltools::tags$h1("Title"))

network <- htmlwidgets::onRender(
  network,
  'function(el, x) { 
    d3.selectAll(".legend text").style("fill", "white");
    d3.select("body").style("background-color", "#144370");
    d3.select("h1").style("color", "red").style("font-family", "sans-serif");
    d3.select("body")
      .style("background-repeat", "no-repeat")
      .style("background-position", "right bottom");
  }'
)


network

enter image description here