使用 R 在 Sankey 图中突出显示从头到尾的所有连接路径

Highlight all connected paths from start to end in Sankey graph using R

我想在单击节点时突出显示整个路径以了解特定节点的整个故事,这是一个示例-http://bl.ocks.org/git-ashish/8959771

请检查这个link,你会发现在 javscript 中突出显示路径的功能,但请注意,这个功能不符合我的要求,它突出显示 links 相关到单击的节点和与目标节点相关的 links。我想要的是突出显示与单击节点相关的所有 link。

d3 Sankey - Highlight all connected paths from start to end

这是我需要的示例, 这是整个图表,我需要的是,当我点击曼谷时,它突出显示数据框中与曼谷相同原始的所有节点,例如突出显示 link 到 ClimateChange 和 EnergyShortage,....然后突出显示基础设施和生态系统,以及领导力和战略,以及...... 这是我想要的。 这是另一张图片,显示了与曼谷有关的节点,使用 shiny 对其进行分析。

这是我在 bl.ocks 和 linked 问题中使用 highlight_node_links 时发生的情况,这是错误的,并且没有显示节点与曼谷之间的关系。

这里是曼谷的数据,向您展示了各列之间的关系,当您使用此数据时,它只会生成第二张图片。

structure(list(City = c("Bangkok", "Bangkok", "Bangkok", "Bangkok", 
"Bangkok", "Bangkok", "Bangkok", "Bangkok", "Bangkok", "Bangkok", 
"Bangkok", "Bangkok", "Bangkok", "Bangkok", "Bangkok", "Bangkok"
), ResiliencyChallenge = c("ClimateChange", "ClimateChange", 
"ClimateChange", "ClimateChange", "ClimateChange", "InfrastructureFaliure", 
"EnergyShortage", "Pollution", "Pollution", "Pollution", "TransportationSystemFailure", 
"TransportationSystemFailure", "TransportationSystemFailure", 
"TransportationSystemFailure", "TransportationSystemFailure", 
"TransportationSystemFailure"), CRI.Dimesnsion.1 = c("Infrastructure & Ecosystems", 
"Infrastructure & Ecosystems", "Infrastructure & Ecosystems", 
"Infrastructure & Ecosystems", "Infrastructure & Ecosystems", 
"Infrastructure & Ecosystems", "Infrastructure & Ecosystems", 
"Leadership & Strategy", "Leadership & Strategy", "Infrastructure & Ecosystems", 
"Infrastructure & Ecosystems", "Infrastructure & Ecosystems", 
"Infrastructure & Ecosystems", "Infrastructure & Ecosystems", 
"Infrastructure & Ecosystems", "Leadership & Strategy"), Implementation.time.frame = c("Short-term", 
"Short-term", "Short-term", "Short-term", "Short-term", "Mid-term", 
"Long-term", "Short-term", "Short-term", "Mid-term", "Mid-term", 
"Short-term", "Short-term", "Short-term", "Short-term", "Short-term"
), Goal = c("Goal13", "Goal13", "Goal13", "Goal13", "Goal13", 
"Goal12", "Goal12", "Goal11", "Goal11", "Goal11", "Goal11", "Goal11", 
"Goal11", "Goal11", "Goal11", "Goal11")), .Names = c("City", 
"ResiliencyChallenge", "CRI.Dimesnsion.1", "Implementation.time.frame", 
"Goal"), class = "data.frame", row.names = c(NA, -16L))

鉴于您提供的 R 代码数据结构...

首先,sankeyNetwork 需要列出 edges/links 的数据以及由这些 link 连接的节点。您的数据具有...让我们称之为以 "traveler" 为中心的格式,其中数据的每一行都与特定的 "path" 相关。因此,首先您需要将该数据转换为 sankeyNetwork 需要的数据类型,同时保留识别 links 到它们来自的路径所需的信息。此外,您的数据中只有一个城市,因此除非您的数据中的路径至少有两个不同的来源,否则很难看到结果,因此我将复制它并将第二组归因于另一个城市。这是一个例子...

library(tidyverse)

# duplicate the data for another city so we have more than 1 origin
links <-
  df %>%
  full_join(mutate(df, City = "Hong Kong")) %>%
  mutate(row = row_number()) %>%
  mutate(origin = .[[1]]) %>%
  gather("column", "source", -row, -origin) %>%
  mutate(column = match(column, names(df))) %>%
  arrange(row, column) %>%
  group_by(row) %>%
  mutate(target = lead(source)) %>%
  ungroup() %>%
  filter(!is.na(target)) %>%
  select(source, target, origin) %>%
  group_by(source, target, origin) %>%
  summarise(count = n()) %>%
  ungroup()

nodes <- data.frame(name = unique(c(links$source, links$target)))
links$source <- match(links$source, nodes$name) - 1
links$target <- match(links$target, nodes$name) - 1

现在您有一个 linksnodes 数据框,其格式符合 sankeyNetwork 的预期,并且 links 数据框有一个额外的列 origin 标识每个 link 所在的城市。您现在可以使用 sankeyNetwork 绘制它,添加回原始数据,因为它被剥离,然后使用 htmlwidgets::onRender 分配一个点击行为,改变任何 link 的不透明度,其来源是被点击的城市节点...

library(networkD3)
library(htmlwidgets)

sn <- sankeyNetwork(Links = links, Nodes = nodes, Source = 'source',
                    Target = 'target', Value = 'count', NodeID = 'name')

# add origin back into the links data because sankeyNetwork strips it out
sn$x$links$origin <- links$origin


# add onRender JavaScript to set the click behavior
htmlwidgets::onRender(
  sn,
  '
  function(el, x) {
    var nodes = d3.selectAll(".node");
    var links = d3.selectAll(".link");
    nodes.on("mousedown.drag", null); // remove the drag because it conflicts
    nodes.on("click", clicked);
    function clicked(d, i) {
      links
        .style("stroke-opacity", function(d1) {
            return d1.origin == d.name ? 0.5 : 0.2;
          });
    }
  }
  '
)

这是上述答案的简化版本(具有较小的示例数据集),它使每个 "path" 分开,而不是像路径一样聚合并递增 count/Value 变量。

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

df <- read.csv(header = T, as.is = T, text = '
name,origin,layover,destination
Bob,Baltimore,Chicago,Los Angeles
Bob,Baltimore,Chicago,Seattle
Bob,New York,St Louis,Austin
Bob,New York,Chicago,Seattle
Tom,Baltimore,Chicago,Los Angeles
Tom,New York,St Louis,San Diego
Tom,New York,Chicago,Seattle
Tom,New York,New Orleans,Austin
')

links <-
  df %>%
  mutate(row = row_number()) %>%
  mutate(traveler = .[[1]]) %>%
  gather("column", "source", -row, -traveler) %>%
  mutate(column = match(column, names(df))) %>%
  arrange(row, column) %>%
  group_by(row) %>%
  mutate(target = lead(source)) %>%
  ungroup() %>%
  filter(!is.na(target)) %>%
  select(source, target, traveler) %>%
  group_by(source, target, traveler) %>%
  summarise(count = n()) %>%
  ungroup()

nodes <- data.frame(name = unique(c(links$source, links$target)))
links$source <- match(links$source, nodes$name) - 1
links$target <- match(links$target, nodes$name) - 1

sn <- sankeyNetwork(Links = links, Nodes = nodes, Source = 'source',
                    Target = 'target', Value = 'count', NodeID = 'name')

# add origin back into the links data because sankeyNetwork strips it out
sn$x$links$traveler <- links$traveler

# add onRender JavaScript to set the click behavior
htmlwidgets::onRender(
  sn,
  '
  function(el, x) {
    var nodes = d3.selectAll(".node");
    var links = d3.selectAll(".link");
    nodes.select("rect").style("cursor", "pointer");
    nodes.on("mousedown.drag", null); // remove the drag because it conflicts
    //nodes.on("mouseout", null);
    nodes.on("click", clicked);
    function clicked(d, i) {
      links
        .style("stroke-opacity", function(d1) {
            return d1.traveler == d.name ? 0.5 : 0.2;
          });
    }
  }
  '
)

这个问题的实现在这个闪亮的应用程序中。

https://setsna2.shinyapps.io/sankey-shinyforallcities/

我不得不从内部修改 networkD3,我正常安装它并将其复制到包含闪亮应用程序的目录中,并将包放入 R-lib 中。

我对绘制桑基图的 sankeyNetwork.js 函数做了一些修改。 这是目录的图片,它显示了目录的结构,可以到达 sankeyNetwork.js 手动更改它的地方。

请注意我在这个问题中使用和上传的 sankeyNetwork.js 版本是旧的,它是 2 年前的,所以你可以下载新版本的 networkD3 并修改部分接下来我会提到。 我在 sankeyNetwork.js 中所做的更改是添加

    .on('mouseover', function(node) {
        Shiny.onInputChange("node_name", node.name);
    })

这意味着如果有人将鼠标悬停在节点上,我将使用 Shiny.onInputChange 将节点名称作为 "node_name" 变量传输到我的 R 会话,您可以在线阅读有关此闪亮功能的更多信息。

这是sankeyNetwork.js我曾经知道我的意思。

现在,如果有人悬停在一个节点上,我可以获得该节点的名称并将其发送到 R,如果他移开光标,我将不会获得任何名称,这是核心思想。

您可以点击here

查看我闪亮应用的代码

您可以看到 Data0 变量的一部分 here also Goals variable from here

在 R 代码中,你会发现一些注释 "for debug use this code" 或代码中的注释,所以如果你 运行 这些注释,你将了解数据在 [=75= 之前的样子]使用闪亮的应用程序以充分了解桑基图如何读取数据以及它应该是什么样子。

在 R 代码中,您会发现这部分正在从 sankeyNetwork.js

读取 node_name
        NodeName <- reactive({ 
                if(length(input$node_name)>0){return(as.character(input$node_name))}
                else{return(0)}
        })

然后代码的下一部分是检查 NodeName 是否在我的 Nodes 数据框中,如果存在,那么我将获取与该节点相关的所有节点,然后我将获取将这些节点相互连接的链接 ID,请注意链接 ID 从 0 开始,而不是从 1 开始,因为 javascript 从 0 开始,而 R 开始从 1.

现在我们有了用户悬停的NodeName,以及与这个节点相关的Links,现在我们可以制作sankey图并将其保存在sn , 然后我删除旧的工具提示并添加一个新的。

使用 onRender 在使用闪亮的同时修改桑基图,我用它来制作 突出显示功能 在 运行 闪亮的同时修改桑基图当用户将鼠标悬停在节点上时,我将获取节点的名称,然后获取链接 ID 并在现有的 sankey 图中搜索链接 ID 并增加其不透明度。

请注意,如果你 运行 应用程序,你会遇到错误,你必须将其上传到 shinyapps.io 以调试它,这就是我检查我的应用程序是否正常工作的方式或者不是,也许你可以找到另一种调试方法。