在RStudio中利用滚动均值作为历史数据实现多期销售预测

现有实现与问题 #

我在RStudio中用xgBoost回归构建多因素销售预测模型，已经实现了滞后特征、滚动均值和标准差的生成函数，但这些函数仅能基于已有历史数据生成特征，无法处理未来无实际历史数据的场景，只能支持单期预测。现在需要通过迭代循环，将每一期的预测值作为"历史数据"补充，生成45天的连续预测结果，最终输出可作为模型变量的单列数据。

当前使用的参数：

start_index_lag=4
num_lags=60
start_index_rollfeat=4
num_rollfeat=60
forecast_horizon = 45 # 预测45天

现有特征生成函数 #

1. 滞后特征生成函数

Create_lags <- function(MyData, start_index_lag, num_lags) {
  lags = seq(from = start_index_lag, to = start_index_lag + num_lags)
  lag_names <- paste("lag", formatC(lags, width = nchar(max(lags)), flag="0"),
                     sep="_")
  lag_functions <- setNames(paste("dplyr::lag(.,", lags, ")"), lag_names)
  MyData = MyData %>%
    arrange(Channel, Product)%>%
    group_by(Channel, Product)%>%
    mutate_at(vars(Sales), funs_(lag_functions))
  return(MyData)
}

2. 滚动均值与标准差生成函数

Create_rolling_window_means <- function(MyData, start_index_rollfeat, num_rollfeat){
  rollmean_1 = seq(from = start_index_rollfeat, to = start_index_rollfeat + num_rollfeat)
  rollmean_names <- paste("rollmean", formatC(rollmean_1,
                                              width = nchar(max(rollmean_1)), flag="0"),
                          sep="")
  rollmean_functions <- setNames(paste("lag(roll_meanr(.,", rollmean_1, "), 1)"), rollmean_names)
  MyData = MyData %>%
    arrange(Channel, Product)%>%
    group_by(Channel, Product)%>%
    mutate_at(vars(Sales), funs_(rollmean_functions))
  return(MyData)
}

Create_rolling_window_sd <- function(MyData, start_index_rollfeat, num_rollfeat){
  rollsd_1 = seq(from = start_index_rollfeat, to = start_index_rollfeat + num_rollfeat)
  rollsd_names <- paste("rollsd", formatC(rollsd_1,
                                          width = nchar(max(rollsd_1)), flag="0"),
                        sep="")
  rollsd_functions <- setNames(paste("lag(roll_sdr(.,", rollsd_1, "), 1)"), rollsd_names)
  MyData = MyData %>%
    arrange(Channel, Product)%>%
    group_by(Channel, Product)%>%
    mutate_at(vars(Sales), funs_(rollsd_functions))
  return(MyData)
}

解决方案：迭代式滚动预测实现 #

修改思路 #

核心逻辑是通过循环迭代，每完成一期预测后，将预测值追加到原始数据中作为下一期特征生成的"历史数据"，重复该过程直到完成45天预测：

1. 预处理历史数据，生成初始特征集
2. 基于训练好的xgBoost模型，循环执行45次预测
3. 每一期预测后更新扩展数据集，用于下一轮特征生成
4. 提取所有预测结果，输出单列数据

修改后的完整代码 #

# 加载依赖包
library(dplyr)
library(xgboost)
library(RcppRoll)

# 微调原有特征生成函数（移除冗余print，添加ungroup保证数据结构一致）
Create_lags <- function(MyData, start_index_lag, num_lags) {
  lags = seq(from = start_index_lag, to = start_index_lag + num_lags)
  lag_names <- paste("lag", formatC(lags, width = nchar(max(lags)), flag="0"),
                     sep="_")
  lag_functions <- setNames(paste("dplyr::lag(.,", lags, ")"), lag_names)
  MyData = MyData %>%
    arrange(Channel, Product)%>%
    group_by(Channel, Product)%>%
    mutate_at(vars(Sales), funs_(lag_functions)) %>%
    ungroup()
  return(MyData)
}

Create_rolling_window_means <- function(MyData, start_index_rollfeat, num_rollfeat){
  rollmean_1 = seq(from = start_index_rollfeat, to = start_index_rollfeat + num_rollfeat)
  rollmean_names <- paste("rollmean", formatC(rollmean_1,
                                              width = nchar(max(rollmean_1)), flag="0"),
                          sep="")
  rollmean_functions <- setNames(paste("lag(roll_meanr(.,", rollmean_1, "), 1)"), rollmean_names)
  MyData = MyData %>%
    arrange(Channel, Product)%>%
    group_by(Channel, Product)%>%
    mutate_at(vars(Sales), funs_(rollmean_functions)) %>%
    ungroup()
  return(MyData)
}

Create_rolling_window_sd <- function(MyData, start_index_rollfeat, num_rollfeat){
  rollsd_1 = seq(from = start_index_rollfeat, to = start_index_rollfeat + num_rollfeat)
  rollsd_names <- paste("rollsd", formatC(rollsd_1,
                                          width = nchar(max(rollsd_1)), flag="0"),
                        sep="")
  rollsd_functions <- setNames(paste("lag(roll_sdr(.,", rollsd_1, "), 1)"), rollsd_names)
  MyData = MyData %>%
    arrange(Channel, Product)%>%
    group_by(Channel, Product)%>%
    mutate_at(vars(Sales), funs_(rollsd_functions)) %>%
    ungroup()
  return(MyData)
}

# 整合特征生成流程
generate_features <- function(data, start_lag, num_lags, start_roll, num_roll) {
  data <- Create_lags(data, start_lag, num_lags)
  data <- Create_rolling_window_means(data, start_roll, num_roll)
  data <- Create_rolling_window_sd(data, start_roll, num_roll)
  # 移除特征生成时产生的NA行
  data <- data %>% filter(complete.cases(.))
  return(data)
}

# 45天滚动预测主函数
forecast_45days <- function(historical_data, trained_xgb_model, params) {
  # 提取参数
  start_lag <- params$start_index_lag
  num_lags <- params$num_lags
  start_roll <- params$start_index_rollfeat
  num_roll <- params$num_rollfeat
  horizon <- params$forecast_horizon
  
  # 初始化扩展数据集（按时间排序，需保证数据含Date列）
  extended_data <- historical_data %>%
    arrange(Channel, Product, Date)
  
  # 存储预测结果
  predictions <- c()
  
  # 循环执行预测
  for (i in 1:horizon) {
    # 生成当前所有特征
    feat_data <- generate_features(extended_data, start_lag, num_lags, start_roll, num_roll)
    
    # 提取最新一行的特征（用于预测下一期）
    latest_features <- feat_data %>%
      group_by(Channel, Product) %>%
      slice_tail(n=1) %>%
      ungroup() %>%
      select(-Sales, -Date) # 移除目标变量和日期列
    
    # 转换为xgBoost输入格式
    xgb_matrix <- xgb.DMatrix(data = as.matrix(latest_features))
    
    # 预测当期销售额
    pred_sales <- predict(trained_xgb_model, xgb_matrix)
    
    # 生成下一期日期（根据实际日期格式调整，示例为日度连续数据）
    latest_date <- extended_data %>%
      group_by(Channel, Product) %>%
      slice_tail(n=1) %>%
      pull(Date)
    next_date <- latest_date + lubridate::days(1) # 需提前加载lubridate包
    
    # 构造新行并追加到扩展数据集
    new_rows <- data.frame(
      Channel = unique(extended_data$Channel),
      Product = unique(extended_data$Product),
      Date = next_date,
      Sales = pred_sales
    )
    extended_data <- bind_rows(extended_data, new_rows)
    
    # 记录预测结果
    predictions <- c(predictions, pred_sales)
  }
  
  # 返回单列预测结果
  return(data.frame(Forecast_Sales = predictions))
}

# 参数配置
params <- list(
  start_index_lag = 4,
  num_lags = 60,
  start_index_rollfeat = 4,
  num_rollfeat = 60,
  forecast_horizon = 45
)

# 使用示例（替换为你的历史数据和训练好的模型）
# forecast_result <- forecast_45days(your_historical_data, your_trained_xgb_model, params)

关键说明 #

1. 特征函数优化：移除原函数中的print语句，避免循环中冗余输出；添加ungroup()确保数据结构统一。
2. 迭代逻辑：每一期预测后，将预测值和对应日期追加到扩展数据集，作为下一轮特征生成的历史数据。
3. 日期处理：假设数据包含Date列且为日度连续数据，实际使用时需根据你的日期格式调整next_date的生成逻辑（比如用lubridate包处理非连续日期）。
4. 模型适配：需确保训练好的xgBoost模型与生成的特征列完全匹配，预测时需排除目标变量Sales和非特征列（如Date）。

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