来自 networkD3 的 forceNetwork 的 1 个图中的多个网络

Question

是否可以通过将 forceNetwork 用于 networkD3 将多个网络绘制到 1 个图中？

一个示例（来自Adjust background picture and title for plot from networkD3's forceNetwork 的帖子）使用一组节点 + 边（即 subNodes 和 subLinkList）。在有 4 组节点 + 边的情况下，我想将它们全部放入 1 个图中。怎么可能？

谢谢。

一组节点+边的图如下：

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

Answer 1

我相信这就是你想要的。

只需使用 dplyr 中的函数 bind_rows 来合并你的节点集 + 边

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