在R中实现动态变量匹配：暴露组与对照组的年龄匹配问询

数据预处理 #

首先计算匹配所需的核心变量：暴露个体的暴露时年龄，以及对照组的最晚有效日期（确保匹配的对照组在暴露个体暴露时仍处于观察期内）：

library(tidyverse)
library(lubridate)

# 生成匹配关键变量
df <- df %>%
  mutate(
    # 暴露个体的暴露当天年龄（精确到年）
    age_at_exp = if_else(exposed == 1, 
                         interval(date_birth, date_exp) %/% years(1), 
                         NA_integer_),
    # 对照组的最晚有效日期：去世则用死亡日期，否则用观察期结束日2020-12-31
    control_valid_until = if_else(exposed == 0,
                                  coalesce(date_death, as.Date("2020-12-31")),
                                  as.Date(NA))
  )

# 拆分暴露组与对照组
exposed_group <- df %>% filter(exposed == 1)
control_group <- df %>% filter(exposed == 0)

执行最优匹配 #

使用fuzzyjoin包实现同性别精确匹配+年龄近邻匹配，同时自动过滤掉在暴露个体暴露前已去世的对照组：

library(fuzzyjoin)

# 1:1 最优匹配（可调整为1:N）
matched_result <- exposed_group %>%
  # 按性别严格匹配，年龄差异控制在±2岁（可修改max_dist调整匹配严格度）
  difference_join(
    control_group,
    by = c("sex" = "sex", "age_at_exp" = "age_at_exp"),
    max_dist = 2,
    match_fun = list(`==`, `-`),
    suffix = c("_exp", "_ctrl"),
    keep = TRUE
  ) %>%
  # 仅保留暴露时仍存活的对照组
  filter(date_exp <= control_valid_until_ctrl) %>%
  # 筛选每个暴露个体的最优匹配（年龄差异最小）
  mutate(age_difference = abs(age_at_exp_exp - age_at_exp_ctrl)) %>%
  group_by(id_exp) %>%
  slice_min(age_difference, n = 1, with_ties = FALSE) %>%
  ungroup()

关键细节说明 #

• 年龄匹配阈值：修改max_dist可调整年龄匹配的宽松度，比如设为1则仅匹配±1岁范围内的对照组。
• 1:N匹配：若需为每个暴露个体匹配多个对照组，将slice_min中的n改为对应数量即可（如n=3实现1:3匹配）。
• 匹配质量验证：匹配完成后可通过以下代码检查组间平衡：

  # 可视化匹配前后的年龄分布差异
  bind_rows(
    exposed_group %>% select(age_at_exp) %>% mutate(group = "暴露组（匹配前）"),
    control_group %>% select(age_at_exp) %>% mutate(group = "对照组（匹配前）"),
    matched_result %>% select(age_at_exp_exp) %>% rename(age_at_exp = age_at_exp_exp) %>% mutate(group = "暴露组（匹配后）"),
    matched_result %>% select(age_at_exp_ctrl) %>% rename(age_at_exp = age_at_exp_ctrl) %>% mutate(group = "对照组（匹配后）")
  ) %>%
    ggplot(aes(x = age_at_exp, fill = group)) +
    geom_density(alpha = 0.5) +
    theme_minimal()
  

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