如何为 R 中的 HoltWinters 循环添加预测准确性？

Question

一个完全可重现的例子。

library(forecast)
date = seq(as.Date("2019/01/01"), by = "month", length.out = 48)

productB = rep("B",48)
productB = rep("B",48)
productA = rep("A",48)
productA = rep("A",48)

subproducts1=rep("1",48)
subproducts2=rep("2",48)
subproductsx=rep("x",48)
subproductsy=rep("y",48)

b1 <- c(rnorm(30,5), rep(0,18))
b2 <- c(rnorm(30,5), rep(0,18))
b3 <-c(rnorm(30,5), rep(0,18))
b4 <- c(rnorm(30,5), rep(0,18))

在下面创建了数据框

dfone <- data.frame("date"= rep(date,4),
            "product"= c(rep(productB,2),rep(productA,2)),
            "subproduct"= 
c(subproducts1,subproducts2,subproductsx,subproductsy),
            "actuals"= c(b1,b2,b3,b4))

export_df <- split(dfone[1:4], dfone[3])

基于 UNIQUE SUBPRODUCTS 创建数据框

dummy_list <- split(dfone[1:4], dfone[3]) %>% lapply( function(x) 
x[(names(x) %in% c("date", "actuals"))])
dummy_list <-  lapply(dummy_list, function(x) { x["date"] <- NULL; x })


list_dfs <- list()
for (i in 1:length(unique(dfone$subproduct))) {
  #assign(paste0("df", i), as.data.frame(dummy_list[[i]]))
  list_dfs <-append(list_dfs,dummy_list[[i]])
}

combined_dfs <- Reduce(function(x, y) merge(x, y, all = TRUE,  
by='date'), list(list_dfs))

创建时间序列

list_ts <- lapply(list_dfs, function(t) 
ts(t,start=c(2019,1),end=c(2021,6), frequency = 12)) %>%
  lapply( function(t) ts_split(t,sample.out=(0.2*length(t))))    # 
creates my train test split
list_ts <- do.call("rbind", list_ts)  #Creates a list of time series

创建许多时间序列列表。 在这种情况下，在全局环境中创建了 729 个对象。

n1 <- seq(0.1, 0.99, by = 0.1)
n2 <- seq(0.1, 0.99, by = 0.1)
n3 <- seq(0.1, 0.99, by = 0.1)

dat_n <- expand.grid(n1 = n1, n2= n2, n3 = n3) 
out<- lapply(seq_len(nrow(dat_n)), function(i) {
   c_triple_holtwinters_multiplicative <- lapply(list_ts[1: 
(length(list_ts)/2)], function(x) 
       forecast::forecast(HoltWinters(x,seasonal = "additive",alpha = 
dat_n$n1[i],beta=dat_n$n2[i],gamma=dat_n$n3[i])))
    c_triple_holtwinters_multiplicative <- 
 lapply(c_triple_holtwinters_multiplicative, "[", "mean")
  assign(paste0("c_triple_holtwinters_multiplicative", i), 
c_triple_holtwinters_multiplicative, envir = .GlobalEnv)
 c_triple_holtwinters_multiplicative})

我想添加下面的函数，在那里我可以准确地测试每个列表对象的训练模型数据，以测试数据并基于 RMSE（list_ts[[4]] 是训练，测试是 list_ts[[8]] 因为有是 4 个独特的子产品，即 4+4=8。）

 forecast::accuracy(forecast::forecast(HoltWinters(list_ts[[4]],
 seasonal="multiplicative",alpha=.1,beta=.1,gamma=.2),h=24),list_ts[[8]])

        ME     RMSE      MAE         MPE      MAPE      MASE        ACF1 Theil's U
Training set    86.77923 2325.705 1476.658   -5.382147  32.47896 0.5611823 -0.05022049        
 NA
Test set     -3165.29871 6126.887 5389.800 -102.314548 129.32404 2.0483154  0.33876651  
 2.446896

目标是，而不是拥有 729 个对象，例如，我只需要 1 个具有测试数据最佳 RMSE 的模型对象。

Edit1：现在从上面的代码中取出它以使用准确性。

 c_triple_holtwinters_multiplicative <- 
     lapply(c_triple_holtwinters_multiplicative, "[", "mean")

Edit2：修复了代码现在可以工作了，c_triple... 是 1-4，list_ts 总是 5-8。

forecast::accuracy(c_triple_holtwinters_multiplicative1[[1]],
 list_ts[[5]])[4] # pulls out the RMSE

当我们找到最低的 RMSE 时，我们要添加回均值函数以在 glb 环境中创建模型

编辑3：

dat_n <- expand.grid(n1 = n1, n2= n2, n3 = n3) 
out<- lapply(seq_len(nrow(dat_n)), function(i) {
  c_triple_holtwinters_additive <- lapply(list_ts[1: 
(length(list_ts)/2)], function(x) 
      forecast::forecast(HoltWinters(x,seasonal = "additive",alpha = 
dat_n$n1[i],beta=dat_n$n2[i],gamma=dat_n$n3[i])))
 #    c_triple_holtwinters_additive <- 
 # lapply(c_triple_holtwinters_additive, "[", "mean")
 assign(paste0("c_triple_holtwinters_additive", i), 
c_triple_holtwinters_additive, envir = .GlobalEnv)
 c_triple_holtwinters_additive})

forecast::accuracy(c_triple_holtwinters_additive1[[1]],list_ts[[5]])[4]

Answer 1

我们可以用

out1 <- lapply(seq_len(nrow(dat_n)), function(i) {
    c_triple_holtwinters_additive <- lapply(list_ts[1: 
  (length(list_ts)/2)], function(x) 
        forecast::forecast(HoltWinters(x,seasonal = "additive",alpha = 
  dat_n$n1[i],beta=dat_n$n2[i],gamma=dat_n$n3[i])))

    c_triple_holtwinters_additive1 <- 
         lapply(c_triple_holtwinters_additive, "[", "mean")
    
    acc1 <- unlist(Map(function(x, y)

         forecast::accuracy(x,y )[4],
                 c_triple_holtwinters_additive,  list_ts[5:8]
              ))
    ind1 <- which.min(acc1)
    nm1 <- paste0("c_triple_holtwinters_additive", i)
    
    
     assign(nm1[ind1], 
        c_triple_holtwinters_additive1[[ind1]], envir = .GlobalEnv)

    c_triple_holtwinters_additive1[[ind1]]
   })

-检查

head(out1, 5)
[[1]]
[[1]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 3.992136 4.551152 4.819030 2.722871 3.429581 5.088622 3.169820 5.611467 5.198844 3.475341 3.554109 5.348270
2022 3.335633 3.894648 4.162526 2.066368 2.773077 4.432118 2.513316 4.954963 4.542341 2.818837 2.897606 4.691766


[[2]]
[[2]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 3.973570 4.537064 4.810701 2.720144 3.431003 5.093744 3.176812 5.638199 5.244988 3.506140 3.572943 5.374759
2022 3.363802 3.927296 4.200934 2.110376 2.821235 4.483976 2.567044 5.028431 4.635220 2.896372 2.963175 4.764991


[[3]]
[[3]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 4.045785 4.619027 4.903568 2.823377 3.542898 5.213984 3.303773 5.790314 5.418427 3.663552 3.723406 5.541533
2022 3.546085 4.119327 4.403867 2.323676 3.043197 4.714283 2.804073 5.290613 4.918727 3.163851 3.223705 5.041832


[[4]]
[[4]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 4.126131 4.707987 5.002172 2.930755 3.657247 5.335301 3.430712 5.941848 5.587022 3.810281 3.864567 5.703121
2022 3.722981 4.304837 4.599022 2.527605 3.254097 4.932151 3.027563 5.538699 5.183873 3.407132 3.461417 5.299972


[[5]]
[[5]]$mean
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep      Oct      Nov      Dec
2021 4.171013 4.757059 5.056343 2.988862 3.717521 5.398159 3.495038 6.027034 5.681583 3.874808 3.923682 5.783772
2022 3.811419 4.397465 4.696749 2.629268 3.357928 5.038565 3.135444 5.667440 5.321989 3.515214 3.564088 5.424178