如何基于数据范围更高效地为事件分配对应值？

我有一批带特定日期的事件，需要根据事件日期所属的任期区间给事件添加对应的领导人信息。目前用case_when写的代码虽然能跑，但扩展性很差，想知道有没有向量化的处理方式。

代表性数据 #

events
#>   event_name event_date
#> 1    event a 2012-05-23
#> 2    event b 2018-03-12
#> 3    event c 2019-08-17
#> 4    event d 2022-01-03

leader_tenure
#>    leader      start        end
#> 1 Manning 2012-04-09 2017-12-30
#> 2    Hale 2017-12-30 2019-11-09
#> 3 Whitney 2019-11-10 2022-05-30

现有低效且扩展性差的代码 #

library(dplyr)
library(lubridate)

events <- data.frame(
  event_name = c("event a", "event b", "event c", "event d"),
  event_date = ymd(c("2012-05-23", "2018-03-12", "2019-08-17", "2022-01-03"))
)

leader_tenure <- data.frame(
  leader = c("Manning", "Hale", "Whitney"),
  start = ymd(c("2012-04-09", "2017-12-30", "2019-11-10")),
  end = ymd(c("2017-12-30", "2019-11-09", "2022-05-30"))
)

events |>
  mutate(
    leader = case_when(
      event_date %within% interval(ymd("2012-04-09"), ymd("2017-12-30")) ~ "Manning",
      event_date %within% interval(ymd("2017-12-30"), ymd("2019-11-09")) ~ "Hale",
      event_date %within% interval(ymd("2019-11-10"), ymd("2022-05-30")) ~ "Whitney"
    )
  )
#>   event_name event_date  leader
#> 1    event a 2012-05-23 Manning
#> 2    event b 2018-03-12    Hale
#> 3    event c 2019-08-17    Hale
#> 4    event d 2022-01-03 Whitney

几种高效向量化解决方案 #

方法1：用fuzzyjoin包做区间匹配

不需要手动编写每个区间条件，新增领导人时直接更新leader_tenure数据框即可，扩展性拉满：

library(fuzzyjoin)

events |>
  fuzzy_left_join(
    leader_tenure,
    by = c("event_date" = "start", "event_date" = "end"),
    match_fun = list(`>=`, `<`) # 匹配逻辑：event_date在[start, end)区间内
  ) |>
  select(event_name, event_date, leader)

如果需要包含区间结束日期，把match_fun里的<改成<=即可。

方法2：dplyr结合rowwise简洁实现

不用额外装包，通过逐行匹配区间实现：

events |>
  rowwise() |>
  mutate(
    leader = leader_tenure$leader[which(event_date >= leader_tenure$start & event_date < leader_tenure$end)]
  ) |>
  ungroup()

方法3：完全向量化的findInterval（性能最优）

利用findInterval快速定位日期所属区间，适合大数据量场景，前提是leader_tenure的start日期是升序排列的：

events |>
  mutate(
    leader = leader_tenure$leader[findInterval(event_date, leader_tenure$start)]
  )

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