【发布时间】：2021-09-17 10:07:07
【问题描述】：
一个完全可重现的例子。
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]
【问题讨论】：
-
是你要找的问题
-
是的。谢谢
-
在 'out' 数据中哪个是 'test' 和 train
-
(list_ts[1: (length(list_ts)/2)] 只是训练。删除 /2 就是全部。训练数据是 list_ts[[1]] 到 4 （因为我们有四个唯一的子产品，可以是 6,10,12 等）。测试数据将始终是 list_ts[[i+(#unique_subproducts)]] （这是带有相应测试数据的训练数据。注意预测如何::accuracy 函数使用训练数据进行模型创建并将其与测试数据进行比较 list_ts[[8]]
-
你能在循环中试试这段代码吗
标签： r loops data-manipulation forecasting