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

在合并的ggplot中添加跨图连线:追踪个体随时间变化

解决方案

你的核心问题是:当前每个子图仅包含单个Wave的数据,每个pidp在子图里只有一个数据点,geom_line()没有足够的点来生成线条。要展示个体随时间的变化,可采用以下两种可行方案:

方案1:单图偏移X轴(推荐,直观清晰)

将不同Wave的收入数据偏移后放在同一坐标系中,直接用线条连接同一pidp的三个数据点:

library(tidyverse)

# 1. 筛选出在所有Wave都有记录的前50个pidp
all_waves <- unique(combined_data$wave)
valid_pidp <- combined_data %>%
  group_by(pidp) %>%
  filter(all(all_waves %in% wave)) %>% # 确保每个pidp在所有Wave都有数据
  distinct(pidp) %>%
  slice(1:50) %>% # 取前50个符合条件的pidp
  pull(pidp)

filtered_data <- combined_data %>%
  filter(pidp %in% valid_pidp) %>%
  # 为不同Wave的收入添加偏移,避免X轴重叠
  mutate(wave_offset = case_match(
    wave,
    all_waves[1] ~ 0,
    all_waves[2] ~ max(ANNUAL_INCOME, na.rm = TRUE) * 1.2,
    all_waves[3] ~ max(ANNUAL_INCOME, na.rm = TRUE) * 2.4
  ),
  adjusted_income = ANNUAL_INCOME + wave_offset)

# 2. 绘制图表
ggplot(filtered_data, aes(x = adjusted_income, y = GENERAL_HAPPINESS, color = pidp, group = pidp)) +
  geom_line(alpha = 0.6) + # 加透明度避免线条重叠
  geom_point(size = 2) +
  labs(x = "Annual Income (by Wave)", y = "General Happiness") +
  theme_minimal() +
  theme(legend.position = "none") +
  scale_y_continuous(breaks = seq(1, 4, by = 1), limits = c(1, 4)) +
  # 添加Wave分隔线和标题
  geom_vline(xintercept = c(max(filtered_data$ANNUAL_INCOME, na.rm = TRUE)*1.1, 
                           max(filtered_data$ANNUAL_INCOME, na.rm = TRUE)*2.3),
             linetype = "dashed", color = "gray50") +
  annotate("text", 
           x = c(max(filtered_data$ANNUAL_INCOME, na.rm = TRUE)*0.5,
                 max(filtered_data$ANNUAL_INCOME, na.rm = TRUE)*1.7,
                 max(filtered_data$ANNUAL_INCOME, na.rm = TRUE)*2.9),
           y = 4.1, 
           label = paste("Wave", all_waves),
           size = 5)

方案2:分图跨图连线(保留三个独立子图)

如果必须保持三个子图并排,可手动计算坐标并添加跨图线条:

library(ggplot2)
library(ggpubr)
library(grid)

# 1. 预处理数据:筛选有效pidp并拆分
all_waves <- unique(combined_data$wave)
valid_pidp <- combined_data %>%
  group_by(pidp) %>%
  filter(all(all_waves %in% wave)) %>%
  distinct(pidp) %>%
  slice(1:50) %>%
  pull(pidp)

filtered_data <- combined_data %>%
  filter(pidp %in% valid_pidp)

subset_data_list <- purrr::map(all_waves, ~dplyr::filter(filtered_data, wave == .x))
names(subset_data_list) <- all_waves

# 2. 生成子图列表(统一X/Y轴范围,增加边距)
plot_list <- purrr::imap(subset_data_list, function(data, wave_val) {
  ggplot(data, aes(x = ANNUAL_INCOME, y = GENERAL_HAPPINESS, color = pidp)) +
    geom_point(size = 2) +
    labs(x = "Income", y = "Happiness") +
    theme_minimal() +
    ggtitle(paste("Wave", wave_val)) +
    theme(legend.position = "none",
          plot.margin = unit(c(1,1,1,1), "cm")) +
    scale_y_continuous(breaks = seq(1, 4, by = 1), limits = c(1, 4)) +
    scale_x_continuous(limits = range(filtered_data$ANNUAL_INCOME))
})

# 3. 组合图表并获取视图信息
combined_plot <- ggarrange(plotlist = plot_list, ncol = 3)
gt <- ggplot_gtable(ggplot_build(combined_plot))

# 4. 为每个pidp添加跨图线条
for (pid in valid_pidp) {
  # 获取该pidp在三个Wave中的坐标
  coords <- purrr::map_dfr(subset_data_list, function(data) {
    row <- data[data$pidp == pid,]
    if(nrow(row) == 0) return(NULL)
    # 转换为绘图坐标
    x <- ggplot_build(plot_list[[1]])$layout$panel_params[[1]]$x$scale$transform(row$ANNUAL_INCOME)
    y <- ggplot_build(plot_list[[1]])$layout$panel_params[[1]]$y$scale$transform(row$GENERAL_HAPPINESS)
    tibble(x = x, y = y)
  })
  
  # 添加Wave1到Wave2的线条
  gt <- gtable_add_grob(gt, 
                        segmentsGrob(x0 = coords$x[1], x1 = coords$x[2], y0 = coords$y[1], y1 = coords$y[2],
                                     gp = gpar(col = as.character(factor(pid)), alpha = 0.6)),
                        t = 7, b = 7, l = 4, r = 6)
  # 添加Wave2到Wave3的线条
  gt <- gtable_add_grob(gt, 
                        segmentsGrob(x0 = coords$x[2], x1 = coords$x[3], y0 = coords$y[2], y1 = coords$y[3],
                                     gp = gpar(col = as.character(factor(pid)), alpha = 0.6)),
                        t = 7, b = 7, l = 6, r = 8)
}

# 5. 绘制最终图表
grid.draw(gt)

内容的提问来源于stack exchange,提问作者Ella

相关产品推荐
方舟 Agent Plan

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

最近更新时间:2026.07.15 15:14:57