r - 使用 R 在 Sankey 图中突出显示从开始到结束的所有连接路径

Question

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

请检查此链接，您将找到在 javscript 中突出显示路径的功能，但请注意，此功能不符合我的要求，它突出显示了与点击节点相关的链接和与目标节点相关的链接。我想要的是突出显示与点击节点相关的所有链接。

d3 Sankey - Highlight all connected paths from start to end

这是我需要的一个例子，

这是整个图表，我需要的是，当我单击曼谷时，它会突出显示数据框中与曼谷处于同一原始状态的所有节点，例如突出显示指向气候变化和能源短缺的链接，......然后突出显示基础设施和生态系统，和领导力与战略，以及......
这就是我想要的。
这是另一张图片，显示了与曼谷相关的节点，使用 Shiny 对其进行分析。



这是当我在 bl.ocks 和链接问题中使用 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))

Answer 1

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

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

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

现在你有一个 links和 nodes格式为 sankeyNetwork 的数据框预计，和 links数据框有一个额外的列 origin标识每个链接在路径上的哪个城市。您现在可以使用 sankeyNetwork 绘制此图，添加回原始数据，因为它被剥离了，然后使用 htmlwidgets::onRender分配一个点击行为，改变任何链接的不透明度，其起源是被点击的城市节点......

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;
          });
    }
  }
  '
)

这是上述答案的简化版本(使用较小的示例数据集)，它将每个“路径”分开，而不是聚合类似的路径并增加计数/值变量。

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;
          });
    }
  }
  '
)