如何基于日期条件关联并分配两个DataFrame的事件与单元？

现有两个带日期的数据集，需要把ancillary_df中的units准确分配到anchor_df的锚点事件中。核心难点是辅助事件可能和多个锚点事件的日期区间存在关联，需要基于起止日期完成匹配分配。之前尝试用fuzzyjoin包未成功，以下是R代码示例和期望输出，寻求解决思路。

原始代码示例 #

library(tidyverse)
library(lubridate)
library(fuzzyjoin)

anchor_df <- tribble(
  ~person, ~anchor_beg, ~anchor_end,
  'a' , '01-01-2020', '01-05-2020' ,
  'a' , '01-17-2020', '01-18-2020' ,
  'a' , '02-11-2020', '02-22-2020' ,
  'b' , '04-01-2020', '04-07-2020' 
)

ancillary_df <- tribble(
  ~person,  ~anc_start , ~anc_end, ~units,
  'a' , '01-07-2020', '01-11-2020' ,3,
  'a' , '02-24-2020', '03-22-2020' , 15,
  'b' , '04-08-2020', '06-07-2020', 25 
)

anchor_df$anchor_beg <- mdy(anchor_df$anchor_beg)
anchor_df$anchor_end <- mdy(anchor_df$anchor_end)
ancillary_df$anc_start <- mdy(ancillary_df$anc_start)
ancillary_df$anc_end <- mdy(ancillary_df$anc_end)


fuzzy_left_join(
  ancillary_df, anchor_df,
  by = c(
    "person" = "person",
    "anc_start" = "anchor_end",
    "anc_start" = "anchor_beg"
  ),
  match_fun = list(`==`, `>=`, `<=`)
)

期望输出 #

解决思路与代码实现 #

从期望输出能看出，匹配规则是：每个辅助事件要分配给同一个用户下，时间上最近的前一个锚点事件（即锚点的结束时间早于辅助事件的开始时间，且是所有符合条件的锚点中最晚结束的那个）。

方法1：用dplyr完成匹配 #

library(tidyverse)
library(lubridate)

# 预处理数据，转换日期格式
anchor_df <- tribble(
  ~person, ~anchor_beg, ~anchor_end,
  'a' , '01-01-2020', '01-05-2020' ,
  'a' , '01-17-2020', '01-18-2020' ,
  'a' , '02-11-2020', '02-22-2020' ,
  'b' , '04-01-2020', '04-07-2020' 
) %>%
  mutate(across(c(anchor_beg, anchor_end), mdy))

ancillary_df <- tribble(
  ~person,  ~anc_start , ~anc_end, ~units,
  'a' , '01-07-2020', '01-11-2020' ,3,
  'a' , '02-24-2020', '03-22-2020' , 15,
  'b' , '04-08-2020', '06-07-2020', 25 
) %>%
  mutate(across(c(anc_start, anc_end), mdy))

# 执行匹配
result <- anchor_df %>%
  group_by(person) %>%
  mutate(anchor_seq = row_number()) %>% # 给锚点排序标记
  ungroup() %>%
  # 左连接辅助数据，筛选锚点结束时间早于辅助事件开始时间的记录
  left_join(ancillary_df, by = "person") %>%
  filter(anchor_end <= anc_start) %>%
  # 对每个辅助事件，选出最近的前一个锚点
  group_by(person, anc_start) %>%
  slice_max(anchor_end, n = 1) %>%
  ungroup() %>%
  # 保留需要的列，合并回原始锚点数据
  select(person, anchor_beg, anchor_end, units) %>%
  right_join(anchor_df, by = c("person", "anchor_beg", "anchor_end")) %>%
  arrange(person, anchor_beg)

print(result)

方法2：调整fuzzyjoin逻辑实现 #

如果你偏好使用fuzzyjoin，可以调整匹配规则后再筛选最近锚点：

library(tidyverse)
library(lubridate)
library(fuzzyjoin)

# 预处理数据（同上）
anchor_df <- tribble(
  ~person, ~anchor_beg, ~anchor_end,
  'a' , '01-01-2020', '01-05-2020' ,
  'a' , '01-17-2020', '01-18-2020' ,
  'a' , '02-11-2020', '02-22-2020' ,
  'b' , '04-01-2020', '04-07-2020' 
) %>%
  mutate(across(c(anchor_beg, anchor_end), mdy))

ancillary_df <- tribble(
  ~person,  ~anc_start , ~anc_end, ~units,
  'a' , '01-07-2020', '01-11-2020' ,3,
  'a' , '02-24-2020', '03-22-2020' , 15,
  'b' , '04-08-2020', '06-07-2020', 25 
) %>%
  mutate(across(c(anc_start, anc_end), mdy))

# 用fuzzy_inner_join先找到所有可能匹配
matched_records <- fuzzy_inner_join(
  anchor_df, ancillary_df,
  by = c("person" = "person", "anchor_end" = "anc_start"),
  match_fun = list(`==`, `<=`)
) %>%
  group_by(person, anc_start) %>%
  slice_max(anchor_end, n = 1) %>% # 筛选最近的前一个锚点
  ungroup() %>%
  select(person, anchor_beg, anchor_end, units)

# 合并回原始锚点数据，保留所有锚点
result <- anchor_df %>%
  left_join(matched_records, by = c("person", "anchor_beg", "anchor_end")) %>%
  arrange(person, anchor_beg)

print(result)

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