如何在给定 ARIMA 值列表的情况下自动更改参数
How to automate changing parameters given a list of values for ARIMA
一个完全可重现的例子。
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
如何自动创建它以便在全局环境中自动创建 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})
我们创建两个 list
以 vector
作为元素 ('n1', 'n2')。执行 expand.grid
创建两列 data.frame 并结合这些 list
s
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
中 - 如果出现一些预测错误,它将 return NA
-检查全局环境中的对象
ls(pattern = '^m\d$')
[1] "m1" "m2" "m3" "m4" "m5" "m6"
一个完全可重现的例子。
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
如何自动创建它以便在全局环境中自动创建 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})
我们创建两个 list
以 vector
作为元素 ('n1', 'n2')。执行 expand.grid
创建两列 data.frame 并结合这些 list
s
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
中 - 如果出现一些预测错误,它将 return NA
-检查全局环境中的对象
ls(pattern = '^m\d$')
[1] "m1" "m2" "m3" "m4" "m5" "m6"