如何在给定 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 = 是相同的，而第二个参数是不同的。在我们用完所有 2 阶的值之后，我们继续按照第一个参数的顺序移动到下一个元素。

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

我们创建了两个list，其中vectors 作为元素（'n1'，'n2'）。执行expand.grid 来创建一个包含lists 组合的两列data.frame

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

-检查全局环境中的对象

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