使用networkD3绘制Sankey图时添加节点百分比的问题

使用networkD3::sankeyNetwork()绘制桑基图时，希望在节点标签旁/下方显示百分比。添加百分比代码后，虽生成了百分比但数值错误（期望正确计算节点流量占比），且原正常显示的节点名称出现异常。

示例数据 #

df <-
  structure(
    list(
      flow_1 = c(
        "myocardial infarction",
        "myocardial infarction",
        "myocardial infarction",
        "myocardial infarction",
        "myocardial infarction",
        "myocardial infarction",
        "angina pectoris",
        "angina pectoris",
        "angina pectoris",
        "angina pectoris",
        "angina pectoris",
        "angina pectoris",
        "ischaemia",
        "ischaemia",
        "ischaemia",
        "ischaemia",
        "ischaemia",
        "ischaemia"
      ),
      flow_2 = c(
        "death",
        "myocardial infarction",
        "heart failure",
        "cardiac rhythm disorders",
        "angina pectoris",
        "ischaemia",
        "death",
        "myocardial infarction",
        "heart failure",
        "cardiac rhythm disorders",
        "angina pectoris",
        "ischaemia",
        "death",
        "myocardial infarction",
        "heart failure",
        "cardiac rhythm disorders",
        "angina pectoris",
        "ischaemia"
      ),
      flow_3 = c(
        NA,
        "death",
        "death",
        "heart failure",
        "cardiac rhythm disorders",
        "angina pectoris",
        NA,
        "death",
        "death",
        "death",
        "cardiac rhythm disorders",
        "death",
        NA,
        "death",
        "death",
        "heart failure",
        "cardiac rhythm disorders",
        "angina pectoris"
      )
    ),
    class = c("tbl_df", "tbl", "data.frame"),
    row.names = c(NA,-18L)
  )

尝试的代码 #

library(dplyr)
library(tidyverse)
library(networkD3)
library(RColorBrewer)

plt <- sankeyNetwork(Links = links2, Nodes = nodes,
                     Source = "IDsource", 
                     Target = "IDtarget",
                     Value = "value", 
                     NodeID = "name",
                     nodeWidth = 8,
                     nodePadding = 15,
                     fontFamily = "Arial"
)

df3 <- df %>%
  group_by(Source) %>%
  mutate(sPerc = paste0(round(sum(Value) / sum(df3$Value) * 100, 2), "%")) %>% 
  group_by(Destination) %>% 
  mutate(dPerc = paste0(round(sum(Value) / sum(df3$Value) * 100, 2), "%")) %>% 
  pivot_longer(c(Destination, Source)) %>% 
  mutate(Perc = ifelse(name == "Destination",
                       dPerc, sPerc)) %>%  
  select(Value, value, Perc) %>%           
  group_by(value, Perc) %>% 
  summarise(Value = sum(Value)) 

plt$x$nodes <- right_join(plt$x$nodes, df3, by = c("name" = "value"))

htmlwidgets::onRender(plt, '
                      function(el, x) {
                        d3.select(el).selectAll(".node text")
                          .text(d => d.name + " (" + d.value + ")" + " (" + d.Perc + ")")
                      }')

解决方案 #

1. 正确转换数据为桑基图格式 #

先将宽格式数据转为桑基图所需的边列表和节点列表：

# 转换为边列表
links_raw <- df %>%
  mutate(row_id = row_number()) %>%
  pivot_longer(cols = starts_with("flow_"), names_to = "level", values_to = "node") %>%
  filter(!is.na(node)) %>%
  group_by(row_id) %>%
  mutate(next_node = lead(node)) %>%
  filter(!is.na(next_node)) %>%
  ungroup() %>%
  select(source = node, target = next_node) %>%
  count(source, target, name = "value")

# 生成节点列表（networkD3使用0索引）
nodes <- data.frame(name = unique(c(links_raw$source, links_raw$target)))
nodes$id <- seq(nrow(nodes)) - 1

# 转换边列表的节点名称为ID
links <- links_raw %>%
  left_join(nodes, by = c("source" = "name")) %>%
  rename(IDsource = id) %>%
  left_join(nodes, by = c("target" = "name")) %>%
  rename(IDtarget = id) %>%
  select(IDsource, IDtarget, value)

2. 计算节点总流量与百分比 #

统计每个节点的总流量，并计算其占整体总流量的百分比：

# 计算每个节点的总流量（流入/流出一致）
node_totals <- links %>%
  group_by(IDsource) %>%
  summarise(total = sum(value)) %>%
  left_join(nodes, by = c("IDsource" = "id")) %>%
  select(name, total) %>%
  full_join(
    links %>%
      group_by(IDtarget) %>%
      summarise(total = sum(value)) %>%
      left_join(nodes, by = c("IDtarget" = "id")) %>%
      select(name, total),
    by = "name"
  ) %>%
  mutate(total = coalesce(total.x, total.y)) %>%
  select(name, total)

# 计算整体总流量（除以2避免重复统计边的流入流出）
grand_total <- sum(node_totals$total) / 2

# 计算百分比
node_totals <- node_totals %>%
  mutate(perc = paste0(round(total / grand_total * 100, 2), "%"))

3. 绘制桑基图并修改标签 #

# 创建桑基图对象
plt <- sankeyNetwork(
  Links = links,
  Nodes = nodes,
  Source = "IDsource",
  Target = "IDtarget",
  Value = "value",
  NodeID = "name",
  nodeWidth = 8,
  nodePadding = 15,
  fontFamily = "Arial"
)

# 合并百分比数据到节点
plt$x$nodes <- plt$x$nodes %>%
  left_join(node_totals, by = "name")

# 修改标签显示，将百分比放在计数下方
htmlwidgets::onRender(plt, '
function(el, x) {
  d3.select(el).selectAll(".node text")
    .text(d => d.name + "\\n(" + d.total + ") (" + d.perc + ")");
}')

问题说明 #

• 原代码错误：引用未定义的df3$Value，且未正确统计桑基图节点的流量逻辑。
• 桑基图总流量需除以2，因为每条边的流量会被同时计入源节点流出和目标节点流入，导致重复统计。
• 使用\\n实现百分比在计数下方的显示效果。

内容的提问来源于stack exchange，提问作者Rokit87