A fully reproducible example.
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))
Created the dataframe below
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))
Creating the time series
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
Creation of many lists of time series. In this case creates 729 objects in the global environment.
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})
I want to add the function below, where I can test each list object's training model data with accuracy for the test data and based off RMSE (list_ts[[4]] is the training and the test is list_ts[[8]] because there is 4 unique subproducts, it is 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
The goal is to instead of having 729 objects, I want only 1 model object with the best RMSE on the test data for example.
Edit1: Take this out from the code above for now to use accuracy.
c_triple_holtwinters_multiplicative <-
lapply(c_triple_holtwinters_multiplicative, "[", "mean")
Edit2: fixed the code This will now work and c_triple... is 1-4 and list_ts is 5-8 always.
forecast::accuracy(c_triple_holtwinters_multiplicative1[[1]],
list_ts[[5]])[4] # pulls out the RMSE
When we find the lowest RMSE we want to add back the mean function to create the model to the glb environment
Edit3:
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]
We can use
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]]
})
-checking
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