R语言如何为三年期数据集创建sankey plot展示用户话题迁移

我有一份覆盖2019-2021共三年的数据集，样例结构如下：

Date      Topic           Users
  01/01/2019     News           user_a
  02/01/2019     Sports         user_b
  03/01/2019     Entertainment  user_c
   ...
  01/01/2020     Weather        user_a
  02/01/2020     News           user_a
  03/01/2020     Business       user_c
   ...
  01/01/2021     Sports         user_b
  02/01/2021     Business       user_b
  03/01/2021     News           user_c
   ...
  29/12/2021     Entertainment  user_c
  30/12/2021     News           user_a
  31/12/2021     Sports         user_a

数据集存在重复记录：同一日期可能对应多个讨论话题，同一用户也可能在不同时间讨论一个或多个不同话题。

我需要基于这份数据绘制桑基图，展示用户讨论话题的跨期迁移规律，比如统计2019年讨论Sports话题的用户，2020年有多少仍在讨论该话题、多少流转到了其他话题。

之前参考公开教程写了基础的桑基图绘制代码，但教程里的示例是单时间维度的邻接矩阵，没有处理跨年配对的逻辑，一直没理清怎么构造符合要求的source和target链路。参考代码如下：

# 加载依赖库
library(tidyverse)
library(viridis)
library(patchwork)
library(hrbrthemes)
library(circlize)
library(networkD3)

# 以下为示例代码原有的测试数据读取逻辑，使用自有数据时替换为本地数据读取代码即可
# data <- read.table(示例公开数据集地址, header=TRUE)

# 原示例代码的长表转换逻辑
data_long <- data %>%
  rownames_to_column %>%
  gather(key = 'key', value = 'value', -rowname) %>%
  filter(value > 0)
colnames(data_long) <- c("source", "target", "value")
data_long$target <- paste(data_long$target, " ", sep="")

# 构造节点数据框
nodes <- data.frame(name=c(as.character(data_long$source), as.character(data_long$target)) %>% unique())
 
# 转换为networkD3要求的数字ID格式
data_long$IDsource=match(data_long$source, nodes$name)-1 
data_long$IDtarget=match(data_long$target, nodes$name)-1

# 配置色阶
ColourScal ='d3.scaleOrdinal() .range(["#FDE725FF","#B4DE2CFF","#6DCD59FF","#35B779FF","#1F9E89FF","#26828EFF","#31688EFF","#3E4A89FF","#482878FF","#440154FF"])'

# 绘制桑基图
sankeyNetwork(Links = data_long, Nodes = nodes,
                     Source = "IDsource", Target = "IDtarget",
                     Value = "value", NodeID = "name", 
                     sinksRight=FALSE, colourScale=ColourScal, nodeWidth=40, fontSize=13, nodePadding=20)

预期的桑基图效果为：横轴按年份从左到右排布，每一列的节点对应该年的所有讨论话题，节点间的链路宽度代表年度间流转到对应话题的独立用户数量。

核心逻辑 #

构造链路的核心是做用户相邻年份的行为配对，步骤如下：

• 从日期字段提取年份，先做去重处理：同一个用户同一年多次讨论同一个话题，仅保留1条记录，避免权重统计偏大
• 按相邻年份拆分配对组：分别构造2019→2020、2020→2021两组流转关系，对每个活跃用户，取其上年讨论的所有话题作为source节点，下年讨论的所有话题作为target节点
• 统计每一组(source, target)对应的独立用户数，作为链路的value（宽度）
• 所有节点必须拼接年份前缀（如2019_Sports、2020_Sports），避免不同年份的同名话题被识别为同一个节点，保证节点按年份分列排布

可直接运行的代码 #

library(tidyverse)
library(lubridate)
library(networkD3)

# --------------------------
# 步骤1：数据预处理
# --------------------------
# 替换成你自己的数据读取代码，假设读入的数据框命名为raw_data，和样例结构一致
# raw_data <- read.csv("your_data_path.csv")

user_topic_year <- raw_data %>%
  # 解析日期、提取年份，如果你原始日期是日/月/年格式就用dmy，其他格式对应换为ymd/mdy即可
  mutate(Date = dmy(Date),
         year = year(Date)) %>%
  # 去重：单用户单年单话题仅保留1条记录
  distinct(Users, year, Topic) %>%
  # 节点加年份前缀，避免重名
  mutate(node_name = paste0(year, "_", Topic))

# --------------------------
# 步骤2：构造跨年流转链路
# --------------------------
links <- bind_rows(
  # 2019年→2020年流转
  user_topic_year %>%
    filter(year == 2019) %>%
    transmute(Users, source = node_name) %>%
    inner_join(
      user_topic_year %>% filter(year == 2020) %>% transmute(Users, target = node_name),
      by = "Users"
    ),
  # 2020年→2021年流转
  user_topic_year %>%
    filter(year == 2020) %>%
    transmute(Users, source = node_name) %>%
    inner_join(
      user_topic_year %>% filter(year == 2021) %>% transmute(Users, target = node_name),
      by = "Users"
    )
) %>%
  # 统计每条链路的独立用户数作为权重
  count(source, target, name = "value")

# --------------------------
# 步骤3：构造节点表+ID匹配
# --------------------------
nodes <- data.frame(
  name = unique(c(links$source, links$target))
) %>%
  # 提取节点的年份、话题属性，方便后续配色
  mutate(year = str_extract(name, "^\\d{4}"),
         topic = str_remove(name, "^\\d{4}_"))

# 转换为networkD3要求的0起始数字ID
links$IDsource <- match(links$source, nodes$name) - 1
links$IDtarget <- match(links$target, nodes$name) - 1

# --------------------------
# 步骤4：配色配置（同话题同色，方便识别）
# --------------------------
topic_list <- unique(nodes$topic)
color_pal <- viridis(length(topic_list), option = "D")
topic_color <- setNames(color_pal, topic_list)
node_colors <- topic_color[nodes$topic]
ColourScal <- paste0(
  'd3.scaleOrdinal() .domain([',
  paste0("'", nodes$name, "'", collapse = ","),
  ']) .range([',
  paste0("'", node_colors, "'", collapse = ","),
  '])'
)

# --------------------------
# 步骤5：绘制桑基图
# --------------------------
sankeyNetwork(
  Links = links, Nodes = nodes,
  Source = "IDsource", Target = "IDtarget",
  Value = "value", NodeID = "name",
  sinksRight = FALSE, colourScale = ColourScal,
  nodeWidth = 40, fontSize = 12, nodePadding = 20,
  iterations = 0 # 关闭自动节点排序，保证年份列对齐
)

踩坑提示 #

• 上述代码用inner_join做用户匹配，会自动过滤掉仅单年活跃的用户，统计的是连续两年都有发言的用户的话题迁移情况，符合常规分析逻辑，如果需要把流失用户也纳入统计，可以换成left_join，给流失用户统一建一个xxx_流失的target节点即可
• 如果不需要统计用户所有讨论过的话题，只想看用户的核心讨论话题，可以在去重步骤前先统计每个用户每年每个话题的发言次数，取发言次数最高的话题作为用户当年的唯一节点即可
• iterations=0是保证节点按年份对齐的关键参数，去掉的话内置布局算法会自动调整节点位置，打乱年份列顺序

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