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

Question

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

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

d3 Sankey - 突出显示从头到尾的所有连接路径

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

这是我在块和链接问题中使用 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并且数据框有一个额外的列，用于标识每个链接在路径上的哪个城市。您现在可以用 绘制它，在原始数据被剥离后重新添加，然后使用它来分配一个点击行为，该行为会改变任何链接的不透明度，其来源是被点击的城市节点......nodessankeyNetworklinksoriginsankeyNetworkhtmlwidgets::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;
          });
    }
  }
  '
)

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

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

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

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

你可以点击这里查看我闪亮的应用程序的代码

您可以在此处看到部分Data0变量，也可以从此处看到变量。Goals

在 R 代码中，您会发现一些注释说“用于调试，请使用此代码”或代码中的注释，因此如果您运行这些注释，您将了解数据的外观，然后再运行闪亮的应用程序以充分了解 sankey 图的读取方式数据及其外观。

在 R 代码中，你会发现这部分正在读取 node_namesankeyNetwork.js

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

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

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

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

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