如何在R中实现病例与对照的1:10年龄匹配（±2岁）

核心思路 #

拆分病例与对照数据集，针对每个病例筛选年龄在±2岁范围内的合格对照，随机抽取10名，最后合并匹配结果。以下是基于dplyr和purrr的可行代码：

完整代码 #

# 加载依赖包
library(dplyr)
library(purrr)

# 假设你的数据集名为df，包含列：Group(Case/Control)、Age、Case_ID(病例唯一标识)、Control_ID(对照唯一标识)
# 拆分病例和对照数据集
case_data <- df %>% filter(Group == "Case")
control_data <- df %>% filter(Group == "Control")

# 定义匹配函数：为单个病例筛选并抽取对照
match_controls <- function(case_row) {
  # 筛选符合年龄范围的对照
  eligible_controls <- control_data %>%
    filter(Age >= case_row$Age - 2, Age <= case_row$Age + 2)
  
  # 随机抽取10名（样本充足时无问题，若不足则返回全部并警告）
  if (nrow(eligible_controls) < 10) {
    warning(paste("病例", case_row$Case_ID, "符合条件的对照不足10名，已返回所有合格对照"))
    sampled_controls <- eligible_controls
  } else {
    sampled_controls <- eligible_controls %>% slice_sample(n = 10, replace = FALSE)
  }
  
  # 标记匹配的病例ID，方便后续关联
  sampled_controls <- sampled_controls %>%
    mutate(matched_case_id = case_row$Case_ID)
  
  return(sampled_controls)
}

# 对所有病例执行匹配
matched_controls_list <- case_data %>%
  rowwise() %>%
  group_map(~ match_controls(.x))

# 合并所有匹配后的对照
matched_controls <- bind_rows(matched_controls_list)

# 若需要合并病例与匹配后的对照为完整数据集
final_matched_data <- bind_rows(case_data, matched_controls)

你遇到的问题原因分析 #

1. 第一段代码缺失30名对照：

   • 大概率是部分病例的年龄区间内合格对照被重复抽取（若未限制对照不重复匹配），或个别病例年龄极端导致合格对照不足10名。可以检查代码中是否限制了对照的唯一性，或添加警告语句排查这类情况。
   • 若研究要求对照不能重复匹配给多个病例，可使用下方的对照不重复版本代码。

2. 第二段代码slice_sample()报错：

   • slice_sample()是dplyr 1.0.0及以上版本新增的函数，若你的dplyr版本过低会触发该错误。解决方法：
     • 升级dplyr：install.packages("dplyr")
     • 或替换为旧版本函数sample_n()：将slice_sample(n = 10)改为sample_n(10)

对照不重复匹配版本（可选） #

若要求每名对照仅匹配给一个病例，可修改匹配函数，每次抽样后从对照池中移除已选中的样本：

match_controls_unique <- function(case_row) {
  eligible_controls <- control_data %>%
    filter(Age >= case_row$Age - 2, Age <= case_row$Age + 2)
  
  if (nrow(eligible_controls) < 10) {
    warning(paste("病例", case_row$Case_ID, "符合条件的对照不足10名"))
    sampled <- eligible_controls
  } else {
    sampled <- eligible_controls %>% slice_sample(n = 10)
  }
  
  # 从全局对照池中移除已选中的对照
  control_data <<- control_data %>% anti_join(sampled, by = "Control_ID")
  
  sampled <- sampled %>% mutate(matched_case_id = case_row$Case_ID)
  return(sampled)
}

# 执行不重复匹配
matched_controls_unique <- case_data %>%
  rowwise() %>%
  group_map(~ match_controls_unique(.x)) %>%
  bind_rows()

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