如何用ggalluvial/ggsankey为桑基图不同轴间分段设置不同颜色？

我使用R的ggalluvial包绘制冲积图，希望为各轴之间的分段设置不同颜色：

• 轴1的A指向轴2的B和C，这两段需用不同颜色
• 轴2到轴3时，B指向B沿用之前的颜色；C指向D、E、F则用三种不同颜色

但当前绘制的图中，末端K的颜色会回溯至起始A，因此想咨询：该需求是否可行？或者改用geom_sankey是否更合适？

测试代码 #

library(ggalluvial)
library(ggplot2)
library(dplyr)
library(ggeasy)

test <- data.frame(
  one = c("A", "A", "A", "A", "A", "A"),
  two = c("B", "C", "C", "C", "C", "C"),
  three = c("B", "D", "E", "F", "F", "F"),
  four = c("B", "D", "E", "F", "F", "G"),
  five = c("B", "D", "E", "I", "J", "G"),
  six = c("B", "D", "E", "I", "K", "K"),
  y = c(102, 89, 48, 75, 826, 7394)
)

test$two <- factor(test$two, levels = c("B", "C"))

test$three <- factor(test$three, levels = c("B", "D", "E", "F"))

test$four <- factor(test$four, levels = c("B", "D", "E", "F", "G"))

test$five <- factor(test$five, levels = c("B", "D", "E", "I", "J", "G"))

test$six <- factor(test$six, levels = c("B", "D", "E", "I", "K"))

g <- ggplot(data = test, aes(
  axis1 = one,
  axis2 = two,
  axis3 = three,
  axis4 = four,
  axis5 = five,
  axis6 = six,
  y = y
)) +
  geom_alluvium(aes(fill = six), curve_type = "cubic",width = 1 / 4, aes.bind = TRUE) +
  geom_stratum(width = 1 / 4, color = "black", alpha = 0.25) +
  geom_text(stat = "stratum", aes(label = after_stat(stratum))) +
  theme_classic() +
  theme(text = element_text(family = "serif", size = 30, color = "black")) +
  theme(axis.text.x = element_text(size = 30, color = "black")) +
  theme(axis.ticks.x = element_blank()) +
  theme(axis.line.x = element_blank()) +
  theme(legend.position = "none") +
  easy_remove_y_axis()+
  easy_remove_x_axis()

g

当前效果 #

解决方案 #

1. 使用ggalluvial实现分段着色 #

ggalluvial默认按整条流的分组（比如你用fill = six）统一着色，要实现分段不同颜色，需要拆分每一对相邻轴的连接，为每段创建唯一标识用于颜色映射：

library(ggalluvial)
library(ggplot2)
library(dplyr)
library(tidyr)
library(ggeasy)

test <- data.frame(
  one = c("A", "A", "A", "A", "A", "A"),
  two = c("B", "C", "C", "C", "C", "C"),
  three = c("B", "D", "E", "F", "F", "F"),
  four = c("B", "D", "E", "F", "F", "G"),
  five = c("B", "D", "E", "I", "J", "G"),
  six = c("B", "D", "E", "I", "K", "K"),
  y = c(102, 89, 48, 75, 826, 7394)
)

# 将宽格式数据转换为长格式，拆分相邻轴的连接段
test_long <- test %>%
  pivot_longer(cols = -y, names_to = "axis", values_to = "category") %>%
  mutate(axis_num = as.integer(factor(axis, levels = c("one", "two", "three", "four", "five", "six")))) %>%
  group_by(y) %>%
  # 为每条流添加下一个节点的信息
  mutate(next_category = lead(category), next_axis = lead(axis_num)) %>%
  filter(!is.na(next_category)) %>%
  ungroup() %>%
  # 为每个连接段创建唯一ID
  mutate(segment_id = paste(category, next_category, sep = "->"))

# 绘制分段着色的冲积图
ggplot(test_long, aes(x = axis_num, stratum = category, alluvium = y, y = y)) +
  geom_alluvium(aes(fill = segment_id), curve_type = "cubic", width = 1/4) +
  geom_stratum(width = 1/4, color = "black", alpha = 0.25) +
  geom_text(stat = "stratum", aes(label = after_stat(stratum))) +
  scale_x_continuous(breaks = 1:6, labels = c("one", "two", "three", "four", "five", "six")) +
  theme_classic() +
  theme(text = element_text(family = "serif", size = 30, color = "black")) +
  theme(axis.text.x = element_text(size = 30, color = "black")) +
  theme(axis.ticks.x = element_blank()) +
  theme(axis.line.x = element_blank()) +
  theme(legend.position = "none") +
  easy_remove_y_axis() +
  easy_remove_x_axis()

2. 改用ggforce的geom_sankey实现 #

如果觉得ggalluvial的分段处理繁琐，ggforce包的geom_sankey更适合这种分段自定义颜色的场景，它的逻辑本身就是基于节点间的连接段：

library(ggforce)
library(ggplot2)
library(dplyr)
library(tidyr)

test <- data.frame(
  one = c("A", "A", "A", "A", "A", "A"),
  two = c("B", "C", "C", "C", "C", "C"),
  three = c("B", "D", "E", "F", "F", "F"),
  four = c("B", "D", "E", "F", "F", "G"),
  five = c("B", "D", "E", "I", "J", "G"),
  six = c("B", "D", "E", "I", "K", "K"),
  y = c(102, 89, 48, 75, 826, 7394)
)

# 转换为长格式并拆分连接段
test_long <- test %>%
  pivot_longer(cols = -y, names_to = "axis", values_to = "category") %>%
  mutate(axis_num = as.integer(factor(axis, levels = c("one", "two", "three", "four", "five", "six")))) %>%
  group_by(y) %>%
  mutate(next_category = lead(category)) %>%
  filter(!is.na(next_category)) %>%
  ungroup() %>%
  mutate(segment_id = paste(category, next_category, sep = "->"))

# 准备Sankey图的节点和连接数据
nodes <- test_long %>%
  select(category) %>%
  distinct() %>%
  mutate(id = row_number())

links <- test_long %>%
  left_join(nodes, by = c("category" = "category")) %>%
  left_join(nodes, by = c("next_category" = "category"), suffix = c("_source", "_target")) %>%
  select(source = id_source, target = id_target, value = y, segment_id)

# 绘制Sankey图
ggplot() +
  geom_sankey(aes(source = source, target = target, value = value, fill = segment_id),
              width = 10, alpha = 0.8) +
  geom_sankey_label(aes(source = source, target = target, label = category),
                    data = nodes %>% mutate(source = id, target = id), size = 8) +
  theme_void() +
  theme(legend.position = "none") +
  theme(text = element_text(family = "serif", size = 30))

总结 #

• 两种方法都能实现分段着色需求，ggalluvial需要手动拆分连接段，适合保留冲积图的传统样式
• ggforce的geom_sankey逻辑更贴合分段着色的需求，代码更直观，样式也更灵活

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