如何在两个data.frame间匹配最近日期？R语言多方法疑问

我有两个数据框：

1. 记录不同运营商特定日期火车乘客数量的data.frame：

df <- data.frame(
  date_of_sampling = c("2021-01-01","2021-02-04","2021-01-03","2021-02-03"),
  operator = c("A","A","B","B"),
  num_passengers = c(204,155,100,400)
)

2. 记录每周新冠流行率的data.frame：

ONS <- data.frame(
  sample_date_midpoint = c("2020-05-03","2020-06-10","2020-06-20","2020-08-03","2021-01-01","2021-01-06","2021-02-05","2021-02-08"),
  prevalence = runif(8)
)

我的需求是：将df中的日期与ONS中最近的日期匹配，并关联对应的流行率。

已尝试的方法及疑问 #

1. Base R 方法 #

# 计算时间差
temp <- outer(df$date_of_sampling, ONS$sample_date_midpoint,  "-")

# 剔除时间差超过±5天的记录
temp[temp < -5 | temp > 5] <- NA

# 找出最小时间差的索引
ind <- apply(temp, 1, function(i) which.min(i))

# 输出结果
df2 <- cbind(ONS,  df[ind,])

疑问：如何保证绑定的是唯一日期？当前结果会重复ONS中的行，怎么只保留匹配到的唯一对应关系？

2. data.table 方法 #

setDT(df)            ## 转换为data.table
setDT(ONS)            ## 同上

df[, date := date_of_sampling]  ## 复制date_of_sampling列
setkey(df, date_of_sampling)    ## 设置连接键
ONS[, date := sample_date_midpoint]  ## 复制sample_date_midpoint列
setkey(ONS, date)    ## 设置连接键

ONS[df, roll=5] 

该方法可行，但有疑问：若ONS中有多个与df日期相近（时间差在±5天内）的采样日时，会如何处理？

3. 寻求 dplyr 实现方案 #

希望得到基于dplyr包的解决方法，实现相同的需求：匹配最近日期（限制±5天内）并关联流行率。

解决方案 #

针对 Base R 方法的优化 #

要绑定唯一日期，需调整索引提取和结果拼接逻辑，确保每一行df只匹配到ONS中符合条件的唯一行：

# 先将日期转换为Date类型（避免字符运算出错）
df$date_of_sampling <- as.Date(df$date_of_sampling)
ONS$sample_date_midpoint <- as.Date(ONS$sample_date_midpoint)

# 计算时间差绝对值矩阵
temp <- outer(df$date_of_sampling, ONS$sample_date_midpoint, function(x,y) abs(x - y))

# 剔除超过5天的时间差
temp[temp > 5] <- NA

# 找到每行最小时间差的索引，无匹配则设为NA
ind <- apply(temp, 1, function(i) {
  if(all(is.na(i))) NA else which.min(i)
})

# 拼接结果，只保留df的行和对应的ONS数据
df2 <- cbind(df, ONS[ind, c("sample_date_midpoint", "prevalence")])
# 重命名列更清晰
colnames(df2)[4:5] <- c("matched_ons_date", "prevalence")

最终的df2每行对应df的原始行，仅绑定匹配到的唯一ONS日期和流行率，不会重复ONS的行。

data.table 方法的疑问解答 #

data.table的roll=5参数是向前滚动匹配：当df的日期在ONS的日期之后且时间差不超过5天时，会匹配最近的前一个ONS日期；若有多个符合时间差的日期，只会取最接近且在df日期之前的那一个。

如果需要双向匹配（取前后最近的日期），可使用roll="nearest"并结合rollends参数限制时间范围：

setDT(df)[, date := as.Date(date_of_sampling)]
setDT(ONS)[, date := as.Date(sample_date_midpoint)]

# 双向匹配最近日期，限制时间差不超过5天
result <- ONS[df, on = .(date), roll = "nearest", rollends = c(TRUE, TRUE), 
              nomatch = NA][abs(date - i.date) > 5, c("prevalence", "sample_date_midpoint") := NA]
# 整理列
result <- result[, .(date_of_sampling = i.date, operator, num_passengers, 
                     matched_ons_date = sample_date_midpoint, prevalence)]

这样会匹配前后5天内最近的日期，超过范围则设为NA。

dplyr 实现方案 #

方法1：原生dplyr+tidyr实现

library(dplyr)
library(tidyr)

# 转换日期类型
df <- df %>% mutate(date_of_sampling = as.Date(date_of_sampling))
ONS <- ONS %>% mutate(sample_date_midpoint = as.Date(sample_date_midpoint))

# 为每个df的日期匹配ONS中5天内最近的日期
df_matched <- df %>%
  rowwise() %>%
  mutate(
    # 计算当前日期与所有ONS日期的时间差绝对值
    time_diff = list(abs(date_of_sampling - ONS$sample_date_midpoint)),
    # 筛选出时间差≤5天的记录
    valid_matches = list(ONS[time_diff <= 5, ]),
    # 找到最近的那一行，无匹配则设为NA
    matched = list(if(nrow(valid_matches) > 0) valid_matches[which.min(time_diff[time_diff <= 5]), ] else NA)
  ) %>%
  # 展开匹配结果
  unnest_wider(matched, names_sep = "_") %>%
  # 清理无用列
  select(-time_diff, -valid_matches) %>%
  # 重命名列
  rename(matched_ons_date = matched_sample_date_midpoint, prevalence = matched_prevalence)

# 处理无匹配的情况
df_matched <- df_matched %>% mutate(across(c(matched_ons_date, prevalence), ~ifelse(is.na(.), NA, .)))

方法2：使用fuzzyjoin扩展包（更简洁）

library(fuzzyjoin)

df_matched <- df %>%
  mutate(date_of_sampling = as.Date(date_of_sampling)) %>%
  # 模糊连接筛选5天内的所有匹配
  fuzzy_left_join(
    ONS %>% mutate(sample_date_midpoint = as.Date(sample_date_midpoint)),
    by = c("date_of_sampling" = "sample_date_midpoint"),
    match_fun = ~abs(.x - .y) <= 5
  ) %>%
  # 按df的原始行分组
  group_by(date_of_sampling, operator, num_passengers) %>%
  # 选择时间差最小的匹配项
  filter(abs(date_of_sampling - sample_date_midpoint) == min(abs(date_of_sampling - sample_date_midpoint))) %>%
  # 去重（若存在多个时间差相同的情况）
  slice_head(n = 1) %>%
  ungroup() %>%
  rename(matched_ons_date = sample_date_midpoint)

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