如何基于非连续日期计算带观测数权重的滚动平均回复时长

我有一张记录技术支持工单日期、回复时长及工单ID的表格，需要计算过去n天的加权滚动平均回复时长（按每日工单数量加权，避免单日异常值影响结果）。

原始数据 #

尝试过的方法及问题 #

我曾先按天计算平均回复时长，再基于此计算滚动平均，但这种方法未考虑每日工单数量的权重，单日异常值会导致结果偏差。目前用runner包实现的代码如下：

daily_reply_time <- df_replies %>%
  filter(!is.na(reply_time) & !is.na(dates)) %>%
  group_by(dates) %>%
  reframe(avg_reply_time = mean(reply_time, na.rm = TRUE)) %>%
  mutate(
    x = "x",
    dates = lubridate::ymd(dates)
  ) %>%
  filter(!is.na(dates)) %>%
  complete(
    nesting(x),
    dates = seq(min(dates), max(dates), by = "day")
  ) %>%
  group_by(x) %>%
  arrange(dates) %>%
  mutate(
    dates= lubridate::ymd(dates),
    avg_reply_time = ifelse(is.na(avg_reply_time), 0, as.numeric(avg_reply_time )),
    running_reply_time_30_days = runner::mean_run(x = avg_reply_time, k = 30, idx = dates)
  ) %>%
  select(-x)

这里创建了虚拟变量x来让nesting正常工作，但应该有更优方式。用这个方法得到的每日平均为186、321、0、412、0、131，计算2024-01-08的滚动平均是175，和直接用所有工单计算的预期值227.83不符。

另外，跳过按天分组直接用complete会报错'from' must be a finite number；不用complete直接用runner的话，会基于数据集前n行而非日期范围计算平均，相关代码：

daily_reply_time <- df_replies %>%
  filter(created_at > '2023-12-31') %>%
  mutate(
    created_at = substr(created_at, 1, 10),
    first_reply_time_in_minutes = first_reply_time_in_minutes / 60
  ) %>%
  filter(!is.na(created_at) & !is.na(first_reply_time_in_minutes)) %>%
  mutate(x = "x") %>%
  complete( 
    nesting(x),
    created_at = seq(min(created_at), max(created_at), by = "day")
  )

需求 #

能否通过runner包或其他工具，在计算滚动平均时纳入每日工单数量的权重？预期输出为每日一行，包含过去n天的加权滚动平均回复时长（示例如下）：

要实现加权滚动平均（按工单数量加权），核心是先计算每日的总回复时长和工单数量，再基于这两个指标计算滚动窗口内的加权平均，而非先算每日平均再做滚动平均。以下提供两种可行方法：

方法1：使用runner包实现加权滚动平均 #

步骤说明 #

1. 按日期聚合，计算每日总回复时长(total_reply)和工单数量(ticket_count)
2. 补全所有缺失日期（无需虚拟变量x，直接用complete生成连续日期）
3. 用runner::runner自定义函数，计算滚动窗口内的加权平均：sum(total_reply) / sum(ticket_count)

代码实现 #

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

# 原始数据示例
df_replies <- tibble(
  Dates = ymd(c("2024-01-02", "2024-01-02", "2024-01-03", "2024-01-05", "2024-01-07", "2024-01-07")),
  Reply_Time = c(341, 31, 321, 412, 93, 169),
  Ticket_ID = 1:6
)

# 计算过去3天的加权滚动平均（可修改k值调整窗口大小）
weighted_moving_avg <- df_replies %>%
  # 1. 按日期聚合
  group_by(Dates) %>%
  reframe(
    total_reply = sum(Reply_Time, na.rm = TRUE),
    ticket_count = n()
  ) %>%
  ungroup() %>%
  # 2. 补全连续日期，缺失日期的总回复和工单数量设为0
  complete(Dates = seq(min(Dates), max(Dates), by = "day"),
           fill = list(total_reply = 0, ticket_count = 0)) %>%
  # 3. 计算滚动加权平均
  mutate(
    moving_avg_reply = runner(
      x = tibble(total_reply, ticket_count),
      k = 3,
      idx = Dates,
      f = function(window) {
        # 过滤无工单的日期
        valid <- window[window$ticket_count > 0, ]
        if(nrow(valid) == 0) return(NA)
        sum(valid$total_reply) / sum(valid$ticket_count)
      }
    )
  ) %>%
  select(Dates, moving_avg_reply)

# 查看结果
print(weighted_moving_avg)

方法2：使用slider包实现（更简洁） #

slider包的slide_dbl函数可更直观地处理滚动窗口计算：

代码实现 #

library(slider)

weighted_moving_avg_slider <- df_replies %>%
  group_by(Dates) %>%
  reframe(total_reply = sum(Reply_Time), ticket_count = n()) %>%
  ungroup() %>%
  complete(Dates = seq(min(Dates), max(Dates), by = "day"),
           fill = list(total_reply = 0, ticket_count = 0)) %>%
  mutate(
    moving_avg_reply = slide_dbl(
      .x = tibble(total_reply, ticket_count),
      .f = function(window) {
        valid <- window[window$ticket_count > 0, ]
        if(nrow(valid) == 0) return(NA)
        sum(valid$total_reply) / sum(valid$ticket_count)
      },
      .before = 2, # 过去2天+当天，共3天，对应窗口大小3
      .complete = FALSE # 允许窗口不足指定大小的情况（如前2天）
    )
  ) %>%
  select(Dates, moving_avg_reply)

结果偏差原因说明 #

你之前的方法先计算每日平均再做滚动平均，相当于给每个日期赋予了相同权重，忽略了当日工单数量的差异。而加权平均按工单数量分配权重，更能反映真实的平均回复时长——比如某天有100个工单，它的权重应远高于只有1个工单的日期。

例如你提到的2024-01-08预期值227.83，正是所有工单回复时长总和(341+31+321+412+93+169=1367)除以工单总数(6)的结果，这和加权滚动平均（窗口覆盖所有日期）的计算逻辑一致。

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