如何用purrr遍历参考日期、筛选案例并生成长表？

1. 用purrr函数式编程生成活跃案例长表 #

你可以用purrr::map_dfr()直接遍历参考日期，筛选对应活跃案例并自动绑定结果，替代for循环：

library(tidyverse)

# 生成示例数据（修正原代码中Complete的采样逻辑）
set.seed(42)
Case_id <- seq(1:100)
Start <- sample(seq(as.Date("2022-08-01"), as.Date("2022-12-01"), by = "day"), 100, replace = TRUE)
Complete <- Start + sample(0:60, 100, replace = TRUE)
Other_attributes <- sample(c("Red", "Blue", "Green"), 100, replace = TRUE)

Cases <- tibble(Case_id, Start, Complete, Other_attributes)

# 定义每周参考日期
Reference_dates <- seq(as.Date("2022-09-04"), as.Date("2022-12-31"), by = "weeks")

# 生成活跃案例长表
active_cases_long <- map_dfr(Reference_dates, ~{
  Cases %>%
    filter(.x >= Start & .x <= Complete) %>%
    mutate(Reference_date = .x)
})

# 查看前几行结果
head(active_cases_long)

map_dfr()会自动将每个参考日期对应的筛选结果按行绑定，功能等价于map() %>% list_rbind()，代码更简洁直接。

2. 大数据场景下的高效替代方案 #

如果你的真实数据量较大，先生成长表会导致内存占用过高，推荐事件计数累加的方法——无需生成完整长表，直接计算各参考日期的活跃案例数：

核心原理 #

每个案例的Start日期对应活跃数+1，Complete+1日期对应活跃数-1（因为案例在Complete当天仍处于活跃状态），通过累加每日的变化量得到活跃数，最后匹配到参考日期即可。

代码实现 #

全局活跃数统计

active_counts <- Cases %>%
  # 转换为事件数据：Start为新增，Complete+1为结束
  pivot_longer(cols = c(Start, Complete), names_to = "event", values_to = "date") %>%
  mutate(
    change = if_else(event == "Start", 1, -1),
    date = if_else(event == "Complete", date + 1, date)
  ) %>%
  # 按日期汇总每日变化量
  group_by(date) %>%
  summarise(change = sum(change), .groups = "drop") %>%
  # 填充所有日期的变化量（缺失日期变化为0）
  complete(date = seq(min(date), max(Reference_dates), by = "day"), fill = list(change = 0)) %>%
  # 计算累计活跃数
  mutate(active = cumsum(change)) %>%
  # 筛选并匹配到参考日期
  right_join(tibble(Reference_date = Reference_dates), by = c("date" = "Reference_date")) %>%
  select(Reference_date = date, active)

head(active_counts)

按属性分组统计

如果需要按Other_attributes或其他属性分组，只需在开头添加group_by()：

active_counts_by_attr <- Cases %>%
  group_by(Other_attributes) %>%
  pivot_longer(cols = c(Start, Complete), names_to = "event", values_to = "date") %>%
  mutate(
    change = if_else(event == "Start", 1, -1),
    date = if_else(event == "Complete", date + 1, date)
  ) %>%
  group_by(Other_attributes, date) %>%
  summarise(change = sum(change), .groups = "drop_last") %>%
  complete(date = seq(min(date), max(Reference_dates), by = "day"), fill = list(change = 0)) %>%
  mutate(active = cumsum(change)) %>%
  right_join(tibble(Reference_date = Reference_dates), by = c("date" = "Reference_date")) %>%
  select(Other_attributes, Reference_date = date, active)

head(active_counts_by_attr)

方案优势 #

这种方法的计算量仅与案例数成正比（每个案例生成2条事件记录），远小于长表的生成成本（参考日期数×活跃案例数），内存占用和计算效率都大幅提升，适合大样本数据场景。

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