从networkd3 sankey图中提取结果

Question

我是新来的，这是我第二次发帖，因为之前的帖子被删除了，我不知道问题是什么，如果你能在删除帖子之前说明原因，那就太好了。

所以我再试一次...

这个问题可能非常基本，因为我刚刚开始使用networkd3，所以请原谅。我尝试在网上寻求帮助，但不幸的是找不到任何东西。我想知道是否有任何特定的方法来提取 networkd3 图的结果。

我正在尝试提取桑基图结果节点的顺序，以便将其用作其他图的输入，但无法弄清楚如何提取此信息。

我知道通过使用 iterations=0 我可以手动对节点进行排序，但我想获得有序的节点，这样它看起来更干净，更容易解释。

编辑：包括我在互联网上找到的基本代码并稍加修改以供参考。

# Library
library(networkD3)
library(dplyr)
 
# A connection data frame is a list of flows with intensity for each flow
links <- data.frame(
  source=c("A","A", "B", "C", "C", "E"), 
  target=c("1","3", "3", "3", "2", "1"), 
  value=c(2,3, 2, 3, 1, 3)
  )
 
# From these flows we need to create a node data frame: it lists every entities involved in the flow
nodes <- data.frame(
  name=c(as.character(links$source), 
  as.character(links$target)) %>% unique()
)
 
# With networkD3, connection must be provided using id, not using real name like in the links dataframe.. So we need to reformat it.
links$IDsource <- match(links$source, nodes$name)-1 
links$IDtarget <- match(links$target, nodes$name)-1
 
# Make the Network
p <- sankeyNetwork(Links = links, Nodes = nodes,
              Source = "IDsource", Target = "IDtarget",
              Value = "value", NodeID = "name", 
              sinksRight=FALSE)

我想知道是否有可能从桑基图中提取目标节点的顺序。

Answer 1

让 JavaScript 将值发送回 R 并不容易，但闪亮的包可以做到这一点。所以你可以添加一些 JavaScript 来使用

htmlwidgets::onRender()

来获取你想要的信息，然后通过闪亮的东西将其发回...

# Library
library(networkD3)
library(dplyr)

# A connection data frame is a list of flows with intensity for each flow
links <- data.frame(
  source=c("A","A", "B", "C", "C", "E"), 
  target=c("1","3", "3", "3", "2", "1"), 
  value=c(2,3, 2, 3, 1, 3)
)

# From these flows we need to create a node data frame: it lists every entities involved in the flow
nodes <- data.frame(
  name=c(as.character(links$source), 
         as.character(links$target)) %>% unique()
)

# With networkD3, connection must be provided using id, not using real name like in the links dataframe.. So we need to reformat it.
links$IDsource <- match(links$source, nodes$name)-1 
links$IDtarget <- match(links$target, nodes$name)-1

# Make the Network
p <- sankeyNetwork(Links = links, Nodes = nodes,
                   Source = "IDsource", Target = "IDtarget",
                   Value = "value", NodeID = "name", 
                   sinksRight=FALSE)


widget <- htmlwidgets::onRender(
  p,
  '
  function(el, x) {
    let sankey = this.sankey;
    let x_of_last_col = Math.max(...sankey.nodes().map(d => d.x));
    var nodes_in_last_col = sankey.nodes().filter(d => d.x == x_of_last_col);
    nodes_in_last_col = nodes_in_last_col.sort((a,b) => a.y > b.y);
    let json_output = JSON.stringify(nodes_in_last_col.map(d => [d.name, d.y]));
    Shiny.setInputValue("x", json_output);
  }
  '
)

node_order <- shiny::runApp(list(
  ui = shiny::bootstrapPage(shiny::textInput("x", "x"), sankeyNetworkOutput("plot")),
  server = function(input, output, session) {
    output$plot <- renderSankeyNetwork({widget});
    shiny::observeEvent(input$x, { shiny::stopApp(input$x) }, ignoreInit = TRUE)
  }
))

jsonlite::fromJSON(node_order)
#>      [,1] [,2]              
#> [1,] "1"  "9.99999999999999"
#> [2,] "3"  "173.571428571429"
#> [3,] "2"  "429.285714285714"