如何用R的networkD3为桑基图节点和链接分组并设置对应颜色？

基于你提供的桑基图示例代码，我们可以通过以下步骤为节点和链接添加分组并设置对应颜色：

1. 定义分组映射 #

首先为每个酒店品牌指定分组（比如按酒店集团划分），创建分组映射表：

# 定义酒店品牌与分组的对应关系
group_mapping <- data.frame(
  label = c("Hilton", "Sheraton", "Westin", "Hyatt", "Four Seasons", "Ritz-Carlton"),
  group = c("希尔顿集团", "万豪集团", "万豪集团", "凯悦集团", "四季集团", "万豪集团")
)

2. 为节点添加分组与颜色信息 #

将分组信息关联到节点数据框，并为每个分组分配专属颜色：

# 为节点数据框添加分组信息
nodes <- nodes %>%
  left_join(group_mapping, by = "label")

# 定义分组对应的颜色
group_colors <- c(
  "希尔顿集团" = "#1f77b4",
  "万豪集团" = "#ff7f0e",
  "凯悦集团" = "#2ca02c",
  "四季集团" = "#d62728"
)

# 为每个节点匹配对应分组的颜色
nodes$color <- group_colors[nodes$group]

3. 为链接设置颜色 #

通常链接颜色可以继承源节点或目标节点的分组颜色，这里我们让链接使用源节点的颜色：

# 将源节点的颜色关联到链接数据框
links <- links %>%
  left_join(nodes %>% select(name, color), by = c("source" = "name")) %>%
  rename(link_color = color)

4. 绘制带分组颜色的桑基图 #

修改sankeyNetwork函数调用，指定节点和链接的颜色参数：

library(networkD3)

sankeyNetwork(Links = links, Nodes = nodes, Source = 'source_id',
              Target = 'target_id', Value = 'value', NodeID = 'label',
              NodeColor = 'color', LinkColor = 'link_color')

完整整合代码 #

把所有步骤整合到原始代码中，完整代码如下：

df <- read.table(header = TRUE, stringsAsFactors = FALSE, text = '
name  year1           year2         year3           year4
Bob   Hilton          Sheraton      Westin          Hyatt
John  "Four Seasons"  Ritz-Carlton  Westin          Sheraton
Tom   Ritz-Carlton    Westin        Sheraton        Hyatt
Mary  Westin          Sheraton      "Four Seasons"  Ritz-Carlton
Sue   Hyatt           Ritz-Carlton  Hilton          Sheraton
Barb  Hilton          Sheraton      Ritz-Carlton    "Four Seasons"
')

# 格式化数据框
links <- 
  df %>%
  mutate(row = row_number()) %>%
  pivot_longer(-row, names_to = "column", values_to = "source") %>%
  mutate(column = match(column, names(df))) %>%
  group_by(row) %>%
  mutate(target = lead(source, order_by = column)) %>%
  ungroup() %>% 
  filter(!is.na(target))
links <- 
  links %>%
  mutate(source = paste0(source, '_', column)) %>%
  mutate(target = paste0(target, '_', column + 1)) %>%
  select(source, target)
nodes <- data.frame(name = unique(c(links$source, links$target)))
nodes$label <- sub('_[0-9]*$', '', nodes$name)
links$source_id <- match(links$source, nodes$name) - 1
links$target_id <- match(links$target, nodes$name) - 1
links$value <- 1

# --- 新增分组着色步骤 ---
# 1. 定义分组映射
group_mapping <- data.frame(
  label = c("Hilton", "Sheraton", "Westin", "Hyatt", "Four Seasons", "Ritz-Carlton"),
  group = c("希尔顿集团", "万豪集团", "万豪集团", "凯悦集团", "四季集团", "万豪集团")
)

# 2. 为节点添加分组与颜色
nodes <- nodes %>%
  left_join(group_mapping, by = "label")

group_colors <- c(
  "希尔顿集团" = "#1f77b4",
  "万豪集团" = "#ff7f0e",
  "凯悦集团" = "#2ca02c",
  "四季集团" = "#d62728"
)

nodes$color <- group_colors[nodes$group]

# 3. 为链接设置颜色
links <- links %>%
  left_join(nodes %>% select(name, color), by = c("source" = "name")) %>%
  rename(link_color = color)

# 4. 绘制桑基图
library(networkD3)

sankeyNetwork(Links = links, Nodes = nodes, Source = 'source_id',
              Target = 'target_id', Value = 'value', NodeID = 'label',
              NodeColor = 'color', LinkColor = 'link_color')

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