Slider工具slide_period移动平均计算错误问题求助

我用slider工具处理日粒度时间序列，要计算每个观测值对应过去7天的日均数值。当前代码存在问题：默认缺失的观测值为0，但代码忽略了这些缺失日期，窗口内仅部分日期有数据时，均值会除以实际观测数而非窗口总天数（比如2023-02-03行，窗口是2023-01-31到2023-02-03共4天，却除以2）。

试过回填缺失值解决，但数据量大且稀疏，运行时间从8秒涨到100秒。想问除了把mean改成sum()/7，有没有更优的实现方案？

注：实际场景要按分组计算，所以用了pick(everything())。

附测试代码及输出：

library(tidyverse)
library(slider)

data <- data.frame(
  date = Sys.Date() - c(0, 1, 2, 3, 4, 6, 7, 8, 9, 10, 13),
  val = c(0, 0, 2, 1, 0, 10, 0, 1, 1, 6, 1)
)

print(as_tibble(data))

summary <- function(data) {
  summarise(data,
    moving_total = sum(val),
    moving_avg = mean(val, na.rm = FALSE),
    num_observations = n()
  )
}

res <- data %>%
  arrange(date) %>%
  mutate(
    weekly = slide_period_dfr(
      .x = pick(everything()),
      .i = date,
      .period = "day",
      .f = summary,
      .before = 6,
      .complete = FALSE
    )
  )

print(as_tibble(res))

输出：

# A tibble: 11 x 2
   date         val
   <date>     <dbl>
 1 2023-02-13     0
 2 2023-02-12     0
 3 2023-02-11     2
 4 2023-02-10     1
 5 2023-02-09     0
 6 2023-02-07    10
 7 2023-02-06     0
 8 2023-02-05     1
 9 2023-02-04     1
10 2023-02-03     6
11 2023-01-31     1
# A tibble: 11 x 3
   date         val weekly$moving_total $moving_avg $num_observations
   <date>     <dbl>               <dbl>       <dbl>             <int>
 1 2023-01-31     1                   1        1                    1
 2 2023-02-03     6                   7        3.5                  2
 3 2023-02-04     1                   8        2.67                 3
 4 2023-02-05     1                   9        2.25                 4
 5 2023-02-06     0                   9        1.8                  5
 6 2023-02-07    10                  18        3.6                  5
 7 2023-02-09     0                  18        3                    6
 8 2023-02-10     1                  13        2.17                 6
 9 2023-02-11     2                  14        2.33                 6
10 2023-02-12     0                  13        2.17                 6
11 2023-02-13     0                  13        2.17                 6

方案1：窗口内总和除以实际天数（简洁高效） #

既然缺失日期的val默认是0，直接计算窗口内总和，再除以窗口实际天数（而非观测数）即可。修改summary函数：

summary <- function(data) {
  # 计算窗口包含的实际天数
  window_days <- as.integer(max(data$date) - min(data$date)) + 1
  total <- sum(data$val)
  summarise(data,
    moving_total = total,
    moving_avg = total / window_days,
    num_observations = n(),
    window_days = window_days
  )
}

该方法无需修改原始数据，性能和原代码接近，完全避免回填带来的性能损耗。

方案2：用slide_index_dfr精准控制窗口 #

slide_index_dfr可直接基于日期范围定义窗口，避免slide_period_dfr自动过滤缺失日期的问题：

res <- data %>%
  arrange(date) %>%
  mutate(
    weekly = slide_index_dfr(
      .x = pick(everything()),
      .i = date,
      .f = function(x) {
        # 计算窗口起始日期（不早于当前日期-6天）
        window_start <- max(min(x$date), x$date[1] - days(6))
        window_days <- as.integer(x$date[1] - window_start) + 1
        total <- sum(x$val)
        tibble(
          moving_total = total,
          moving_avg = total / window_days,
          num_observations = nrow(x),
          window_days = window_days
        )
      },
      .before = days(6)
    )
  )

方案3：data.table高效处理超大数据集 #

如果数据量极大（百万级以上），data.table的非等值连接在稀疏数据上的效率远高于dplyr+slider，尤其适合分组场景：

library(data.table)
setDT(data)[order(date)]
# 标记每个日期的窗口起始
data[, window_start := date - days(6)]
# 非等值连接匹配窗口内数据，分组聚合
res <- data[data, on = .(date >= window_start, date <= date), 
            .(val_i = val, date_i = x.date), allow.cartesian = TRUE] %>%
  .[, .(
    moving_total = sum(val_i),
    num_observations = .N,
    window_days = as.integer(max(date) - min(date)) + 1
  ), by = date_i] %>%
  .[, moving_avg := moving_total / window_days] %>%
  setnames("date_i", "date") %>%
  merge(data, by = "date", all.y = TRUE) %>%
  setcolorder(c("date", "val", "moving_total", "moving_avg", "num_observations", "window_days"))

方案4：仅保留完整7天窗口（按需使用） #

如果只需要完整7天窗口的均值，可设置.complete = TRUE，此时仅窗口包含连续7天时才返回结果，否则为NA：

res <- data %>%
  arrange(date) %>%
  mutate(
    weekly = slide_period_dfr(
      .x = pick(everything()),
      .i = date,
      .period = "day",
      .f = function(x) {
        tibble(
          moving_total = sum(x$val),
          moving_avg = sum(x$val)/7,
          num_observations = n()
        )
      },
      .before = 6,
      .complete = TRUE
    )
  )

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