如何用Tidyverse风格实现无日期间隔的住院记录分组聚合？

现有一组患者住院数据，部分记录包含event布尔列。需求为：从标记event=TRUE的住院记录开始，将后续时间连续（前一次住院结束日与下一次开始日无间隔）的所有住院记录归为一组，最终汇总每组的起始日期、结束日期及总费用。

示例数据与预期输出 #

library(tidyverse)
library(lubridate)

# 输入数据
input <- tribble(
 ~ begin          ,  ~ end            , ~ event,  ~ cost,
 ymd("2022/11/21"),  ymd("2023/11/30"), FALSE   ,      6,
 ymd("2023/01/01"),  ymd("2023/01/03"), TRUE   ,       8,
 ymd("2023/01/07"),  ymd("2023/01/10"), FALSE  ,       2,
 ymd("2023/01/14"),  ymd("2023/01/19"), TRUE   ,       3,
 ymd("2023/01/19"),  ymd("2023/01/25"), FALSE  ,       7,
 ymd("2023/02/14"),  ymd("2023/03/01"), FALSE  ,       5,
 ymd("2023/04/03"),  ymd("2023/04/11"), TRUE   ,       5,
 ymd("2023/04/11"),  ymd("2023/04/21"), FALSE  ,       2,
 ymd("2023/04/21"),  ymd("2023/04/23"), FALSE  ,       4,
 ymd("2023/05/01"),  ymd("2023/06/22"), FALSE  ,      15,
) 

# 预期输出
expected_output <- tribble(
 ~ begin          ,  ~ end            , ~ cost,
 ymd("2023/01/01"),  ymd("2023/01/03"),      8,
 ymd("2023/01/14"),  ymd("2023/01/25"),     10,
 ymd("2023/04/03"),  ymd("2023/04/23"),     11,
)

Tidyverse风格解决方案 #

可以通过窗口函数标记分组起始、填充分组ID、筛选连续区间三步实现，完全避免循环：

result <- input %>%
  # 按住院开始时间排序，确保时序正确
  arrange(begin) %>%
  # 标记分组起始点，同时记录上一条记录的结束时间
  mutate(
    is_group_start = event,
    prev_end = lag(end)
  ) %>%
  # 生成分组ID：每个event=TRUE的记录对应一个新分组
  mutate(group_id = cumsum(is_group_start)) %>%
  # 筛选有效分组内的记录：要么是分组起始，要么同分组且时间连续
  filter(
    is_group_start | 
      (group_id != 0 & begin == prev_end & group_id == lag(group_id))
  ) %>%
  # 按分组汇总关键信息
  group_by(group_id) %>%
  summarise(
    begin = min(begin),
    end = max(end),
    cost = sum(cost)
  ) %>%
  ungroup() %>%
  # 移除临时分组ID列
  select(-group_id)

# 验证结果匹配度
all.equal(result, expected_output)
# [1] TRUE

逻辑说明 #

1. 排序：确保记录按住院时间先后排列，是判断时间连续性的基础。
2. 标记分组起始：用cumsum(is_group_start)生成递增的分组ID，每个event=TRUE的记录对应一个新分组。
3. 筛选连续记录：仅保留分组起始点，以及与前一条记录同分组且时间连续的记录（begin == prev_end）。
4. 汇总分组：按分组ID聚合，得到每组的最早起始日、最晚结束日和总费用。

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