在R中筛选距第二剂接种日14天后的事件日期

原始数据 #

需求 #

从5个episode_*列中筛选出比Date of Dose 2晚14天的日期，将符合条件的日期合并为逗号分隔的字符串，最终输出如下表格：

尝试的代码 #

vaccine_received_test <- vaccine_received %>%
  rowwise() %>%
  mutate(
    dose_2_plus_14 = `Date of Dose 2` + days(14),
    
    # Check if any episode date is greater than 'Date of Dose 2 + 14 days'
    date_of_BI = case_when(
          any(c(episode_1, episode_2, episode_3, episode_4, episode_5) > dose_2_plus_14, 
          na.rm = TRUE) ~ any(c(episode_1, episode_2, episode_3, episode_4, episode_5), 
          TRUE ~ NA
    )
  )

问题分析与解决方案 #

你当前代码的问题在于case_when中使用any()返回的是布尔值（TRUE/FALSE），而非符合条件的日期集合，因此无法得到期望的合并日期字符串。以下提供两种可行的解决方案：

方案1：使用rowwise逐行处理 #

适合数据量较小的场景，逻辑直观：

library(dplyr)
library(lubridate)

vaccine_received_test <- vaccine_received %>%
  rowwise() %>%
  mutate(
    # 计算Date of Dose 2加14天的日期
    dose_2_plus_14 = `Date of Dose 2` + days(14),
    # 筛选并合并符合条件的日期
    date_of_BI = {
      # 提取当前行的所有episode日期
      episode_dates <- c(episode_1, episode_2, episode_3, episode_4, episode_5)
      # 筛选出大于dose_2_plus_14且非NA的日期
      valid_dates <- episode_dates[episode_dates > dose_2_plus_14 & !is.na(episode_dates)]
      # 有符合条件的则合并为字符串，否则返回NA
      if (length(valid_dates) > 0) paste(valid_dates, collapse = ", ") else NA_character_
    }
  ) %>%
  # 仅保留目标列并重命名
  select(`Date of BI` = date_of_BI)

方案2：使用tidyr转长表处理 #

适合数据量较大的场景，性能更优：

library(dplyr)
library(tidyr)
library(lubridate)

vaccine_received_test <- vaccine_received %>%
  # 添加行ID用于后续分组合并
  mutate(row_id = row_number()) %>%
  # 将宽表转为长表，统一处理所有episode日期
  pivot_longer(
    cols = starts_with("episode_"),
    names_to = "episode_type",
    values_to = "episode_date"
  ) %>%
  # 计算Date of Dose 2加14天的日期
  mutate(dose_2_plus_14 = `Date of Dose 2` + days(14)) %>%
  # 筛选符合条件的日期
  filter(episode_date > dose_2_plus_14 & !is.na(episode_date)) %>%
  # 按行ID分组，合并符合条件的日期
  group_by(row_id) %>%
  summarise(`Date of BI` = paste(episode_date, collapse = ", "), .groups = "drop") %>%
  # 合并回原表，确保无符合条件日期的行显示NA
  right_join(vaccine_received %>% mutate(row_id = row_number()), by = "row_id") %>%
  # 仅保留目标列
  select(`Date of BI`) %>%
  # 空值统一为NA
  mutate(`Date of BI` = ifelse(is.na(`Date of BI`), NA_character_, `Date of BI`))

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