在R中统计ID的年度事件数，包含无事件年份的0值

需求说明 #

需要统计每个ID在start到end日期范围内每年的事件发生数量，包含无事件年份的0值，而非仅统计有事件的年份。

示例数据 #

example<-data.frame(ID=c(1,1,1,1,2,2,3,3,3,3,3,3,3,3),
                    start=c("1998-05-01","1998-05-01","1998-05-01","1998-05-01",
                            "2020-07-20","2020-07-20",
                            "1977-12-23","1977-12-23","1977-12-23","1977-12-23",
                            "1977-12-23","1977-12-23","1977-12-23","1977-12-23"),
                    end=c("2007-05-01","2007-05-01","2007-05-01","2007-05-01",
                           "2021-07-20","2021-07-20",
                           "1990-12-23","1990-12-23","1990-12-23","1990-12-23",
                           "1990-12-23","1990-12-23","1990-12-23","1990-12-23"),
                    date_event=c("1998-06-05","2000-01-01","2002-11-30","2006-12-21",
                                 "2020-12-20","2020-12-25",
                                 "1978-02-23","1982-05-05","1983-06-20","1988-11-29",
                                 "1988-12-29","1990-01-01","1990-12-15","1990-12-15"))

现有尝试的问题 #

• data.table代码：仅统计了有事件的年份，无法覆盖起止范围内的所有年份

  example[,year:=lubridate::year(date_event)]
  summary<-example[,.(contacts=.N),by=c("ID","year","start","end")]
  

• dplyr代码：错误在于尝试全局生成年份水平，未按ID分组处理各自的起止年份，导致逻辑错误

  summary<-example %>% 
    transmute(ID, year_start=year(start), year_end=year(end),
              year=year(date_event),event=1) %>% 
    count(ID,event,year=factor(year,levels=unique(year_start:year_end)))
  

解决方案 #

核心思路：先为每个ID生成其起止日期范围内的所有年份，再与事件统计结果做左连接，将无事件年份的缺失值填充为0。

方法一：使用data.table实现 #

library(data.table)
library(lubridate)

# 转换为data.table并统一日期格式
setDT(example)
example[, c("start", "end", "date_event") := lapply(.SD, ymd), .SDcols = c("start", "end", "date_event")]

# 生成每个ID对应的全年份序列（从start年到end年）
id_full_years <- example[, .(year = seq(year(start)[1], year(end)[1], by = 1)), by = .(ID, start, end)]

# 统计每个ID每年的事件发生数
event_stats <- example[, .(contacts = .N), by = .(ID, year = year(date_event))]

# 左连接并填充无事件年份的0值
final_result_dt <- id_full_years[event_stats, on = .(ID, year), contacts := i.contacts]
final_result_dt[is.na(contacts), contacts := 0]

方法二：使用dplyr实现 #

library(dplyr)
library(lubridate)
library(tidyr)

# 处理日期格式，为每个ID生成全年份序列
id_full_years_dplyr <- example %>%
  mutate(across(c(start, end, date_event), ymd)) %>%
  distinct(ID, start, end) %>% # 去重ID的起止信息，避免重复生成年份
  rowwise() %>%
  mutate(year = list(seq(year(start), year(end), by = 1))) %>%
  unnest(year) # 展开年份列表为行

# 统计每个ID每年的事件数
event_stats_dplyr <- example %>%
  mutate(year = year(date_event)) %>%
  count(ID, year, name = "contacts")

# 左连接并填充0值
final_result_dplyr <- id_full_years_dplyr %>%
  left_join(event_stats_dplyr, by = c("ID", "year")) %>%
  mutate(contacts = replace_na(contacts, 0))

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