按分组确定多段连续事件的起止日期

问题背景 #

我有一个包含site、Date、Event三列的dataframe，包含两个站点、一系列日期，以及表示事件是否发生的标记（无事件编码为0，有事件编码为1）。需要生成按分组统计的连续事件起止日期表。

示例数据 #

aa <- data.frame(
  site = c('a','a','a','a','a','a','a','a','a','a',
           'b','b','b','b','b','b','b','b','b','b'),
  Date = rep(seq(as.Date('2023-11-01'),
                 as.Date('2023-11-10'),
                 by = 1),2),
  Event = c(0,0,1,1,1,0,1,1,0,0,
            1,1,1,0,1,0,0,1,1,1) 
)

预期输出 #

site start_date   end_date
1    a 2023-11-03 2023-11-05
2    a 2023-11-07 2023-11-08
3    b 2023-11-01 2023-11-03
4    b 2023-11-05 2023-11-05
5    b 2023-11-08 2023-11-10

原尝试代码及问题 #

我尝试了以下代码：

library(tidyverse)

aa %>%
  group_by(site) %>%
  mutate(
    start_date = ifelse(Event != 0 & lag(Event == 0, n = 1), Date, NA),
    end_date = ifelse(Event != 0 & lead(Event == 0, n = 1), Date, NA)
  ) %>%
  filter(!is.na(start_date) | !is.na(end_date)) %>%
  fill(c(start_date, end_date), .direction = "downup") %>%
  distinct(site, start_date, end_date)

但这段代码存在三个问题：

• 日期以数字而非日期类型返回
• 事件在首个日期开始或最后一个日期结束时处理异常
• 无法正确统计每组的事件数量

修正后的解决方案 #

使用cumsum给每个连续事件组生成唯一标签，再按标签聚合起止日期，完美解决上述问题：

library(tidyverse)

aa %>%
  group_by(site) %>%
  # 为连续的事件组生成标签：当当前是事件且前一个不是事件时，标签递增
  mutate(event_group = cumsum(Event == 1 & lag(Event, default = 0) == 0)) %>%
  # 仅保留有事件的行
  filter(Event == 1) %>%
  # 按站点和事件组聚合，提取起止日期
  group_by(site, event_group) %>%
  summarise(
    start_date = min(Date),
    end_date = max(Date),
    .groups = "drop"
  ) %>%
  # 移除辅助的事件组标签列
  select(-event_group)

问题解决说明 #

1. 日期类型保留：直接对原始Date列取min()和max()，不会触发类型转换，始终保持日期格式。
2. 首尾事件处理：lag(Event, default = 0)将首个日期的前一个事件默认设为0，确保开头的连续事件能被正确标记；结尾的连续事件通过max(Date)自动取到最后一个日期，无遗漏。
3. 事件数量准确：每个event_group对应一个独立的连续事件，聚合后每条结果就是一个事件的起止记录，数量完全匹配预期。

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