过滤ID后使用geom_vline添加事件垂直线出现多余线条问题

我有一个长格式的重复测量数据集，包含多名患者的测量时间点、日期，以及是否发生事件和事件日期。用ggplot2绘制单个ID的测量值随时间变化的图表时，已经过滤了目标ID的数据，但添加的geom_vline却显示了所有ID的事件日期线，而非仅目标ID的。示例数据和出错代码如下：

library(tidyverse)
sampledata <- structure(list(ID = c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2), Measure1 = c(10, 20, 0, 30, 20, 10, 2, 0, 0, 0), timepoint = c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5), time = structure(c(18628, 18748, 18840, 18932, 19024, 19205, 19297, 19024, 19113, 19205), class = "Date"), event = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1), eventdate = structure(c(18779, 18779, 18779, 18779, 18779, 19024, 19024, 19024, 19024, 19024), class = "Date")), row.names = c(NA, 10L), class = "data.frame") 

出错的绘制代码：

filter(sampledata, ID %in% 1&Measure1 !="NA") %>% ggplot(aes(x = time, y = Measure1)) + 
  geom_line(size=0.3,linetype="solid") + 
  geom_point(size=2, color="#0073C2FF") +
  geom_vline(xintercept = as.numeric(as.Date(sampledata$eventdate)), linetype=1) +
  theme_gray() + theme(text = element_text(size=12), axis.text=element_text(size=8), legend.position="none", axis.title.y = element_blank()) + 
  labs(y="ylab", x = "Follow up") +
  scale_x_date(date_labels = "%Y-%m-%d", date_breaks = "2 months")

问题原因 #

你在geom_vline的xintercept参数里直接引用了原始数据集sampledata$eventdate，这会把所有ID的事件日期都传入，完全不受前面过滤数据的影响——因为这里没有使用管道里的过滤后数据集，而是直接调用了外部的原始数据。

解决方案 #

1. 修正单个ID的绘图代码 #

有两种简单的修正方式：

方式一：引用管道内的过滤后数据

用.data引用当前管道里的过滤后数据集，同时取唯一的事件日期（因为每个ID的事件日期在多行数据里重复）：

filter(sampledata, ID == 1 & !is.na(Measure1)) %>% 
  ggplot(aes(x = time, y = Measure1)) + 
  geom_line(size=0.3, linetype="solid") + 
  geom_point(size=2, color="#0073C2FF") +
  # 取过滤后数据中唯一的eventdate转成数值
  geom_vline(xintercept = as.numeric(unique(.data$eventdate)), linetype=1) +
  theme_gray() + 
  theme(text = element_text(size=12), 
        axis.text=element_text(size=8), 
        legend.position="none", 
        axis.title.y = element_blank()) + 
  labs(y="ylab", x = "Follow up") +
  scale_x_date(date_labels = "%Y-%m-%d", date_breaks = "2 months")

方式二：给geom_vline指定专属数据源

明确给geom_vline指定过滤后的数据集，确保只加载目标ID的事件日期：

# 先保存过滤后的数据
filtered_data <- filter(sampledata, ID == 1 & !is.na(Measure1))

ggplot(filtered_data, aes(x = time, y = Measure1)) + 
  geom_line(size=0.3, linetype="solid") + 
  geom_point(size=2, color="#0073C2FF") +
  # 用distinct去重，确保只生成一条垂直线
  geom_vline(data = distinct(filtered_data, eventdate), 
             xintercept = as.numeric(eventdate), 
             linetype=1) +
  theme_gray() + 
  theme(text = element_text(size=12), 
        axis.text=element_text(size=8), 
        legend.position="none", 
        axis.title.y = element_blank()) + 
  labs(y="ylab", x = "Follow up") +
  scale_x_date(date_labels = "%Y-%m-%d", date_breaks = "2 months")

2. 批量绘制所有ID的图表 #

如果要自动生成所有ID的图表，不用硬编码，可以用purrr包的map函数遍历每个ID：

步骤1：生成所有ID的图表列表

# 按ID分组拆分数据，并批量生成图表
id_plot_list <- sampledata %>% 
  group_by(ID) %>% 
  nest() %>% 
  mutate(plot = map(data, function(df) {
    ggplot(df, aes(x = time, y = Measure1)) + 
      geom_line(size=0.3, linetype="solid") + 
      geom_point(size=2, color="#0073C2FF") +
      geom_vline(xintercept = as.numeric(unique(df$eventdate)), linetype=1) +
      theme_gray() + 
      theme(text = element_text(size=12), 
            axis.text=element_text(size=8), 
            legend.position="none", 
            axis.title.y = element_blank()) + 
      labs(y="ylab", x = "Follow up", title = paste("患者ID:", unique(df$ID))) +
      scale_x_date(date_labels = "%Y-%m-%d", date_breaks = "2 months")
  }))

步骤2：查看或保存图表

• 查看单个ID的图表：比如id_plot_list$plot[[1]]
• 批量保存所有图表到本地：

# 遍历列表，将每个ID的图表保存为png文件
walk2(id_plot_list$ID, id_plot_list$plot, function(id, plt) {
  ggsave(paste0("患者ID_", id, "_随访图.png"), plt, width=6, height=4)
})

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