如何在R中用aggregate/apply替代循环实现高效条件活动计数

我完全理解你的痛点——百万行数据加50+活动类型，双重循环简直是灾难，跑几小时都没结果太正常了。别担心，我们可以用向量化的分组操作或者高效的数据处理包来彻底解决这个问题，速度能提升好几个数量级。

先回顾下你的需求：针对每个ID的每条Outcome记录，统计该结果日期前180天内各Activity的出现次数，最后转成宽表格式。下面我给你两种高效的实现方案，分别基于tidyverse（dplyr+tidyr）和data.table，后者更适合超大规模数据。

方案1：用tidyverse（dplyr+tidyr）实现 #

这个方案语法直观，符合tidy数据的操作习惯，适合大多数R用户。

首先加载所需包：

library(dplyr)
library(tidyr)

先构造你的原始数据：

ID <- c(1,1,1,1,1,1,2,2,2,2)
Date <- as.Date(c("2/1/17", "4/1/17", "5/15/17", "5/20/17", "9/25/17", "10/1/17", "4/1/17", "10/5/17", "10/10/17", "10/20/17"), format = "%m/%d/%y")
Stage <- c("Activity 1", "Activity 2", "Activity 1", "Outcome 1", "Activity 3", "Outcome 0", "Activity 1", "Activity 4", "Activity 4", "Outcome 1")
df <- data.frame(ID, Date, Stage)

接下来分三步处理：

1. 分离活动记录和结果记录
2. 为每个结果匹配符合时间条件的活动
3. 统计次数并转成宽表

# 1. 拆分活动和结果数据
activities <- df %>% 
  filter(!grepl("Outcome", Stage)) %>%  # 筛选所有活动记录
  rename(Activity = Stage)

outcomes <- df %>% 
  filter(grepl("Outcome", Stage))  # 筛选所有结果记录

# 2. 匹配符合条件的活动并统计次数
activity_counts <- outcomes %>%
  # 按ID连接结果和活动数据
  left_join(activities, by = "ID", suffix = c("_outcome", "_activity")) %>%
  # 筛选活动日期在结果日期前180天内的记录
  filter(Date_activity >= Date_outcome - 180 & Date_activity < Date_outcome) %>%
  # 按结果维度分组，统计每个活动的出现次数
  group_by(ID, Date = Date_outcome, Stage = Stage_outcome, Activity) %>%
  summarise(Count = n(), .groups = "drop") %>%
  # 转成宽表，缺失的活动次数补0
  pivot_wider(names_from = Activity, values_from = Count, values_fill = 0)

运行后得到的结果就是你想要的：

activity_counts
#> # A tibble: 3 × 7
#>      ID Date       Stage     `Activity 1` `Activity 2` `Activity 3` `Activity 4`
#>   <dbl> <date>     <chr>            <int>        <int>        <int>        <int>
#> 1     1 2017-05-20 Outcome 1           2            1            0            0
#> 2     1 2017-10-01 Outcome 0           1            0            1            0
#> 3     2 2017-10-20 Outcome 1           0            0            0            2

方案2：用data.table实现（百万级数据首选） #

如果你的数据是百万行级别，data.table的非等值连接和高效分组统计会比tidyverse更快，内存占用也更低。

首先加载包并转成data.table格式：

library(data.table)

setDT(df)  # 将普通data.frame转成data.table

然后直接用非等值连接完成筛选和统计：

# 拆分活动和结果数据
activities <- df[!grepl("Outcome", Stage), .(ID, Date_activity = Date, Activity = Stage)]
outcomes <- df[grepl("Outcome", Stage), .(ID, Date_outcome = Date, Stage)]

# 非等值连接+统计+转宽表
activity_counts_dt <- outcomes[activities, 
                               on = .(ID, Date_outcome > Date_activity, Date_outcome <= Date_activity + 180), 
                               .(Count = .N), 
                               by = .(ID, Date = Date_outcome, Stage, Activity)] %>%
  dcast(ID + Date + Stage ~ Activity, value.var = "Count", fill = 0)

最终结果和方案1完全一致，但处理速度会快很多，尤其适合超大规模数据。

为什么这两种方法比循环快？ #

• 向量化操作：底层用C/C++实现，避免了R原生循环的巨大开销，时间复杂度从O(n*m)降到O(n log n)
• 自动适配活动类型：不管你有50种还是100种活动，代码都会自动识别并生成对应列，不用手动列名适配
• 内存高效：data.table的操作会尽量在原数据上修改，减少内存复制，百万级数据也能轻松处理

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