如何在R中生成五层桑基图？代码运行后图表不显示

原代码无法生成桑基图的核心原因是链接中存在大量NA值，以及节点层级逻辑混乱，导致networkD3无法渲染。以下是修正后的完整代码，同时满足五个阶段层级、链接按源阶段统一颜色的需求：

修正后代码 #

library(networkD3)
library(dplyr)
library(tibble)

# 1. 重新整理节点，明确各阶段顺序（避免层级混乱）
stage1_nodes <- unique(data$Species)
stage2_nodes <- unique(data$Method)
stage3_nodes <- c("Fragment", "Fiber", "Foam", "Line") # 形状
stage4_nodes <- c("X0.200.µm", "X200.500.µm", "X500.1000.µm", "X1000.5000.µm") # 尺寸范围
stage5_nodes <- c("PP", "PE", "PS", "PET", "Rayon", "Cellulose", "Acrylic", "Resin", "Nylon", "PBS") # 材料

nodes <- tibble(
  name = c(stage1_nodes, stage2_nodes, stage3_nodes, stage4_nodes, stage5_nodes),
  # 标记节点所属阶段，用于颜色映射
  stage = rep(c("Species", "Method", "Shape", "Size", "Material"), 
              times = c(length(stage1_nodes), length(stage2_nodes), 
                        length(stage3_nodes), length(stage4_nodes), length(stage5_nodes)))
)

# 2. 构建有效链接（确保无NA值）
links <- bind_rows(
  # 阶段1 -> 阶段2：按Species和Method聚合Total，避免重复链接
  data %>% 
    group_by(Species, Method) %>% 
    summarise(value = sum(Total), .groups = "drop") %>% 
    mutate(
      source = match(Species, nodes$name) - 1,
      target = match(Method, nodes$name) - 1
    ) %>% 
    select(source, target, value),
  
  # 阶段2 -> 阶段3：仅保留Component属于形状类的记录，并聚合
  data %>% 
    filter(Component %in% stage3_nodes) %>% 
    group_by(Method, Component) %>% 
    summarise(value = sum(Total), .groups = "drop") %>% 
    mutate(
      source = match(Method, nodes$name) - 1,
      target = match(Component, nodes$name) - 1
    ) %>% 
    select(source, target, value),
  
  # 阶段3 -> 阶段4：按形状到尺寸的映射关系构建链接
  data %>% 
    filter(Component %in% stage3_nodes) %>% 
    group_by(Component) %>% 
    summarise(value = sum(Total), .groups = "drop") %>% 
    mutate(
      source = match(Component, nodes$name) - 1,
      target = match(
        case_when(
          Component == "Fragment" ~ "X0.200.µm",
          Component == "Fiber" ~ "X200.500.µm",
          Component == "Foam" ~ "X500.1000.µm",
          Component == "Line" ~ "X1000.5000.µm"
        ), nodes$name
      ) - 1
    ) %>% 
    select(source, target, value),
  
  # 阶段2 -> 阶段4：直接从方法到尺寸的链接（原数据中存在Method对应尺寸的记录）
  data %>% 
    filter(Component %in% stage4_nodes) %>% 
    group_by(Method, Component) %>% 
    summarise(value = sum(Total), .groups = "drop") %>% 
    mutate(
      source = match(Method, nodes$name) - 1,
      target = match(Component, nodes$name) - 1
    ) %>% 
    select(source, target, value),
  
  # 阶段2 -> 阶段5：直接从方法到材料的链接（原数据中存在Method对应材料的记录）
  data %>% 
    filter(Component %in% stage5_nodes) %>% 
    group_by(Method, Component) %>% 
    summarise(value = sum(Total), .groups = "drop") %>% 
    mutate(
      source = match(Method, nodes$name) - 1,
      target = match(Component, nodes$name) - 1
    ) %>% 
    select(source, target, value)
) %>% 
# 移除无效的NA链接
filter(!is.na(source) & !is.na(target))

# 3. 定义链接颜色：按源节点所属阶段统一颜色
# 为每个阶段分配颜色
stage_colors <- c(
  "Species" = "#1f77b4",
  "Method" = "#ff7f0e",
  "Shape" = "#2ca02c",
  "Size" = "#d62728",
  "Material" = "#9467bd"
)

# 为每个链接匹配源节点的阶段颜色
links <- links %>% 
  mutate(
    source_stage = nodes$stage[source + 1],
    color = stage_colors[source_stage]
  )

# 4. 生成桑基图
sankey <- sankeyNetwork(
  Links = links,
  Nodes = nodes,
  Source = "source",
  Target = "target",
  Value = "value",
  NodeID = "name",
  LinkGroup = "color", # 按颜色分组
  colourScale = JS(d3.scaleOrdinal()
                   .domain(names(stage_colors))
                   .range(unname(stage_colors))),
  units = "Tons",
  fontSize = 12,
  nodeWidth = 30,
  iterations = 0 # 固定节点位置，避免层级混乱
)

sankey

关键修改说明 #

• 节点层级明确：按五个阶段顺序排列节点，避免networkD3自动布局时的层级混乱
• 移除无效链接：过滤掉所有source或target为NA的记录，这是原代码不显示的核心原因
• 聚合重复链接：对同一源-目标对的Total求和，避免重复绘制细链接
• 添加阶段颜色映射：为每个阶段分配专属颜色，链接继承源节点的阶段颜色，满足"链接按源阶段保持一致颜色"的需求
• 补充缺失的链接逻辑：原数据中存在Method直接对应尺寸、材料的记录，补充这些链接以完整展示数据关系

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