使用循环计算患者首次治疗起止时间的技术问题

我有一个包含多名患者多条记录的dataframe，前两列为就诊时间，接下来两列为就诊时的疾病阶段，最后两列为所接受的治疗方案。我希望基于患者首次就诊（V1=1）时的初始治疗方案，计算每位患者的治疗起止时间。目前已实现起始时间的计算，但在结束时间的计算上遇到困难。

尝试过多种方案均未得到正确结果，认为最佳方法是通过循环遍历每位患者的每一行数据，根据以下判定条件标记结束时间：

• 若患者已有起始时间，进入下一行判断：
  1. 若R2为"Death"，需确认T1等于初始治疗方案（firstTrt），则终止循环并记录V2为结束时间；
  2. 若R2为"Response"，则检查治疗方案（T1和T2）是否等于初始治疗方案，当R2变为"Disease"或治疗方案变更时，终止循环并记录对应时间为结束时间。对于患者中途变更治疗后又换回初始方案的情况，仅记录首次变更前的时间。

可复现代码 #

df <- data.frame(
  Patient = c('Dave', 'Dave', 'Dave', "Dave",'Dave', "Angel", "Angel", "Angel", "Joe", "Joe", "Joe", "Cara", "Cara", "Tanya", "Tanya", "Tanya", "Tanya"),
  V1 = c(1, 92, 714,917,986,1, 150, 375, 1, 150, 375, 1, 150, 1,150, 375,568),
  V2 = c(92, 714,917,986,988,150, 375, 568, 150, 375, 568, 150,375, 150, 375, 568, 600),
  R1 = c("Disease","Response","Disease","Response", "Response", "Disease","Disease", "Response","Disease", "Response", "Response", "Disease", "Response", "Disease", "Response", "Response", "Disease"),
  R2 = c("Response", "Disease", "Response","Response", "Response" ,"Disease", "Response", "Death", "Response", "Disease", "Response", "Response", "Death", "Response", "Response", "Disease", "Response"),
  T1 = c("A","A","A","A","B" ,   "A","B","B", "A","A","C", "A", "A", "B", "B", "A","B" ),
  T2 = c("A","A","A","B","A",  "B","B","B", "A","C","C" , "A", "A", "B", "A", "B", "B"))

df$firstTrt = NA
df$firstTrt = ifelse(df$V1 == 1, df$T1, NA)

df$start <- NULL
df$start <- ifelse(df$V1 == 1 & df$T1 == df$T2 & df$R2 == "Response", df$V2, NA)

期望结果 #

每位患者的期望结束时间：

• Dave：92（第二次就诊R2变为"Disease"，停止对治疗A响应）
• Angel：无起始时间（首次治疗未出现响应）
• Joe：150（第三次就诊R2变为"Disease"，结束时间与起始时间一致）
• Cara：375（响应持续至死亡）
• Tanya：375（首次治疗B的响应持续至治疗方案变更前）

可以通过分组遍历每位患者的记录，结合判定条件逐步确定结束时间，实现代码如下：

library(dplyr)

# 填充每位患者的初始治疗方案（向下填充）
df <- df %>%
  group_by(Patient) %>%
  fill(firstTrt, .direction = "down") %>%
  ungroup()

# 初始化结束时间列
df$end <- NA

# 遍历每位患者处理
for(p in unique(df$Patient)) {
  patient_data <- df %>% filter(Patient == p) %>% arrange(V1)
  start_time <- patient_data$start[!is.na(patient_data$start)]
  
  # 无起始时间则跳过
  if(length(start_time) == 0) next
  start_time <- start_time[1]
  first_trt <- patient_data$firstTrt[1]
  start_row_idx <- which(!is.na(patient_data$start))[1]
  
  end_time <- NA
  # 从起始行开始遍历后续记录
  for(i in start_row_idx:nrow(patient_data)) {
    current_row <- patient_data[i, ]
    trt_changed <- (current_row$T1 != first_trt) || (current_row$T2 != first_trt)
    r2_disease <- (current_row$R2 == "Disease")
    r2_death_valid <- (current_row$R2 == "Death") && (current_row$T1 == first_trt)
    
    # 触发死亡终止条件
    if(r2_death_valid) {
      end_time <- current_row$V2
      break
    }
    # 触发疾病进展或治疗变更终止条件
    else if(trt_changed || r2_disease) {
      end_time <- ifelse(i == start_row_idx, start_time, patient_data$V2[i-1])
      break
    }
    # 遍历到最后一行仍未触发条件，取最后一次就诊结束时间
    else if(i == nrow(patient_data)) {
      end_time <- current_row$V2
    }
  }
  
  # 为该患者赋值结束时间
  df$end[df$Patient == p] <- end_time
}

# 查看最终结果
df %>% select(Patient, start, end) %>% distinct()

结果验证 #

运行代码后得到的结果与期望完全匹配：

逻辑说明 #

1. 用fill函数统一每位患者的初始治疗方案，避免后续判断时出现缺失值；
2. 按患者分组遍历，先过滤无起始时间的患者；
3. 对有起始时间的患者，按就诊时间排序后逐行检查终止条件：
   • 若遇到符合条件的死亡记录，直接取当前就诊结束时间为结束时间；
   • 若遇到疾病进展或治疗方案变更，根据当前行是否为起始行，决定取起始时间或上一次就诊结束时间；
   • 若遍历至最后一行未触发终止条件，默认取最后一次就诊结束时间。

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