为R中时依Cox回归创建起止时间变量的函数需求

需求说明 #

准备用于R语言{survival}包的时依Cox回归纵向数据集：

• 随访起始于出院日期(HospDis)，终止于死亡(Death)、删失或出院后10年
• 需要生成起止时间区间（以出院后月数为单位）和删失变量Event，其中Event=1表示死亡事件，0表示删失

原始数据集 #

目标输出格式 #

R函数实现 #

library(dplyr)
library(lubridate)

create_survival_intervals <- function(data) {
  # 转换日期列为Date类型
  data <- data %>%
    mutate(
      HospDis = ymd(HospDis),
      FU = ymd(FU),
      Death = ymd(Death)
    ) %>%
    arrange(ID, FUPeriod)
  
  # 按患者ID分组处理区间
  data_processed <- data %>%
    group_by(ID) %>%
    mutate(
      # 确定每条记录的终止日期：优先死亡日期，其次随访日期，最后出院后10年
      stop_date = case_when(
        !is.na(Death) ~ Death,
        !is.na(FU) ~ FU,
        TRUE ~ HospDis + years(10)
      ),
      # 计算终止日期距出院的精确月数
      Stop = time_length(interval(HospDis, stop_date), "month"),
      # 当前区间起始时间 = 上一条记录的终止时间，基线记录（FUPeriod=0）起始为0
      Start = lag(Stop, default = 0),
      # 事件变量：终止日期为死亡日期则标记为1，否则0
      Event = if_else(!is.na(Death) & stop_date == Death, 1, 0)
    ) %>%
    # 单独处理基线记录（FUPeriod=0）：起止时间均为0，无事件
    mutate(
      Start = if_else(FUPeriod == 0, 0, Start),
      Stop = if_else(FUPeriod == 0, 0, Stop),
      Event = if_else(FUPeriod == 0, 0, Event)
    ) %>%
    ungroup()
  
  return(data_processed)
}

# 测试示例
# 构造原始数据框
original_data <- tibble(
  ID = c(1,1,1,2,2,2,2,2),
  FUPeriod = c(0,1,2,0,1,2,5,10),
  HospDis = c("2011-01-01","2011-01-01","2011-01-01","2011-02-18","2011-02-18","2011-02-18","2011-02-18","2011-02-18"),
  FU = c(NA,"2011-10-10",NA,NA,"2012-01-07","2013-01-09","2016-07-07","2021-04-30"),
  Death = c(NA,NA,"2012-03-15",NA,NA,NA,NA,NA),
  Score = c(75,34,NA,115,124,122,126,125)
)

# 生成目标数据集
output_data <- create_survival_intervals(original_data)

# 查看结果
print(output_data)

关键说明 #

• 使用lubridate包处理日期，确保日期计算的准确性
• time_length(interval(...), "month")计算两个日期间的精确月数，避免手动按天数估算的误差
• 按ID分组后，通过lag()函数自动衔接前后区间的起止时间
• 基线记录（FUPeriod=0）单独处理，对应起始随访点，无时间区间跨度和事件

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