Несколько сетей в 1 графике из сети ForceDetworkD3

Question

Можно ли построить несколько сетей на 1 графике, используя forceNetwork для networkD3?

Пример (из публикации Настройка фонового изображения и заголовка для графика из forceNetwork сети D3)1 набор узлов + ребер (т. Е. SubNodes & subLinkList).В случае, когда есть 4 набора узлов + ребер, и я хочу поместить их все в 1 граф.Как это возможно?

Спасибо.

график 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

Я считаю, что это то, что вы хотите.

Просто используйте функцию bind_rows из dplyr, чтобы объединить ваш набор узлов + ребер

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