在R中从多列诊断数据提取最早诊断及对应疾病编码

原代码问题说明 #

• 引用了未定义的data对象，应替换为实际数据框名df
• 日期列是字符串类型，无法直接用min()求最小值，需先转为日期格式
• 错误地对疾病编码列求最小值，而非目标的日期列

数据预处理 #

首先修正数据中的无效日期（18/20/2005为非法日期，改为18/10/2005）：

df = data.frame(ID = c(1001, 1002, 1003, 1004, 1005),
                Disease_code_1 = c('I802', 'G200','I802',NA, 'H356'),
                Disease_code_2 = c('A071',NA,'G20',NA,'H250'),
                Disease_code_3 = c('H250', NA,NA,NA,NA),
                Date_of_diagnosis_1 = c('12/06/1997','13/06/1997','14/02/2003',NA,'18/10/2005'),
                Date_of_diagnosis_2 = c('12/06/1998',NA,'18/09/2001',NA,'12/07/1993'),
                Date_of_diagnosis_3 = c('17/09/2010',NA,NA,NA,NA),
                stringsAsFactors = FALSE)

方法一：Tidyverse 简洁实现 #

借助tidyr的长格式转换和dplyr的分组操作，轻松配对日期与编码：

library(tidyverse)

# 转换为长格式，将编码与对应日期配对
df_long <- df %>%
  pivot_longer(cols = -ID,
               names_to = c(".value", "group"),
               names_pattern = "(Disease_code|Date_of_diagnosis)_(\\d)") %>%
  # 转换日期格式（日/月/年）
  mutate(diagnosis_date = dmy(Date_of_diagnosis)) %>%
  # 过滤无效的NA行
  filter(!is.na(Disease_code), !is.na(diagnosis_date))

# 按ID分组，提取最早诊断的编码和日期
df_result <- df_long %>%
  group_by(ID) %>%
  slice_min(diagnosis_date, n = 1) %>%
  ungroup() %>%
  select(ID, firstdiagnosis = Disease_code, mindate = diagnosis_date) %>%
  # 合并回原数据，保留所有ID
  right_join(df, by = "ID") %>%
  select(ID, firstdiagnosis, mindate, everything())

print(df_result)

方法二：基础R逐行处理 #

无需额外包，用apply逐行处理编码与日期的配对：

# 先将所有日期列转为日期格式
library(lubridate)
date_cols <- grep("Date_of_diagnosis", names(df), value = TRUE)
df[date_cols] <- lapply(df[date_cols], dmy, quiet = TRUE)

# 定义逐行处理函数
get_first_diagnosis <- function(row) {
  # 提取当前行的疾病编码和日期
  codes <- row[grep("Disease_code", names(row))]
  dates <- row[grep("Date_of_diagnosis", names(row))]
  
  # 配对编码与日期，过滤NA
  paired <- data.frame(code = codes, date = dates) %>%
    filter(!is.na(code), !is.na(date))
  
  if(nrow(paired) == 0) {
    return(list(firstdiagnosis = NA, mindate = NA))
  }
  
  # 找到最早日期对应的编码
  min_idx <- which.min(paired$date)
  return(list(firstdiagnosis = paired$code[min_idx], mindate = paired$date[min_idx]))
}

# 应用函数到每一行
result_list <- apply(df, 1, get_first_diagnosis)

# 将结果合并到原数据框
df$firstdiagnosis <- sapply(result_list, function(x) x$firstdiagnosis)
df$mindate <- sapply(result_list, function(x) x$mindate)

print(df)

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