R语言高效统计指定时空区间事件计数分类的性能优化

业务背景 #

我正在分析规模超150万条观测的大型数据集，旨在挖掘事件发生时间与位置的相关性，但在构建分析数据集的过程中遇到了严重的性能问题。

事件核心规则如下：

• 事件归属维度：所有事件发生在A、B、C三类设施中，每个设施下设1-6号点位
• 时间范围：事件发生时间跨度为1990年1月1日至1990年6月1日
• 事件结果：取值仅为0或1
• 空间影响范围：点位地理位置相邻，某点位发生的事件会对自身、左右相邻点位产生影响
• 时间影响窗口：事件影响具备持续性，单事件影响时长为7天（例如3月10日发生的事件，影响会持续至3月17日）

测试数据构造代码 #

set.seed(12345)

df <- data.frame(
  facility = sample(
    c("A","B","C"),
    100,
    replace=TRUE),
  
  site = sample(
    1:6,
    100,
    replace=TRUE),
  
  date = as.Date(
    sample(
      c(lubridate::ymd("1990-1-1"):lubridate::ymd("1990-6-1")),
      100,
      replace=TRUE),
    origin = "1970-01-01"
    ),
    
  outcome = sample(
    c(0,1),100,
    replace=TRUE),
  
  stringsAsFactors = FALSE
)

当前实现方案 #

目前通过逐行迭代的for循环实现窗口统计逻辑，代码如下：

# 初始化输出结果集
outputdf <- data.frame(
  facility = character(),
  site = numeric(),
  date = as.Date(character()),
  outcome = numeric(),
  recent_success = integer(),
  recent_failures = integer(),
  stringsAsFactors = FALSE
)

# 逐行遍历每条事件
for(i in 1:nrow(df)){
  # 控制台打印进度
  print(paste("Event ",i," of ",nrow(df),sep=""))
  
  # 提取当前待统计的目标事件
  EventofInterest <- df[i,]

  # 获取目标事件所属设施、点位信息
  facility_of_interest <- EventofInterest$facility %>%
    unlist()
  
  site_of_interest <- EventofInterest$site %>%
    unlist()
  
 # 统计窗口内成功事件（outcome=1）数量
  recent_success <- df %>%
    filter(outcome == 1,
           facility %in% facility_of_interest,
           site %in% c((site-1),site,(site+1)),
           date %within% lubridate::interval(date-7,date)) %>% 
    nrow()
  
  # 统计窗口内失败事件（outcome=0）数量
recent_failures <- df %>%
    filter(outcome == 0,
           facility %in% facility_of_interest,
           site %in% c((site-1),site,(site+1)),
           date %within% lubridate::interval(date-7,date)) %>% 
    nrow()
  
  # 合并统计结果到输出集
  outputdf <- EventofInterest %>%
    mutate(recent_success = recent_success,
           recent_failures = recent_failures
    ) %>%
    bind_rows(outputdf)
  
  
}

现存问题 #

小样本测试场景下，上述代码可输出符合预期的结果，示例输出如下：

> head(outputdf)
  facility site       date outcome recent_success recent_failures
1        C    4 1990-01-23       1             15              23
2        B    1 1990-02-18       1             16              19
3        B    1 1990-02-01       1             16              19
4        A    5 1990-01-06       1             10              17
5        B    5 1990-01-10       0             16              19
6        C    3 1990-02-26       1             15              23

当输入数据集规模增大、逻辑复杂度提升时，代码运行速度极慢（当前输入数据体量约150MB）。经排查确认逐行for循环是核心性能瓶颈，已尝试的优化手段包括：

• 尽可能减少for循环内的计算逻辑
• 循环启动前预生成日期间隔字段
• 拆分成功/失败事件为独立数据集减少判断分支

以上优化均未带来明显提速，性能瓶颈并非数值比较操作。目前考虑过dplyr::summarize()等向量化实现方案、多处理器并行方案，但担心并行方案内存占用过高，需要可行的提速优化方案。

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