如何用dplyr实现批量预测模型的数据集拆分与精度计算？

我来帮你搞定这两个问题，先说说你之前代码报错的核心原因，再一步步给出可运行的解决方案：

首先，你之前的代码报错Error in ets(...) : y should be a univariate time series，主要是两个问题：

• 你用了**整个数据框的行数nrow(df5)**来拆分训练集，但分组后每个产品的观测数远小于整个数据框的行数，导致训练集索引变成负数/空值，ets()拿到空数据自然报错；
• 没有把每组的value转成规范的时间序列对象，虽然ets()支持向量，但转成ts能避免不少潜在问题。

先给你构造一个更合理的示例数据（每组6个时间点，方便拆分训练/测试集，毕竟你原来的2个观测没法拆分）：

library(dplyr)
library(forecast)
library(purrr) # 用来处理批量的map函数
library(tidyr) # 用来展开嵌套结果

# 构造示例数据：每个产品6个月度观测
set.seed(123) # 固定随机种子，结果可复现
df5 <- expand.grid(
  Primary.Base.Product = c('A','B','Z'),
  variable = paste0(c('Aug','Sep','Oct','Nov','Dec','Jan'), '16')
) %>% 
  mutate(value = sample(1:20, nrow(.), replace = TRUE))

1. 拆分训练集/测试集，计算预测精度 #

我们要在每个产品分组内拆分数据，而不是用整个数据框的行数。这里假设用每组前4个观测做训练，后2个做测试：

第一步：分组拟合训练集模型 #

# 分组处理：拆分训练/测试集，拟合ETS模型
model_fits <- df5 %>%
  group_by(Primary.Base.Product) %>%
  do(
    # 每组内拆分训练集（前n-2个）和测试集（后2个），转成时间序列
    train_ts = ts(.$value[1:(nrow(.)-2)]),
    test_ts = ts(.$value[(nrow(.)-1):nrow(.)]),
    fit = ets(ts(.$value[1:(nrow(.)-2)]))
  )

第二步：批量计算测试集的预测精度 #

# 批量生成预测并计算精度
model_acc <- model_fits %>%
  mutate(
    # 生成对应测试集长度的预测结果
    test_forecast = purrr::map(fit, forecast, h = length(test_ts[[1]])),
    # 用accuracy函数计算预测值和测试集的精度
    acc = purrr::map2_dfr(test_forecast, test_ts, ~accuracy(.x, .y))
  ) %>%
  ungroup() %>%
  select(Primary.Base.Product, acc) %>%
  tidyr::unnest(acc) # 展开精度结果列

# 查看结果
print(model_acc)

运行后model_acc会包含每个产品的MAE、RMSE、MAPE等常用精度指标。

2. 计算拟合值与实际值的精度 #

拟合值是模型对训练集的预测结果，我们可以从拟合好的模型中提取fitted()值，再和训练集实际值对比计算精度：

# 计算拟合值与训练集实际值的精度
fit_acc <- df5 %>%
  group_by(Primary.Base.Product) %>%
  do(
    train_ts = ts(.$value[1:(nrow(.)-2)]),
    fit = ets(ts(.$value[1:(nrow(.)-2)])),
    # 提取模型的拟合值
    fitted_vals = fitted(ets(ts(.$value[1:(nrow(.)-2)])))
  ) %>%
  mutate(
    # 对比训练集实际值和拟合值，计算精度
    fit_acc = purrr::map2_dfr(train_ts, fitted_vals, ~accuracy(.y, .x))
  ) %>%
  ungroup() %>%
  select(Primary.Base.Product, fit_acc) %>%
  tidyr::unnest(fit_acc)

# 查看结果
print(fit_acc)

内容的提问来源于stack exchange，提问作者S Ne.