在含缺失日期的R数据中标记连续3天Dist≤500的首次日期

样本数据 #

ID=rep(c(1,2,3),times=10)
Date=rep(seq(as.Date("2020-05-16"),as.Date("2020-05-25"),1),each=3)
Dist=c(191,134,607,970,1050,480,302,200,108,420,1050,480,302,200,108,420,191,134,607,970,
       480,302,200,108,560,490,480,302,200,108)
dat<-data.frame(ID=ID,Date=Date,Dist=Dist)

dat<-dat %>% 
  arrange(ID,Date)
dat<-dat[-2,]
dat<-dat[-25,] %>% 
  arrange(ID,Date)

需求 #

按ID（后续将扩展至按年份）遍历数据，找出每个ID首次出现连续3天（日期连续，数据集可能存在日期缺失）Dist≤500的日期，新增列记录该日期（同一ID可能多次出现该情况或未出现）。

已尝试的代码 #

首先添加了标记连续3行Dist≤500的den列和计算日期差的date_diff列：

dat<-dat %>% 
  arrange(ID,Date) %>% 
  group_by(ID) %>% 
  mutate(den=ifelse((lag(Dist)<=500)&Dist<=500&lead(Dist)<=500,1,0),
         date_diff=c(0,diff(Date))) %>% 
  ungroup()

之后尝试用lead()和lag()筛选日期连续的情况，但无法准确获取首次符合条件的日期：

dat<-dat %>% 
  mutate(Crit=ifelse(den==1 & (lead(date_diff==1)&date_diff==1&
                                 (lag(date_diff==0)|lag(date_diff==1))),1,0))

解决方案 #

方法1：基于dplyr的分组与连续序列识别 #

通过标记每日是否满足条件、识别连续日期序列，再筛选出首次出现的长度≥3的有效序列起始日期：

library(dplyr)

dat_result <- dat %>%
  arrange(ID, Date) %>%
  group_by(ID) %>%
  # 标记当日是否满足Dist≤500
  mutate(meet_criteria = Dist <= 500,
         # 标记与前一日日期是否连续
         date_continuous = c(FALSE, diff(Date) == 1)) %>%
  # 生成连续满足条件的分组ID：当日期不连续或不满足条件时，分组ID递增
  mutate(group_id = cumsum(!(meet_criteria & date_continuous | lag(meet_criteria, default = FALSE)))) %>%
  # 统计每个连续分组的天数
  group_by(ID, group_id) %>%
  mutate(group_length = n()) %>%
  ungroup() %>%
  # 找出每个ID中第一个长度≥3的有效分组的起始日期
  group_by(ID) %>%
  mutate(first_valid_start = ifelse(
    group_length >= 3 & row_number() == min(which(group_length >= 3)),
    Date,
    NA
  )) %>%
  # 将首次起始日期填充到该ID的所有行
  fill(first_valid_start, .direction = "downup") %>%
  # 清理临时辅助列
  select(-meet_criteria, -date_continuous, -group_id, -group_length) %>%
  ungroup()

方法2：使用slider包的滑动窗口（更直观） #

借助slider包的滑动窗口功能，直接检查连续3天的条件是否满足，再提取首次有效窗口的起始日期：

library(dplyr)
library(slider)

dat_result <- dat %>%
  arrange(ID, Date) %>%
  group_by(ID) %>%
  # 滑动窗口检查：当前及后两天是否都满足Dist≤500，且日期连续
  mutate(has_valid_window = slide_lgl(
    .x = tibble(Date, Dist),
    .f = ~ all(.x$Dist <= 500) & all(diff(.x$Date) == 1),
    .before = 0,
    .after = 2,
    .complete = TRUE
  )) %>%
  # 提取每个ID的首个有效窗口的起始日期
  mutate(first_valid_start = ifelse(
    row_number() == min(which(has_valid_window), default = Inf),
    Date,
    NA
  )) %>%
  # 将首次起始日期填充到该ID的所有行
  fill(first_valid_start, .direction = "downup") %>%
  ungroup()

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