在使用R语言创建桑基图时，如何突出显示从起点到终点的所有连接路径。

Question

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

请检查此链接，您将找到突出显示路径的JavaScript函数，请注意，此函数不执行我想要的操作，它突出显示与单击节点相关的链接以及目标节点相关的链接。我想要的是突出显示与单击节点相关的所有链接。

d3桑基图-突出显示从起点到终点的所有连接路径

这是我所需要的一个示例， 这是整个图形，我需要的是，当我单击曼谷时，它会突出显示与数据框中曼谷在同一行的所有节点，例如突出显示到ClimateChange和EnergyShortage的链接，然后突出Infrastructure&Ecosystems和Leadership&strategy等。 这就是我想要的。 这里是另一张使用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))

- Omar Abd El-Naser

---

你想用JavaScript还是使用networkD3中的R语言？你复制粘贴的代码是使用networkD3的R语言...在该代码的结果中，当你悬停在一个节点上时，它已经实现了你想要的功能，突出显示与该节点相关的所有链接。你希望它在单击时起作用吗？或者你正在寻找一个JavaScript实现networkD3输出的方法，在悬停时突出显示节点的链接？ - CJ Yetman

我想要突出显示与所点击节点相关的所有节点和链接，这只能通过Javascript实现。当我尝试将此功能插入到networkD3中时，发现必须使用htmlwidget中的onRender。但是我无法成功，当我尝试通过操作sankeyNetwork小部件手动更改networkD3的内容时，我成功了。但是我发现上面链接中的Javascript函数highlight_node_links是错误的，它不能实现我想要的效果，请帮帮我。 - Omar Abd El-Naser

你能更具体地说明你所说的“相关”是什么意思吗？并且具体解释一下你想要的行为与你发布的 JavaScript 示例以及 networkD3 的默认悬停行为有何不同？ - CJ Yetman

我会上传一张图片来展示我的数据，这样你就明白我的意思了，谢谢。 - Omar Abd El-Naser

你想要在networkD3的输出中获得默认的悬停行为，但是你希望它在点击时发生？ - CJ Yetman

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

- CJ Yetman

Answer 2

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

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

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

我对绘制桑基图的sankeyNetwork.js函数进行了一些修改。 这里是一个目录的图片，显示了到达具有sankeyNetwork.js的位置以手动更改它的目录结构。

请注意，我在此问题中使用和上传的sankeyNetwork.js版本已经过时，是两年前的版本，因此您可以下载新版本的networkD3，然后只需修改我将在下面提到的部分。 我在sankeyNetwork.js中所做的更改是添加了

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

这意味着如果有人将光标悬停在一个节点上，我将使用Shiny.onInputChange将节点名称作为“node_name”变量传输到我的R会话中，您可以在网上了解更多关于这个闪亮的函数。

这是我用来了解自己意思的 sankeyNetwork.js。

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

您可以通过点击此处查看我的闪亮应用程序代码。

您可以在这里看到Data0变量的一部分，也可以从这里看到Goals变量。

在R代码中，您会发现一些注释说“用于调试使用此代码”或在代码内的注释，因此如果您运行这些注释，您将了解在运行闪亮应用程序之前数据的外观以充分了解桑基图如何读取数据以及它应该是什么样子。

在R代码中，您将找到这个部分，它正在从sankeyNetwork.js读取节点名称。

        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，现在我们可以制作桑基图并将其保存在sn中，然后删除旧的工具提示并添加新的工具提示。

使用onRender来修改sankey图表，同时使用shiny，我使用它来制作高亮功能，以便在运行shiny时修改sankey图表，当用户悬停在节点上时，我将获取节点的名称，然后获取链接ID并搜索现有的sankey图表中的链接ID，并增加其不透明度。

请注意，如果您运行该应用程序，您将会遇到错误，您需要将其上传至shinyapps.io进行调试，这是我检查应用程序是否正常工作的方式，也许您可以找到其他调试方式。

- Omar Abd El-Naser