r-如何在给定ARIMA值列表的情况下自动更改参数

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

如何自动创建它，以便在全局环境中自动创建m1到m6？注意第一个参数order=是相同的，而第二个参数是不同的。在我们用完所有二阶的值之后，我们转到第一个参数顺序的下一个元素。

m1<- lapply(list_ts[1: 
(length(list_ts)/2)], function(x)
forecast::forecast(arima(x,order=c(1,1,1),seasonal=list(order=c(0,1,0),
period=12)) ,h=24))
m1<- lapply(m1, "[",  c("mean"))
m2<- lapply(list_ts[1: 
(length(list_ts)/2)], function(x)
forecast::forecast(arima(x,order=c(1,1,1),seasonal=list(order=c(1,0,0),
period=12)) ,h=24))
m2<- lapply(m2"[",  c("mean"))
m3<- lapply(list_ts[1: 
(length(list_ts)/2)], function(x)
forecast::forecast(arima(x,order=c(1,1,1),seasonal=list(order=c(0,0,0),
period=12)) ,h=24))
m3<- lapply(m3"[",  c("mean"))

m4<- lapply(list_ts[1: 
(length(list_ts)/2)], function(x)
forecast::forecast(arima(x,order=c(0,0,0),seasonal=list(order=c(0,1,0),
period=12)) ,h=24))
m4<- lapply(m4, "[",  c("mean"))
m5<- lapply(list_ts[1: 
(length(list_ts)/2)], function(x)
forecast::forecast(arima(x,order=c(0,0,0),seasonal=list(order=c(1,0,0),
period=12)) ,h=24))
m5<- lapply(m5"[",  c("mean"))
m6<- lapply(list_ts[1: 
(length(list_ts)/2)], function(x)
forecast::forecast(arima(x,order=c(0,0,0),seasonal=list(order=c(0,0,0),
period=12)) ,h=24))
m6<- lapply(m6"[",  c("mean"))

我想用这个做点什么

n1 <- ((0,0,0),(1,1,1))
where each element of n1 is (0,0,0)... etc
n2 <- ((0,1,0),(1,0,1),(0,0,0))
out<- lapply(seq_along(n1), function(i) {
m<- lapply(list_ts[1: 
(length(list_ts)/2)], function(x) 
forecast::forecast(arima(x,order=c(0,0,0),seasonal=list(order=c(1,0,0),
period=12)),h=24)
m1<- 
lapply(m1, "[", "mean")
assign(paste0("m1", i), 
m1, envir = .GlobalEnv)
m1})

Answer 1

我们用vectors作为元素('n1'，'n2'(创建两个list。执行expand.grid以创建一个两列数据帧，其中包含这些list的

n1 <- list(c(0,0,0), c(1,1,1))
n2 <- list(c(1,0,0),c(0, 1, 0),c(0,0,0))
dat_n <- expand.grid(n1 = n1, n2 = n2)

遍历"dat_n"的行序列，提取与这些列[[i]]对应的list，并在order中指定

out <- lapply(seq_len(nrow(dat_n)), function(i) {
m <- lapply(list_ts[1:(length(list_ts)/2)], function(x)  {
tryCatch({forecast::forecast(arima(x, order = dat_n$n1[[i]],
seasonal=list(order = dat_n$n2[[i]],
period=12)),h=24)
}, error = function(err) return(data.frame(mean = NA_real_))

)})
m <- lapply(m, "[", "mean")
assign(paste0("m", i), m, envir = .GlobalEnv)
m
}) 

该代码也被封装在tryCatch中——如果出现一些预测错误，它将返回NA

-检查全局env 中的对象

ls(pattern = '^m\d$')
[1] "m1" "m2" "m3" "m4" "m5" "m6"