如何为 R 中的 HoltWinters 循环增加预测准确性？
How to add forecast accuracy to this loop for HoltWinters in R?
一个完全可重现的例子。
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])
基于独特的子产品创建数据框
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]
我们可以使用
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
一个完全可重现的例子。
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])
基于独特的子产品创建数据框
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]
我们可以使用
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