Несколько сетей в 1 графе от networkD3 ForceNetwork

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

Образец (из сообщения Отрегулируйте фоновое изображение и заголовок для plot из forceNetwork networkD3) использует 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

person Mark K    schedule 28.12.2018    source источник


Ответы (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

введите описание изображения здесь

person Winicius Sabino    schedule 28.12.2018
comment
Вероятно, полезно указать, что номера индексов в объединенном списке ссылок, вероятно, необходимо будет адаптировать к объединенному списку узлов. - person CJ Yetman; 28.12.2018
comment
@Wincius_Sabino, отличный ответ! похоже, что 4 графика случайным образом помещены вместе. Есть ли способ отличить №1, №2, №3 и №4? Спасибо. - person Mark K; 29.12.2018
comment
@MarkK, я пытаюсь решить аналогичную задачу, различая 4 графика, есть ли способ поставить 2 и более легенд? - person user5249203; 11.07.2019
comment
@CJYetman, возможно ли с networkd3 иметь несколько легенд и цветовых узоров при построении нескольких сетей вместе? - person user5249203; 11.07.2019
comment
нет, это невозможно со встроенной функциональностью - person CJ Yetman; 11.07.2019
comment
@ user5249203, тем временем, вы можете изучить другие инструменты для аналогичных дисплеев. - person Mark K; 12.07.2019