在R语言中计算患者首次有效治疗的持续时长

我有一个包含多名患者多条记录的dataframe，前两列为就诊时间区间（V1是区间起始，V2是区间结束），接下来两列为就诊时的疾病阶段（R1、R2），最后两列为对应治疗方案（T1、T2）。需要计算每位患者首次产生应答时所用治疗方案的持续时长：

• 首次发现应答时标记开始时间
• 持续检查后续记录：若患者仍使用同一治疗方案且处于应答状态，继续追踪；一旦治疗方案变更（哪怕仍有应答），终止追踪
• 最终时长为结束时间与开始时间的差值

已编写了一个检查首次应答开始时间的循环函数，但需要补充后续的方案一致性检查和结束时间计算逻辑。

可复现数据示例 #

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

现有代码 #

target_string <- "Response"
strtTime <- function(id) {
  subset_df <- df[df$Patient == id, ]
  start <- NULL
  # Loop through rows in the subset dataframe
  for (i in 1:nrow(subset_df)) {
    # Check if the target string is in Column1 or Column2
    if (target_string %in% subset_df$R1[i] || target_string %in% subset_df$R2[i]) {
      # Record the result when the target string is found
      start <- subset_df$V2[i]
      break
    }
  }
  return(start)
}

pts = unique(df$Patient)
startTime <- lapply(pts, strtTime)
startTime_list <- setNames(startTime, pts)
startTime_list <- as.data.frame(do.call(cbind, startTime_list))

改进后的解决方案 #

完整函数实现 #

扩展原有函数，在找到首次应答后，继续检查后续记录的治疗方案一致性和应答状态，直到触发终止条件：

calculate_response_duration <- function(id) {
  subset_df <- df[df$Patient == id, ]
  # 转换时间列为数值型，避免字符串运算错误
  subset_df$V1 <- as.numeric(subset_df$V1)
  subset_df$V2 <- as.numeric(subset_df$V2)
  
  start_time <- NULL
  end_time <- NULL
  initial_treatment <- NULL
  target_string <- "Response"
  
  for (i in 1:nrow(subset_df)) {
    # 检查当前行是否存在应答
    has_response <- target_string %in% subset_df$R1[i] || target_string %in% subset_df$R2[i]
    
    if (is.null(start_time)) {
      # 未找到首次应答，检查当前行是否符合条件
      if (has_response) {
        start_time <- subset_df$V2[i]
        # 记录首次应答时的治疗方案（用T1-T2拼接作为唯一标识）
        initial_treatment <- paste(subset_df$T1[i], subset_df$T2[i], sep = "-")
        end_time <- start_time # 初始化结束时间为开始时间
      }
    } else {
      # 已找到首次应答，检查后续记录
      current_treatment <- paste(subset_df$T1[i], subset_df$T2[i], sep = "-")
      # 终止条件：治疗方案变更 或 不再有应答
      if (current_treatment != initial_treatment || !has_response) {
        break
      }
      # 符合条件则更新结束时间为当前区间的结束时间
      end_time <- subset_df$V2[i]
    }
  }
  
  # 计算时长，未找到应答则返回NA
  duration <- if (!is.null(start_time)) end_time - start_time else NA
  
  return(data.frame(Patient = id, Start_Time = start_time, End_Time = end_time, Duration = duration))
}

# 应用到所有患者
pts <- unique(df$Patient)
result_list <- lapply(pts, calculate_response_duration)
final_result <- do.call(rbind, result_list)

运行结果 #

执行代码后，final_result的输出与预期一致：

Patient Start_Time End_Time Duration
1    Dave        150      375      225
2   Angel        375      568      193
3     Joe        150      375      225

逻辑说明 #

1. 时间类型转换：将V1、V2转为数值型，避免字符串格式导致的计算错误
2. 首次应答检测：遍历行找到第一个出现"Response"的记录，记录开始时间和对应治疗方案
3. 后续追踪：继续遍历后续行，若治疗方案与首次应答时一致且仍有应答，则更新结束时间；一旦方案变更或无应答，立即终止循环
4. 时长计算：用最终结束时间减去开始时间得到持续时长，未找到应答则返回NA

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