如何按患者、检验类型和时间点分组，筛选近值并转宽表？

需求梳理 #

需处理检验结果数据集，完成以下操作：

1. 标记记录对应的时间节点：
   • BASELINE：入组日期（ParticipationDate）后7天内（含入组当天）
   • MONTH3：入组后90天至97天（不早于90天，容忍7天）
   • MONTH12：入组后365天至372天（不早于365天，容忍7天）
2. 对每个患者、每个时间节点、每个检验指标，筛选最接近目标时间且不早于该时间的有效记录（仅保留Verified="Yes"的结果）
3. 转换为指定的宽表格式

完整优化代码 #

library(dplyr)
library(tidyr)

# 读取示例数据
df <- read.table(text = "
PatientID,ParticipationDate,LabResultDate,LabType,LabValue,Verified
PAT_001,05-01-2023,05-01-2023,Crea,5.0,Yes
PAT_001,05-01-2023,07-01-2023,Gluc,4.2,Yes
PAT_001,05-01-2023,09-01-2023,Hb,4.2,No
PAT_220,12-03-2023,03-03-2023,Hb,5.2,Yes
PAT_220,12-03-2023,15-03-2023,Hb,5.3,Yes
PAT_220,12-03-2023,16-03-2023,Gluc,4.4,Yes
PAT_001,05-01-2023,03-04-2023,Gluc,4.6,Yes
PAT_001,05-01-2023,06-04-2023,Crea,5.4,Yes
PAT_001,05-01-2023,07-04-2023,Crea,5.0,Yes
PAT_001,05-01-2023,08-04-2023,Hb,5.1,Yes
PAT_220,12-03-2023,11-06-2023,Gluc,5.3,Yes
PAT_220,12-03-2023,12-06-2023,Crea,4.8,No
PAT_220,12-03-2023,14-06-2023,Hb,4.6,Yes
PAT_220,12-03-2023,28-06-2023,Crea,3.9,No
PAT_220,12-03-2023,23-07-2023,Hb,5.1,No
PAT_001,05-01-2023,27-07-2023,Gluc,4.3,Yes
PAT_220,12-03-2023,29-07-2023,Crea,5.1,Yes
PAT_220,12-03-2023,25-08-2023,Gluc,4.9,Yes
PAT_220,12-03-2023,27-08-2023,Crea,4.3,Yes
PAT_220,12-03-2023,14-09-2023,Crea,5.5,Yes
PAT_001,05-01-2023,17-09-2023,Hb,5.5,Yes
PAT_220,12-03-2023,09-11-2023,Hb,5.4,No
PAT_001,05-01-2023,13-11-2023,Gluc,4.2,Yes
PAT_001,05-01-2023,17-11-2023,Hb,5.2,Yes
PAT_001,05-01-2023,29-12-2023,Crea,5.4,Yes
PAT_001,05-01-2023,31-12-2023,Crea,4.4,Yes
PAT_220,12-03-2023,03-01-2024,Gluc,4.2,Yes
PAT_001,05-01-2023,09-01-2024,Gluc,5.4,Yes
PAT_001,05-01-2023,09-01-2024,Hb,4.0,Yes
PAT_001,05-01-2023,13-01-2024,Crea,4.7,Yes
PAT_001,05-01-2023,07-03-2024,Hb,4.2,Yes
PAT_220,12-03-2023,14-03-2024,Gluc,4.4,Yes
PAT_220,12-03-2023,15-03-2024,Crea,5.0,No
PAT_220,12-03-2023,17-03-2024,Hb,3.9,Yes
PAT_220,12-03-2023,23-05-2024,Crea,4.4,Yes
PAT_001,05-01-2023,23-06-2024,Gluc,4.8,No
PAT_220,12-03-2023,04-08-2024,Hb,4.3,Yes
PAT_220,12-03-2023,24-08-2024,Gluc,4.5,Yes
", header = TRUE, sep = ",", na.strings = "")

# 1. 日期格式修正与天数计算
df <- df %>%
  mutate(
    # 将字符串日期转换为Date类型（注意格式是dd-mm-yyyy）
    ParticipationDate = as.Date(ParticipationDate, format = "%d-%m-%Y"),
    LabResultDate = as.Date(LabResultDate, format = "%d-%m-%Y"),
    # 计算检验日期距离入组日期的天数（正数表示检验在入组之后）
    DaysSince = as.numeric(difftime(LabResultDate, ParticipationDate, units = "days"))
  ) %>%
  # 仅保留已验证的有效记录
  filter(Verified == "Yes")

# 2. 标记时间节点并计算与目标的差值
df <- df %>%
  mutate(
    # 标记符合容忍期的时间节点
    MomentCode = case_when(
      DaysSince >= 0 & DaysSince < 7 ~ "BASELINE",
      DaysSince >= 90 & DaysSince < 97 ~ "MONTH3",
      DaysSince >= 365 & DaysSince < 372 ~ "MONTH12"
    ),
    # 计算与目标节点的天数差，用于筛选最接近的记录
    TargetDiff = case_when(
      MomentCode == "BASELINE" ~ DaysSince - 0,
      MomentCode == "MONTH3" ~ DaysSince - 90,
      MomentCode == "MONTH12" ~ DaysSince - 365
    )
  ) %>%
  # 移除未匹配到任何节点的记录
  drop_na(MomentCode)

# 3. 筛选最接近目标时间的记录
df_filtered <- df %>%
  # 按患者、时间节点、检验指标分组
  group_by(PatientID, MomentCode, LabType) %>%
  # 选择与目标节点差值最小的记录（即最接近），with_ties=FALSE避免重复
  slice_min(TargetDiff, n = 1, with_ties = FALSE) %>%
  ungroup()

# 4. 转换为指定宽表格式
df_wide <- df_filtered %>%
  pivot_wider(
    id_cols = c(PatientID, ParticipationDate),
    names_from = c(MomentCode, LabType),
    values_from = LabValue,
    # 生成目标格式的列名
    names_glue = "{MomentCode}_{LabType}"
  )

# 查看最终结果
print(df_wide)

关键优化说明 #

• 日期计算修正：原代码中DaysSince计算方向错误，修正为检验日期减入组日期，确保正数表示检验在入组之后，符合“不早于目标时间”的要求。
• 提前过滤有效记录：先筛选Verified="Yes"的记录，减少后续计算量，避免无效数据干扰。
• 精准节点标记：直接通过天数区间标记节点，逻辑清晰，符合7天容忍期要求。
• 高效筛选记录：使用slice_min按分组筛选最接近目标的记录，代码简洁且性能优异，适合大规模数据集。
• 灵活宽表转换：通过names_glue自定义列名格式，完美匹配需求中的宽表结构。

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