如何用dplyr创建高效的条件滚动平均值（棒球投球场景）

问题说明 #

处理600万行已按投手分组并时序排序的棒球逐次投球数据，需基于pitch_type列的条件计算多个滚动平均值，要求非目标投球类型行沿用前值而非NA，偏好使用dplyr，当前可用内存32GB。

示例数据 #

mydata <- data.frame(pitch_type = c("FB", "SI", "CU", "FB", "CH", "FB", "FS", "SL", "FB", "CH"), 
                      velocity = c(99, 97, 83, 97, 85, 101, 82, 84, 100, 83))

期望输出 #

mydata_updated
   pitch_type velocity l2_velo_fb
1          FB       99         NA
2          SI       97         NA
3          CU       83         NA
4          FB       97      98.00
5          CH       85      98.00
6          FB      101      99.00
7          FS       82      99.00
8          SL       84      99.00
9          FB      100      100.5
10         CH       83      100.5

现有问题 #

之前尝试的代码会生成大量NA且效率极低（几列耗时30分钟），代码如下：

mutate(last1000FBvelo = ifelse(pitch_type %in% c("FB"),
rollapply(release_speed, 1000, mean, fill = NA, align = 'right', na.rm = TRUE), NA),

解决方案 #

1. 基础滚动平均（最近N次FB的平均） #

核心思路：仅在FB投球行计算滚动平均，再用前向填充（na.locf）覆盖非FB行的NA，大幅减少计算量。结合dplyr和zoo包实现：

library(dplyr)
library(zoo)

# 按投手分组（实际数据需替换为真实投手ID列）
mydata_updated <- mydata %>%
  group_by(pitcher_id) %>%
  mutate(
    # 仅FB行计算最近2次FB的速度平均，不足2次时返回NA
    l2_velo_fb = ifelse(pitch_type == "FB",
                        rollapply(velocity[pitch_type == "FB"],
                                  width = list(-(1:2)), # 窗口包含当前及前1次FB
                                  FUN = mean, fill = NA, align = "right"),
                        NA),
    # 前向填充非FB行的NA
    l2_velo_fb = na.locf(l2_velo_fb, na.rm = FALSE)
  ) %>%
  ungroup()

如果追求更高效率，推荐使用slider包（专为dplyr设计的高效滑动窗口工具）：

library(dplyr)
library(slider)

mydata_updated <- mydata %>%
  group_by(pitcher_id) %>%
  mutate(
    # 标记FB的速度，非FB行设为NA
    fb_vel = ifelse(pitch_type == "FB", velocity, NA),
    # 取最近2次FB的平均，不足2次返回NA
    l2_velo_fb = slide_vec(fb_vel,
                           .f = ~mean(na.omit(.x), na.rm = TRUE),
                           .before = Inf,
                           .complete = 2),
    # 前向填充
    l2_velo_fb = na.locf(l2_velo_fb, na.rm = FALSE)
  ) %>%
  select(-fb_vel) %>%
  ungroup()

2. 加权滚动平均（近期观测值权重更高） #

若需要给最近的FB投球更高权重，可自定义加权逻辑。以下示例实现最近2次FB的加权平均（最近1次权重0.6，前1次权重0.4）：

library(dplyr)
library(slider)

# 自定义加权平均函数
weighted_fb_mean <- function(x) {
  clean_x <- na.omit(x)
  if (length(clean_x) < 2) return(NA)
  # 取最近2次FB，权重分配为0.6（最近）和0.4（前一次）
  tail_x <- tail(clean_x, 2)
  weighted.mean(tail_x, weights = c(0.4, 0.6))
}

mydata_updated <- mydata %>%
  group_by(pitcher_id) %>%
  mutate(
    fb_vel = ifelse(pitch_type == "FB", velocity, NA),
    weighted_l2_fb = slide_vec(fb_vel,
                              .f = weighted_fb_mean,
                              .before = Inf),
    weighted_l2_fb = na.locf(weighted_l2_fb, na.rm = FALSE)
  ) %>%
  select(-fb_vel) %>%
  ungroup()

若需要指数加权平均（EWMA，权重随时间指数衰减），可结合zoo包实现：

library(dplyr)
library(zoo)

mydata_updated <- mydata %>%
  group_by(pitcher_id) %>%
  mutate(
    ewma_fb_vel = ifelse(pitch_type == "FB",
                         rollapply(velocity[pitch_type == "FB"],
                                   width = list(-Inf:-1), # 所有历史FB
                                   FUN = function(x) {
                                     # alpha=0.5，最近的权重最高
                                     weights = 0.5^(seq_along(x)-1)
                                     weighted.mean(x, weights = weights)
                                   }, fill = NA, align = "right"),
                         NA),
    ewma_fb_vel = na.locf(ewma_fb_vel, na.rm = FALSE)
  ) %>%
  ungroup()

效率说明 #

• 避免对所有行调用滚动函数，仅针对目标投球类型计算，减少冗余计算；
• 使用slider或RcppRoll替代基础rollapply，可大幅提升600万行数据的处理速度；
• 32GB内存足够支撑分组和滚动计算，无需担心内存溢出。

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