如何在R语言中执行固定日期范围的过滤连接？

问题场景 #

需要用tibble1过滤tibble2，保留同时满足以下条件的行：

• 匹配patient_id和laterality字段
• tibble2的日期与tibble1对应行的日期相差不超过±2天

普通的semi_join()只能处理精确匹配，无法直接纳入日期范围条件，因此需要其他实现方式。

示例数据 #

library(tibble)

# 创建tibble1
patient_id <- c("patient1", "patient2")
laterality <- c("L", "R")
date <- as.Date(c("2020-10-24", "2010-09-24"))
tibble1 <- tibble(patient_id, laterality, date)

# 创建tibble2
patient_id <- c("patient1", "patient2", "patient1", "patient1")
laterality <- c("L", "R", "R", "L")
date <- as.Date(c("2020-10-24", "2010-09-24", "2010-09-18", "2020-10-25"))
type <- c("dark", "light", "dark", "light")
tibble2 <- tibble(patient_id, laterality, date, type)

# 预期输出
patient_id <- c("patient1", "patient2", "patient1")
laterality <- c("L", "R", "L")
date <- as.Date(c("2020-10-24", "2010-09-24", "2020-10-25"))
type <- c("dark", "light", "light")
output <- tibble(patient_id, laterality, date, type)

解决方案 #

方法1：使用dplyr基础函数实现 #

通过内连接匹配共同字段，再筛选日期范围，最后去重保留目标行：

library(dplyr)

result <- tibble2 %>%
  # 按patient_id和laterality做内连接，区分两个表的日期字段
  inner_join(tibble1, by = c("patient_id", "laterality"), suffix = c("_2", "_1")) %>%
  # 筛选日期差≤2天的行
  filter(abs(date_2 - date_1) <= 2) %>%
  # 保留tibble2的字段
  select(patient_id, laterality, date = date_2, type) %>%
  # 去重避免同一行被多次匹配
  distinct()

# 验证结果与预期一致
all.equal(result, output)
#> [1] TRUE

方法2：使用fuzzyjoin包的模糊半连接 #

fuzzyjoin包专门处理非精确匹配连接，代码更简洁直观：

library(fuzzyjoin)
library(dplyr)

result <- tibble2 %>%
  fuzzy_semi_join(
    tibble1,
    # 指定字段对应关系
    by = c("patient_id" = "patient_id",
           "laterality" = "laterality",
           "date" = "date"),
    # 定义匹配规则：前两个字段精确匹配，日期差≤2天
    match_fun = list(`==`, `==`, function(x, y) abs(x - y) <= 2)
  )

all.equal(result, output)
#> [1] TRUE

方法3：逐行检查匹配条件（适合小数据集） #

通过pmap_lgl逐行验证tibble2的行是否符合匹配要求：

library(dplyr)
library(purrr)

result <- tibble2 %>%
  filter(
    pmap_lgl(., function(patient_id, laterality, date, ...) {
      tibble1 %>%
        filter(patient_id == !!patient_id, laterality == !!laterality) %>%
        mutate(date_diff = abs(date - !!date)) %>%
        pull(date_diff) %>%
        any(. <= 2)
    })
  )

all.equal(result, output)
#> [1] TRUE

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