如何基于日期差递归筛选并变更滞后参考行？[R语言]

筛选出距离最后保留的事件记录5天内的事件，且滞后计算的参考应为上一条被保留的行，而非数据中的上一行。

示例数据 #

df <- structure(list(ID = c(1177, 1177, 1177, 1177, 1177, 1177), Period = c(0, 0, 0, 0, 0, 0), Date = c("04/16/20", "04/17/20", "04/20/20", "04/20/20", "04/23/20", "04/25/20"), Event = c("M", "M", "M", "M", "M", "M")), row.names = c(NA, -6L),class = c("tbl_df", "tbl", "data.frame"))

原代码问题 #

原代码使用lag(Date)计算的是数据中当前行的上一行日期，并非上一条被保留的行的日期，导致筛选逻辑不符合需求：

df %>% 
  select(ID, Period, Date, Event) %>%
  mutate_if(is.numeric, as.character) %>% 
  mutate(Date = lubridate::mdy(Date)) %>% 
  group_by(ID, Period, Event) %>% 
  arrange(ID, Period, Event, Date) %>% 
  mutate(
     lead_1 = Date - lead(Date),
    lag_1 = Date - lag(Date)) %>%
  filter(is.na(lag_1) | lag_1 > 5)

修正后的代码 #

使用purrr::accumulate迭代跟踪最后保留的日期，逐行判断是否满足保留条件：

library(dplyr)
library(lubridate)
library(purrr)

df_processed <- df %>%
  select(ID, Period, Date, Event) %>%
  mutate(Date = mdy(Date)) %>%
  group_by(ID, Period, Event) %>%
  arrange(Date, .by_group = TRUE) %>%
  mutate(
    # 迭代记录最后保留的日期：满足间隔>5天则更新，否则沿用之前的日期
    last_kept_date = accumulate(Date, function(last, current) {
      if (is.na(last)) {
        current
      } else if (current - last > 5) {
        current
      } else {
        last
      }
    }),
    # 标记需要保留的行：当前日期等于最后保留的日期则保留
    keep = Date == last_kept_date
  ) %>%
  filter(keep) %>%
  select(-last_kept_date, -keep) %>%
  ungroup()

逻辑说明 #

1. 先按ID、Period、Event分组并按日期排序，确保数据顺序正确。
2. 用accumulate迭代每一行：
   • 第一行直接保留，将当前日期设为初始的「最后保留日期」。
   • 后续行判断当前日期与「最后保留日期」的间隔：若间隔超过5天，保留该行并更新「最后保留日期」；否则不保留，沿用之前的日期。
3. 通过Date == last_kept_date标记保留行，最后筛选出符合要求的记录。

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