如何用tidyverse高效为百万行时间序列标记事件区间

我有一个百万行级别的tibble格式时间序列数据，包含多个不同ID，每个ID对应数万条数据点：

timeseries <- tibble(ID = c(101, 101, 101, 101, 101), 
                     time = c(1,2,3,4,5), 
                     block = c(0,0,0,0,0))

还有一个数千行的tibble，记录了不同ID的事件起止时间，需要将这些事件标记到时间序列中（方便后续用summarize()汇总），每个ID的时间序列在事件间、首尾存在空白时间点：

blocks <- tibble(ID = c(101, 101), 
                 block = c(1, 2), 
                 st = c(1, 4), 
                 end = c(2,5))

当前用循环方案效率极低且繁琐：

j <- 1
for(i in 1:nrow(blocks)){
  checkrow <- blocks[i,]
  while(timeseries[j, "ID"] < checkrow["ID"]) j = j+1   # 跳过不匹配的ID
  while(timeseries[j, "time"] < checkrow["st"]) j = j+1 # 跳到事件起始时间点
  while(timeseries[j, "time"] < checkrow["end"]){
    timeseries[j, "block"] <- checkrow["block"]         # 标记事件区间内的时间点
    j = j+1
  }
}

后续用基础R优化了方案，速度提升明显，但想知道tidyverse框架内的向量式实现方法，避免循环。

方法1：dplyr结合lubridate区间匹配 #

利用lubridate的区间功能，先给事件数据创建时间区间，再按ID匹配后判断时间点是否落在区间内：

library(tidyverse)
library(lubridate)

# 为事件数据生成时间区间
blocks_with_interval <- blocks %>%
  mutate(time_interval = interval(st, end))

# 匹配并更新block标记
timeseries_updated <- timeseries %>%
  left_join(blocks_with_interval, by = "ID") %>%
  group_by(ID, time) %>%
  mutate(
    # 优先取匹配区间的block值，无匹配则保留原block（0）
    block = if_else(any(time %within% time_interval), 
                   block.y[time %within% time_interval], 
                   block.x)
  ) %>%
  select(ID, time, block) %>%
  distinct() # 处理同一时间点匹配多个区间的重复行

方法2：fuzzyjoin模糊匹配（直观高效） #

fuzzyjoin专门处理非精确匹配场景，适合这种时间区间匹配需求：

library(tidyverse)
library(fuzzyjoin)

timeseries_updated <- timeseries %>%
  fuzzy_left_join(
    blocks, 
    by = c("ID" = "ID", "time" = "st", "time" = "end"),
    match_fun = list(`==`, `>=`, `<`) # 匹配规则：ID相等，time≥起始时间，time<结束时间
  ) %>%
  group_by(ID, time) %>%
  mutate(block = coalesce(block.y, block.x)) # 有匹配用事件block，无匹配保留原值
  select(ID, time, block) %>%
  ungroup()

方法3：分组向量操作（超大数据优化） #

针对百万级数据，分组后用向量逻辑直接匹配，避免额外join开销：

library(tidyverse)

timeseries_updated <- timeseries %>%
  group_by(ID) %>%
  mutate(
    block = pmap_dbl(list(time), ~{
      t <- ..1
      # 获取当前ID对应的所有事件区间
      id_blocks <- blocks %>% filter(ID == cur_group()$ID)
      # 找到时间点所属区间，返回对应block，无匹配则保留原值
      match_idx <- which(id_blocks$st <= t & t < id_blocks$end)
      if(length(match_idx) > 0) id_blocks$block[match_idx] else block[time == t]
    })
  ) %>%
  ungroup()

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