You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

基于R语言复刻Sankey/Chord图的技术求助:路径类数据可视化

三级路径可视化复刻优化方案

问题背景

我在浏览网页时发现一款优秀的可视化图表,希望在项目中复刻它。项目需要呈现左侧为Main.Path、中间为Group、右侧为Sub.Path的三级路径关系。尝试用Chord图复刻失败后改用Sankey图,但输出效果仍远未达到预期。以下是数据结构、当前代码及输出截图,恳请提供改进建议、参考资料或相关意见。

数据概览

dput(chord)
structure(list(X = 1:61, Group = c("Annelida", "Annelida", "Annelida", 
"Annelida", "Annelida", "Bryozoan ", "Chromista", "Cnidaria", 
"Cnidaria", "Cnidaria", "Cnidaria", "Cnidaria", "Crustaceans", 
"Crustaceans", "Crustaceans", "Crustaceans", "Crustaceans", "Crustaceans", 
"Crustaceans", "Crustaceans", "Crustaceans", "Crustaceans", "Crustaceans", 
"Crustaceans", "Crustaceans", "Fishes", "Fishes", "Fishes", "Fishes", 
"Fishes", "Fishes", "Fishes", "Fishes", "Fishes", "Fishes", "Fishes", 
"Fishes", "Fishes", "Fishes", "Fishes", "Fishes", "Mollusks", 
"Mollusks", "Mollusks", "Mollusks", "Mollusks", "Mollusks", "Mollusks", 
"Mollusks", "Mollusks", "Mollusks", "Mollusks", "Mollusks", "Mollusks", 
"Mollusks", "Mollusks", "Mollusks", "Mollusks", "Mollusks", "Mollusks", 
"Platyhelminthes"), Main.Path = c("Contaminant & Stowaway", "Contaminant & Stowaway", 
"Corridor", "Release", "Release", "Contaminant & Stowaway", "Contaminant & Stowaway", 
"Contaminant & Stowaway", "Contaminant & Stowaway", "Contaminant & Stowaway", 
"Corridor", "Corridor", "Contaminant & Stowaway", "Contaminant & Stowaway", 
"Contaminant & Stowaway", "Contaminant & Stowaway", "Corridor", 
"Corridor", "Corridor", "Escape", "Escape", "Release", "Release", 
"Release", "Release", "Contaminant & Stowaway", "Contaminant & Stowaway", 
"Contaminant & Stowaway", "Corridor", "Corridor", "Corridor", 
"Corridor", "Escape", "Escape", "Escape", "Escape", "Release", 
"Release", "Release", "Release", "Release", "Contaminant & Stowaway", 
"Contaminant & Stowaway", "Contaminant & Stowaway", "Contaminant & Stowaway", 
"Contaminant & Stowaway", "Corridor", "Corridor", "Corridor", 
"Corridor", "Corridor", "Escape", "Escape", "Escape", "Escape", 
"Escape", "Release", "Release", "Release", "Release", "Corridor"
), Sub.Path = c("Other", "Shipping", "Interconnected waterways", 
"Interconnected waterways", "Other", "Other", "Shipping", "Interconnected waterways", 
"Other", "Shipping", "Interconnected waterways", "Shipping", 
"Food production", "Interconnected waterways", "Other", "Shipping", 
"Food production", "Interconnected waterways", "Shipping", "Food production", 
"Interconnected waterways", "Food production", "Interconnected waterways", 
"Other", "Shipping", "Food production", "Interconnected waterways", 
"Shipping", "Food production", "Interconnected waterways", "Shipping", 
"Trade", "Food production", "Interconnected waterways", "Other", 
"Trade", "Food production", "Interconnected waterways", "Other", 
"Shipping", "Trade", "Food production", "Interconnected waterways", 
"Other", "Shipping", "Trade", "Food production", "Interconnected waterways", 
"Other", "Shipping", "Trade", "Food production", "Interconnected waterways", 
"Other", "Shipping", "Trade", "Food production", "Interconnected waterways", 
"Other", "Shipping", "Interconnected waterways"), n = c(7L, 1L, 
2L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 4L, 9L, 3L, 6L, 8L, 23L, 
2L, 6L, 5L, 10L, 13L, 5L, 1L, 1L, 3L, 1L, 4L, 13L, 1L, 2L, 7L, 
3L, 1L, 4L, 5L, 4L, 1L, 1L, 3L, 1L, 2L, 2L, 2L, 1L, 1L, 2L, 1L, 
2L, 1L, 2L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L)), class = "data.frame", row.names = c(NA, 
-61L))

当前代码

chord <- read.csv("matrix.csv")

group_colors <- c(
  "Fishes" = "#1b9e77",
  "Crustaceans" = "#d95f02",
  "Molluscs" = "#7570b3",
  "Annelida" = "#e7298a",
  "Mollusks" = "yellow",
  "Cnidaria" = "red",
  "Bryozoan " = "green",
  "Platyhelminthes" = "black")

links <- data.frame(
  source = c(as.character(chord$Main.Path), as.character(chord$Group)),
  target = c(as.character(chord$Group), as.character(chord$Sub.Path)),
  value = c(chord$n, chord$n))

nodes <- data.frame(name = unique(c(links$source, links$target)))

links$Group <- ifelse(
  links$target %in% names(group_colors),               # Main.Path → Group
  links$target,
  ifelse(links$source %in% names(group_colors),        # Group → Sub.Path
         links$source, "Other"))

color_js <- paste0(
  'd3.scaleOrdinal() .domain(["',
  paste(names(group_colors), collapse = '","'),
  '","Other"]) .range(["',
  paste(unname(group_colors), collapse = '","'),
  '","#222222"])' )

links$source <- match(links$source, nodes$name) - 1
links$target <- match(links$target, nodes$name) - 1

sankeyNetwork(
  Links = links, Nodes = nodes, 
  Source = "source", Target = "target",
  Value = "value", NodeID = "name",
  LinkGroup = "Group",
  colourScale = color_js,
  fontSize = 12, nodeWidth = 30
)

当前输出效果

当前Sankey图输出

核心改进建议

1. 强制固定三级节点层级

当前Sankey图的节点自动排列,无法保证左-中-右的三级结构。可以通过以下方式强制层级:

  • 给节点添加层级标记:
    library(dplyr)
    nodes$level <- case_when(
      nodes$name %in% unique(chord$Main.Path) ~ 0,
      nodes$name %in% unique(chord$Group) ~ 1,
      nodes$name %in% unique(chord$Sub.Path) ~ 2
    )
    
  • 用自定义D3逻辑固定节点位置:
    library(htmlwidgets)
    sankeyNetwork(...) %>% 
      onRender("
        function(el, x) {
          d3.select(el).selectAll('.node')
            .attr('transform', function(d) { 
              return 'translate(' + d.level * 250 + ',' + d.y + ')'; 
            });
        }
      ")
    

2. 修正数据与颜色映射问题

  • 统一拼写:group_colors中同时存在"Molluscs"和"Mollusks",需统一为数据中的"Mollusks",避免颜色失效。
  • 简化链路颜色关联:直接基于Group节点匹配颜色,确保上下游链路与中间Group颜色一致:
    main_to_group <- chord %>% 
      group_by(Main.Path, Group) %>% 
      summarise(value = sum(n), .groups = "drop") %>% 
      mutate(LinkGroup = Group)
    
    group_to_sub <- chord %>% 
      group_by(Group, Sub.Path) %>% 
      summarise(value = sum(n), .groups = "drop") %>% 
      mutate(LinkGroup = Group)
    
    links <- rbind(main_to_group, group_to_sub) %>% 
      rename(source = 1, target = 2)
    

3. 预处理数据合并重复链路

当前代码直接拼接原始数据,导致同一来源-目标组合出现多条重复链路,需先汇总数值:

# 汇总Main→Group的总流量
main_group_sum <- chord %>% 
  group_by(Main.Path, Group) %>% 
  summarise(value = sum(n), .groups = "drop")

# 汇总Group→Sub的总流量
group_sub_sum <- chord %>% 
  group_by(Group, Sub.Path) %>% 
  summarise(value = sum(n), .groups = "drop")

# 合并为最终链路数据
links <- rbind(
  main_group_sum %>% rename(source = Main.Path, target = Group),
  group_sub_sum %>% rename(source = Group, target = Sub.Path)
)

4. 优化布局参数提升视觉效果

  • 调整nodePadding(节点垂直间距)为20左右,避免标签重叠;
  • 增大图表width和height参数,预留足够展示空间;
  • 增加iterations参数(如50),让链路布局更平滑;
  • 调整fontSize为适配大小,避免文字截断。

5. 改用更灵活的可视化工具

如果networkD3自定义能力不足,可尝试:

  • ggalluvial:基于ggplot2,层级控制更精准:
    library(ggalluvial)
    ggplot(chord,
           aes(y = n, axis1 = Main.Path, axis2 = Group, axis3 = Sub.Path)) +
      geom_alluvium(aes(fill = Group), width = 1/12) +
      geom_stratum(width = 1/12, fill = "white", color = "black") +
      geom_text(stat = "stratum", aes(label = after_stat(stratum))) +
      scale_fill_manual(values = group_colors) +
      scale_x_discrete(limits = c("Main.Path", "Group", "Sub.Path"), expand = c(0.05, 0.05)) +
      theme_minimal()
    
  • D3.js原生开发:完全复刻目标图表的交互与样式,适合高度定制化需求。

内容的提问来源于stack exchange,提问作者Isma Soto Almena

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.12 20:44:54