在R中按单元统计指定采样日期前的事件及月份数

我有一份按unit（单元）分组的数据集，包含事件日期、事件月份、采样日期及年份字段。需要实现：

• 针对每个采样日期，按unit统计该日期之前发生的事件数量
• 统计这些事件涉及的不同月份数

存在两个复杂场景：

• 部分年份中事件日期晚于采样日期，这类事件不应被统计
• 部分年份仅有采样日期但无事件，这类情况也需要保留统计结果（事件数为0，月份数为0）

示例数据 #

实际数据集约6000条观测，示例数据如下：

data<-read.table(header=T, text="
 unit  eventdate eventmonth  sampledate  year
 a 1996-06-01  06  1996-08-01  1996
 a 1997-09-03  09  1997-08-02  1997
 a 1998-05-15  05  1998-08-03  1998
 a NA  NA  1999-08-02  1999
 b 1996-05-31  05  1996-08-01  1996
 b 1997-05-31  05  1997-08-02  1997
 b 1998-05-15  05  1998-08-03  1998
 b 1999-05-16  05  1999-08-02  1999")

预期输出 #

year unit numevent nummonth
1996 a 1 1
1997 a 1 1
1998 a 3 3
1999 a 3 3
1996 b 1 1
1997 b 2 1
1998 b 3 1
1999 b 4 1

注意：单元a的1997年事件因晚于采样日期未被统计

现有问题 #

针对小型数据集，我曾手动按采样日期子集化数据并统计事件数/唯一月份数（再合并数据集），但这种方法无法处理约6000条观测的大数据量。现有手动处理代码片段：

numevent.1996<-ddply(data[data$eventdate<'1996-08-01',], .(unit), 
                     summarize, numevent=length(eventdate), nummth=length(unique(eventmonth)), year=1996)

用dplyr包的分组窗口操作可以高效解决这个问题，无需手动逐个日期处理，适合大数据量场景：

完整代码 #

library(dplyr)

# 转换日期格式，确保日期比较逻辑正确
data <- data %>%
  mutate(
    eventdate = as.Date(eventdate),
    sampledate = as.Date(sampledate)
  )

# 核心统计逻辑
result <- data %>%
  group_by(unit) %>%
  mutate(
    # 为每个采样日期，筛选当前unit下所有早于该日期的有效事件索引
    valid_events = list(which(!is.na(eventdate) & eventdate < sampledate)),
    # 统计有效事件数量
    numevent = sapply(valid_events, length),
    # 统计有效事件涉及的唯一月份数，无事件时返回0
    nummonth = sapply(valid_events, function(idx) {
      if(length(idx) == 0) 0 else length(unique(eventmonth[idx]))
    })
  ) %>%
  # 保留目标字段并去重（每个unit+year对应一条结果）
  select(year, unit, numevent, nummonth) %>%
  distinct() %>%
  ungroup()

# 输出结果
print(result)

代码说明 #

• group_by(unit)：按单元分组，保证每个单元的统计独立进行
• valid_events：用列表存储每个采样日期对应的有效事件索引，避免重复筛选
• sapply：遍历索引列表，分别计算事件数和唯一月份数
• distinct()：因为每个unit+year对应一条采样记录，去重后得到预期格式

大数据量优化 #

如果数据量远超6000条（比如10万+），可以改用data.table进一步提升效率：

library(data.table)

setDT(data)
data[, `:=`(eventdate = as.Date(eventdate), sampledate = as.Date(sampledate))]

result <- data[, {
  sd_list = sampledate
  valid_idx = lapply(sd_list, function(d) which(!is.na(eventdate) & eventdate < d))
  .(
    year = year,
    numevent = sapply(valid_idx, length),
    nummonth = sapply(valid_idx, function(idx) if(length(idx)==0) 0 else length(unique(eventmonth[idx])))
  )
}, by = unit]

print(result)

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