以下代码循环遍历vars中的大约120个变量。目前，该文件大约需要80秒才能完成，这很长。我很想知道是否有人在加速我的代码方面看到了低落的果实。我有32个核心，但是为DoParallel更改核心= 32并没有给我带来太多好处。也许将for循环重写为apply？
# rm(list = ls()) #clears the workspace
library(plyr)
library(ggplot2)
library(scales)
library(foreach)
library(doParallel)
library(forecast)
# set up
options(scipen = 999) #removes scientific notation
registerDoParallel(cores = 32)
# read data
proj_path = "P:/R"
Macro <- read.csv("P:/Earnest/Old/R/Input.csv")
# prep data
source("P:/Earnest/Old/R/VarTS.R") #Calls variables
cbind.fill <- function(...){
nm <- list(...)
nm <- lapply(nm, as.matrix)
n <- max(sapply(nm, nrow))
do.call(cbind, lapply(nm, function (x)
rbind(x, matrix(, n-nrow(x), ncol(x)))))
}
len <- nrow(Macro)
# Loads all variable names from Macro and Macro2
vars_macro = names(Macro)[!names(Macro) %in% c("qtrs", "y", "s1", "s2", "s3", "date")] #Returns names in Macro not in "qtrs", "y", "s1", "s2", "s3"
vars_macro2 = names(Macro2)[!names(Macro2) %in% c("y", "s1", "s2", "s3")]
vars_macro3 = names(Macro3)[!names(Macro3) %in% c("y", "s1", "s2", "s3")]
vars_macroall = names(Macroall)[!names(Macroall) %in% c("y", "s1", "s2", "s3")]
vars = c(vars_macro, vars_macro2, vars_macro3)
consensus = Macro[[2]][len]
fit <- list()
output <- list()
forecast <- list()
for(m in vars){
thedata <- get(m)
output[[m]] <- list() # treat output as a list-of-lists
fit[[m]] <- list() # treat fit as a list-of-lists
for(z in rev(1:6)) {
tryCatch( #added tryCatch because for loop was breaking on error around number of dimensions
expr = {
x <- thedata[1:(len-z),1:1]
x <- ts((x), start = c(2016, 3), frequency = 4)
y <- Macro[1:(len-z),2:2]
y <- ts((y), start = c(2016, 3), frequency = 4)
t <- thedata[(len+1-z):(len+1-z),1:1]
t <- ts((t), start = c(2018, 4), frequency = 4)
#fit model
fit[[m]][[z]] <-auto.arima(y,xreg=x,seasonal=TRUE,parallel = TRUE,num.cores = NULL) #D=1 enforces seasonality
output[[m]][[z]] <- forecast(fit[[m]][[z]],xreg=t)$mean
},
error = function(e){
message("* Caught an error on itertion", m)
print(e)
}
)}}
output
output2 <- matrix(unlist(output), ncol = length(vars))
output2 <- output2[nrow(output2):1,]
matrixoutput <- output2[1:5,1:length(vars)]
matrixactual <- matrix(Macro[(len-5):(len-1),2:2])
matrixactual <- c(matrixactual)
MAPE <- colMeans(abs((matrixactual - matrixoutput) / matrixactual))
Forecast <- output2[6:6,1:length(vars)]
Delta <- ((Forecast - consensus) / consensus)
LastMAPE <- abs(((matrixoutput[5:5,] - matrixactual[5:5])/matrixactual[5:5]))
df <- data.frame(vars,Forecast, MAPE, Delta)
dflast <- data.frame(vars,Forecast, MAPE, LastMAPE, Delta )
df_macro1 = df[df$vars %in% vars_macro,]
df_macro1[17:17,] <- NA
df <- df[with(df, order(MAPE)), ] #sorts after original variables
df_macro2 = df[df$vars %in% vars_macro2,]
df_macro2$blankVar = NA
df_macro3 = df[df$vars %in% vars_macro3,]
df_macro3$blankVar = NA
df_macroall = df[df$vars %in% vars_macroall,]
df_macroall$blankVar = NA
df_macro4 = df[df$vars %in% names(Macro4),]
df_macro4$blankVar = NA
df_macro5 = dflast[dflast$vars %in% vars_macroall,]
df_macro5 <- df_macro5[with(df_macro5, order(LastMAPE)), ]
df_macro5$blankVar = NA
df_macro1 <- rbind.fill(df_macro1, df_macro5)
a = cbind.fill(df_macro1, df_macro2, df_macro3, df_macroall, df_macro4, df, consensus)
print(df, row.names = FALSE)
write.csv(a, "P:/Earnest/Old/R/OutputTSList.csv", row.names = F, na="")
不确定是否有帮助，请提供dput（Macro）
dput(Macro)
structure(list(qtrs = structure(1:14, .Label = c("15_Q3", "15_Q4",
"16_Q1", "16_Q2", "16_Q3", "16_Q4", "17_Q1", "17_Q2", "17_Q3",
"17_Q4", "18_Q1", "18_Q2", "18_Q3", "QQ_New"), class = "factor"),
y = c(121.3, 131.1, 142.5, 156.4, 168.7, 176.2, 177, 186.6,
199.6, 208.4, 214, 226.2, 232.5, 233.3), c1372 = c(0.51798059487155,
0.605074600778554, 0.70840580233259, 0.796638389230915, 0.800936365512504,
0.862507422705653, 0.906587776772603, 0.965869599669482,
1.02057681299029, 1.0173665712577, 1.00815541019123, 1.11026857023261,
1.12549360199319, 1.17070543044674), c5244 = c(0.0158288398871533,
0.0186529717846534, 0.0335038479568057, 0.0322124481706554,
0.0473432307176583, 0.0372644166954006, 0.055124227441671,
0.0462947124597511, 0.0595395997947759, 0.079813226336006,
0.0632338684298483, 0.0359582444979424, 0.0399978873936274,
0.0363530147033467), c5640 = c(0.0695411232121069, 0.0711030107194139,
0.0768960904393596, 0.0937721113616879, 0.0912072768529112,
0.0948627915873504, 0.0898598251896699, 0.102519015439631,
0.117307571608132, 0.116512410019832, 0.112621649435311,
0.113373707050245, 0.11920732067264, 0.11385677519257), c6164 = c(0.165253620685311,
0.180939722142955, 0.204839371353829, 0.230388360169478,
0.245455819824873, 0.250222069413121, 0.267517323013963,
0.301455130772129, 0.312527568603722, 0.318684362849784,
0.336297671149745, 0.385321973576628, 0.393392171202544,
0.414026295628249), b1372 = c(0.220276379575007, 0.232259423605283,
0.239015099925248, 0.29722406784095, 0.305759227349267, 0.314812674203001,
0.373507924872403, 0.376216626537958, 0.450679682818151,
0.422160030256414, 0.398670890305128, 0.380896038096525,
0.339513818723946, 0.365265284571949), b5244 = c(0.0256963971001724,
0.0308736893223339, 0.0314727889765328, 0.0342560993718647,
0.0329261690808683, 0.0341169107838618, 0.0500316002161605,
0.057066652393088, 0.0637597978553195, 0.102100656473269,
0.109515398926193, 0.0509080775409312, 0.034576665601428,
0.037353167421955), b5640 = c(0.0610914743954476, 0.0681070468175109,
0.0680584203087885, 0.0737178858316377, 0.0657525044040775,
0.0634389081514569, 0.0655890933419926, 0.0689747904574716,
0.0653176858840394, 0.0683221933318993, 0.0692822163266979,
0.0648739229545749, 0.0613089747918081, 0.0681802570906864
), b6164 = c(0.106769764392002, 0.117293493937739, 0.128632140410947,
0.146139699267301, 0.15999997720466, 0.170137316488036, 0.188733545209946,
0.192072924866328, 0.200314760101575, 0.206572493122192,
0.21531555211795, 0.187877279779437, 0.161952291803993, 0.160944253061549
), v1372 = c(0.00268999015293817, 0.00312395322452212, 0.00339511453015627,
0.00345686458302532, 0.00342490795325169, 0.0036875222492476,
0.00361618758896395, 0.00355297766248592, 0.00386182842589497,
0.00356454140879668, 0.00347191673410727, 0.00363595803623375,
0.00374222181870868, 0.00371078757415556), v5244 = c(0.000480051602474059,
0.00042588395300854, 0.0005605459198973, 0.000529571165782351,
0.00057240403833901, 0.000468179333138233, 0.000653241119295764,
0.000455570432040571, 0.000535395675184177, 0.00138501873189088,
0.00114060122318986, 0.000320532455933637, 0.000333175133801828,
0.000314970929257286), v5640 = c(0.000839152227642805, 0.000878653169087127,
0.00086250329626335, 0.000928749230480325, 0.000952705037621405,
0.0009145284719627, 0.000862662166602764, 0.000861675351344781,
0.000900555099811469, 0.000846321708899047, 0.000869990227889332,
0.000889602926022706, 0.000847332392691765, 0.000745645512078392
), v6164 = c(0.00174116886286925, 0.00190736857470478, 0.00204206516831707,
0.00208434471661794, 0.0022434016778137, 0.00215767033473045,
0.00216675412062837, 0.00211218329813293, 0.00222445645154173,
0.00210022505915819, 0.00196775099859493, 0.00205851514065652,
0.00187858647947073, 0.00198038712502613), bv1372 = c(0.00142360941776777,
0.00151188642851632, 0.00157840305106086, 0.00168297006976765,
0.00157809381382463, 0.00180299614944991, 0.00285754565464732,
0.0026777621396315, 0.00314015380649578, 0.00293231409618566,
0.00290686161843522, 0.00248890293023165, 0.00168251123284542,
0.00179265933772828), bv5244 = c(0.000582722401914161, 0.000711777965499918,
0.000761910243648493, 0.000805854835145839, 0.000736857013245957,
0.000833892120648163, 0.0013602408759186, 0.0015050207801102,
0.0016936381650882, 0.00295309680744017, 0.0031773319850428,
0.00106962198904438, 0.000593441969063344, 0.000574791244792
), bv5640 = c(0.00115351432401665, 0.00132428243672085, 0.00136224787475921,
0.00141606633583978, 0.00116049625522213, 0.000858609082150378,
0.000908098663997447, 0.000935982449156028, 0.000899912473850066,
0.000835053614508394, 0.000872837946479594, 0.000833516238462063,
0.000726891442062557, 0.000774037355521608), bv6164 = c(0.000926271545004555,
0.00105864530300842, 0.00109611375444535, 0.00117219207771791,
0.00122508269987305, 0.00135585463133827, 0.00195926581029822,
0.00187620455518874, 0.00206572868014085, 0.00213169451258196,
0.00205259028597028, 0.00136013066654879, 0.000919533667669498,
0.0010609844820593), s1 = c(1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L,
1L, 0L, 0L, 0L, 1L, 0L), s2 = c(0L, 1L, 0L, 0L, 0L, 1L, 0L,
0L, 0L, 1L, 0L, 0L, 0L, 1L), s3 = c(0L, 0L, 1L, 0L, 0L, 0L,
1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L), date = structure(c(1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "2018-09-30", class = "factor")), class = "data.frame", row.names = c(NA,
-14L))
最后，下面是所有变量的定义方式，即以下是VarTS.R（source（“ P：/Earnest/Old/R/VarTS.R”）#Calls变量
中包含的内容。#Let's define some variables
c1372 <- Macro["c1372"]
c5244 <- Macro["c5244"]
c5640 <- Macro["c5640"]
c6164 <- Macro["c6164"]
b1372 <- Macro["b1372"]
b5244 <- Macro["b5244"]
b5640 <- Macro["b5640"]
b6164 <- Macro["b6164"]
v1372 <- Macro["v1372"]
v5244 <- Macro["v5244"]
v5640 <- Macro["v5640"]
v6164 <- Macro["v6164"]
bv1372 <- Macro["bv1372"]
bv5244 <- Macro["bv5244"]
bv5640 <- Macro["bv5640"]
bv6164 <- Macro["bv6164"]
X1372C5244C <- rowMeans(Macro[c("c1372", "c5244")])
X1372C5640C <- rowMeans(Macro[c("c1372", "c5640")])
X1372C6164C <- rowMeans(Macro[c("c1372", "c6164")])
X1372C1372B <- rowMeans(Macro[c("c1372", "b1372")])
X1372C5244B <- rowMeans(Macro[c("c1372", "b5244")])
X1372C5640B <- rowMeans(Macro[c("c1372", "b5640")])
X1372C6164B <- rowMeans(Macro[c("c1372", "b6164")])
X5244C5640C <- rowMeans(Macro[c("c5244", "c5640")])
X5244C6164C <- rowMeans(Macro[c("c5244", "c6164")])
X5244C1372B <- rowMeans(Macro[c("c5244", "b1372")])
X5244C5244B <- rowMeans(Macro[c("c5244", "b5244")])
X5244C5640B <- rowMeans(Macro[c("c5244", "b5640")])
X5244C6164B <- rowMeans(Macro[c("c5244", "b6164")])
X5640C6164C <- rowMeans(Macro[c("c5640", "c6164")])
X5640C1372B <- rowMeans(Macro[c("c5640", "b1372")])
X5640C5244B <- rowMeans(Macro[c("c5640", "b5244")])
X5640C5640B <- rowMeans(Macro[c("c5640", "b5640")])
X5640C6164B <- rowMeans(Macro[c("c5640", "b6164")])
X6164C1372B <- rowMeans(Macro[c("c6164", "b1372")])
X6164C5244B <- rowMeans(Macro[c("c6164", "b5244")])
X6164C5640B <- rowMeans(Macro[c("c6164", "b5640")])
X6164C6164B <- rowMeans(Macro[c("c6164", "b6164")])
X1372B5244B <- rowMeans(Macro[c("b1372", "b5244")])
X1372B5640B <- rowMeans(Macro[c("b1372", "b5640")])
X1372B6164B <- rowMeans(Macro[c("b1372", "b6164")])
X5244B5640B <- rowMeans(Macro[c("b5244", "b5640")])
X5244B6164B <- rowMeans(Macro[c("b5244", "b6164")])
X5640B6164B <- rowMeans(Macro[c("b5640", "b6164")])
X1372C5640C1372B <- rowMeans(Macro[c("c1372", "c5640", "b1372" )])
X1372C5640C5640B <- rowMeans(Macro[c("c1372", "c5640", "b5640" )])
X1372C5640C6164B <- rowMeans(Macro[c("c1372", "c5640", "b6164" )])
X1372C6164C1372B <- rowMeans(Macro[c("c1372", "c6164", "b1372" )])
X1372C6164C5640B <- rowMeans(Macro[c("c1372", "c6164", "b5640" )])
X1372C6164C6164B <- rowMeans(Macro[c("c1372", "c6164", "b6164" )])
X6164C5640C1372B <- rowMeans(Macro[c("c6164", "c5640", "b1372" )])
X6164C5640C5640B <- rowMeans(Macro[c("c6164", "c5640", "b5640" )])
X6164C5640C6164B <- rowMeans(Macro[c("c6164", "c5640", "b6164" )])
XAll3Card <- rowMeans(Macro[c("c1372","c5640","c6164")])
XAll3Card1372B <- rowMeans(Macro[c("c1372","c5640","c6164","b1372")])
XAll3Card5640B <- rowMeans(Macro[c("c1372","c5640","c6164","b5640")])
XAll3Card6164B <- rowMeans(Macro[c("c1372","c5640","c6164","b6164")])
XAll3Bank <- rowMeans(Macro[c("b1372","b5640","b6164")])
XAll3Bank1372C <- rowMeans(Macro[c("b1372","b5640","b6164","c1372")])
XAll3Bank5640C <- rowMeans(Macro[c("b1372","b5640","b6164","c5640")])
XAll3Bank6164C <- rowMeans(Macro[c("b1372","b5640","b6164","c6164")])
XAll13725640 <- rowMeans(Macro[c("c1372", "b1372", "c5640", "b5640")])
XAll13726164 <- rowMeans(Macro[c("c1372", "b1372", "c6164", "b6164")])
XAll56406164 <- rowMeans(Macro[c("c5640", "b5640", "c6164", "b6164")])
XAll4Card <- rowMeans(Macro[c("c1372", "c5244", "c5640", "c6164")])
XAll4Bank <- rowMeans(Macro[c("b1372", "b5244", "b5640", "b6164")])
XAll6 <- rowMeans(Macro[c("c1372","c5640","c6164","b1372","b5640","b6164")])
XAll8 <- rowMeans(Macro[c("c1372", "c5244", "c5640", "c6164","b1372", "b5244", "b5640", "b6164")])
X1372V5244V <- rowMeans(Macro[c("v1372", "v5244")])
X1372V5640V <- rowMeans(Macro[c("v1372", "v5640")])
X1372V6164V <- rowMeans(Macro[c("v1372", "v6164")])
X1372V1372BV <- rowMeans(Macro[c("v1372", "bv1372")])
X1372V5244BV <- rowMeans(Macro[c("v1372", "bv5244")])
X1372V5640BV <- rowMeans(Macro[c("v1372", "bv5640")])
X1372V6164BV <- rowMeans(Macro[c("v1372", "bv6164")])
X5244V5640V <- rowMeans(Macro[c("v5244", "v5640")])
X5244V6164V <- rowMeans(Macro[c("v5244", "v6164")])
X5244V1372BV <- rowMeans(Macro[c("v5244", "bv1372")])
X5244V5244BV <- rowMeans(Macro[c("v5244", "bv5244")])
X5244V5640BV <- rowMeans(Macro[c("v5244", "bv5640")])
X5244V6164BV <- rowMeans(Macro[c("v5244", "bv6164")])
X5640V6164V <- rowMeans(Macro[c("v5640", "v6164")])
X5640V1372BV <- rowMeans(Macro[c("v5640", "bv1372")])
X5640V5244BV <- rowMeans(Macro[c("v5640", "bv5244")])
X5640V5640BV <- rowMeans(Macro[c("v5640", "bv5640")])
X5640V6164BV <- rowMeans(Macro[c("v5640", "bv6164")])
X6164V1372BV <- rowMeans(Macro[c("v6164", "bv1372")])
X6164V5244BV <- rowMeans(Macro[c("v6164", "bv5244")])
X6164V5640BV <- rowMeans(Macro[c("v6164", "bv5640")])
X6164V6164BV <- rowMeans(Macro[c("v6164", "bv6164")])
X1372BV5244BV <- rowMeans(Macro[c("bv1372", "bv5244")])
X1372BV5640BV <- rowMeans(Macro[c("bv1372", "bv5640")])
X1372BV6164BV <- rowMeans(Macro[c("bv1372", "bv6164")])
X5244BV5640BV <- rowMeans(Macro[c("bv5244", "bv5640")])
X5244BV6164BV <- rowMeans(Macro[c("bv5244", "bv6164")])
X5640BV6164BV <- rowMeans(Macro[c("bv5640", "bv6164")])
X1372V5640V1372BV <- rowMeans(Macro[c("v1372", "v5640", "bv1372" )])
X1372V5640V5640BV <- rowMeans(Macro[c("v1372", "v5640", "bv5640" )])
X1372V5640V6164BV <- rowMeans(Macro[c("v1372", "v5640", "bv6164" )])
X1372V6164V1372BV <- rowMeans(Macro[c("v1372", "v6164", "bv1372" )])
X1372V6164V5640BV <- rowMeans(Macro[c("v1372", "v6164", "bv5640" )])
X1372V6164V6164BV <- rowMeans(Macro[c("v1372", "v6164", "bv6164" )])
X6164V5640V1372BV <- rowMeans(Macro[c("v6164", "v5640", "bv1372" )])
X6164V5640V5640BV <- rowMeans(Macro[c("v6164", "v5640", "bv5640" )])
X6164V5640V6164BV <- rowMeans(Macro[c("v6164", "v5640", "bv6164" )])
XAll3CardV <- rowMeans(Macro[c("v1372","v5640","v6164")])
XAll3Card1372BV <- rowMeans(Macro[c("v1372","v5640","v6164","bv1372")])
XAll3Card5640BV <- rowMeans(Macro[c("v1372","v5640","v6164","bv5640")])
XAll3Card6164BV <- rowMeans(Macro[c("v1372","v5640","v6164","bv6164")])
XAll3BankV <- rowMeans(Macro[c("bv1372","bv5640","bv6164")])
XAll3Bank1372V <- rowMeans(Macro[c("bv1372","bv5640","bv6164","v1372")])
XAll3Bank5640V <- rowMeans(Macro[c("bv1372","bv5640","bv6164","v5640")])
XAll3Bank6164V <- rowMeans(Macro[c("bv1372","bv5640","bv6164","v6164")])
XAll13725640V <- rowMeans(Macro[c("v1372", "bv1372", "v5640", "bv5640")])
XAll13726164V <- rowMeans(Macro[c("v1372", "bv1372", "v6164", "bv6164")])
XAll56406164V <- rowMeans(Macro[c("v5640", "bv5640", "v6164", "bv6164")])
XAll4CardV <- rowMeans(Macro[c("v1372", "v5244", "v5640", "v6164")])
XAll4BankV <- rowMeans(Macro[c("bv1372", "bv5244", "bv5640", "bv6164")])
XAll6V <- rowMeans(Macro[c("v1372","v5640","v6164","bv1372","bv5640","bv6164")])
XAll8V <- rowMeans(Macro[c("v1372", "v5244", "v5640", "v6164","bv1372", "bv5244", "bv5640", "bv6164")])
X1372C5244C <- data.frame(X1372C5244C)
X1372C5640C <- data.frame(X1372C5640C)
X1372C6164C <- data.frame(X1372C6164C)
X1372C1372B <- data.frame(X1372C1372B)
X1372C5244B <- data.frame(X1372C5244B)
X1372C5640B <- data.frame(X1372C5640B)
X1372C6164B <- data.frame(X1372C6164B)
X5244C5640C <- data.frame(X5244C5640C)
X5244C6164C <- data.frame(X5244C6164C)
X5244C1372B <- data.frame(X5244C1372B)
X5244C5244B <- data.frame(X5244C5244B)
X5244C5640B <- data.frame(X5244C5640B)
X5244C6164B <- data.frame(X5244C6164B)
X5640C6164C <- data.frame(X5640C6164C)
X5640C1372B <- data.frame(X5640C1372B)
X5640C5244B <- data.frame(X5640C5244B)
X5640C5640B <- data.frame(X5640C5640B)
X5640C6164B <- data.frame(X5640C6164B)
X6164C1372B <- data.frame(X6164C1372B)
X6164C5244B <- data.frame(X6164C5244B)
X6164C5640B <- data.frame(X6164C5640B)
X6164C6164B <- data.frame(X6164C6164B)
X1372B5244B <- data.frame(X1372B5244B)
X1372B5640B <- data.frame(X1372B5640B)
X1372B6164B <- data.frame(X1372B6164B)
X5244B5640B <- data.frame(X5244B5640B)
X5244B6164B <- data.frame(X5244B6164B)
X5640B6164B <- data.frame(X5640B6164B)
X1372C5640C1372B <- data.frame(X1372C5640C1372B)
X1372C5640C5640B <- data.frame(X1372C5640C5640B)
X1372C5640C6164B <- data.frame(X1372C5640C6164B)
X1372C6164C1372B <- data.frame(X1372C6164C1372B)
X1372C6164C5640B <- data.frame(X1372C6164C5640B)
X1372C6164C6164B <- data.frame(X1372C6164C6164B)
X6164C5640C1372B <- data.frame(X6164C5640C1372B)
X6164C5640C5640B <- data.frame(X6164C5640C5640B)
X6164C5640C6164B <- data.frame(X6164C5640C6164B)
XAll3Card <- data.frame(XAll3Card)
XAll3Card1372B <- data.frame(XAll3Card1372B)
XAll3Card5640B <- data.frame(XAll3Card5640B)
XAll3Card6164B <- data.frame(XAll3Card6164B)
XAll3Bank <- data.frame(XAll3Bank)
XAll3Bank1372C <- data.frame(XAll3Bank1372C)
XAll3Bank5640C <- data.frame(XAll3Bank5640C)
XAll3Bank6164C <- data.frame(XAll3Bank6164C)
XAll13725640 <- data.frame(XAll13725640)
XAll13726164 <- data.frame(XAll13726164)
XAll56406164 <- data.frame(XAll56406164)
XAll4Card <- data.frame(XAll4Card)
XAll4Bank <- data.frame(XAll4Bank)
XAll6 <- data.frame(XAll6)
XAll8 <- data.frame(XAll8)
X1372V5244V <- data.frame(X1372V5244V)
X1372V5640V <- data.frame(X1372V5640V)
X1372V6164V <- data.frame(X1372V6164V)
X1372V1372BV <- data.frame(X1372V1372BV)
X1372V5244BV <- data.frame(X1372V5244BV)
X1372V5640BV <- data.frame(X1372V5640BV)
X1372V6164BV <- data.frame(X1372V6164BV)
X5244V5640V <- data.frame(X5244V5640V)
X5244V6164V <- data.frame(X5244V6164V)
X5244V1372BV <- data.frame(X5244V1372BV)
X5244V5244BV <- data.frame(X5244V5244BV)
X5244V5640BV <- data.frame(X5244V5640BV)
X5244V6164BV <- data.frame(X5244V6164BV)
X5640V6164V <- data.frame(X5640V6164V)
X5640V1372BV <- data.frame(X5640V1372BV)
X5640V5244BV <- data.frame(X5640V5244BV)
X5640V5640BV <- data.frame(X5640V5640BV)
X5640V6164BV <- data.frame(X5640V6164BV)
X6164V1372BV <- data.frame(X6164V1372BV)
X6164V5244BV <- data.frame(X6164V5244BV)
X6164V5640BV <- data.frame(X6164V5640BV)
X6164V6164BV <- data.frame(X6164V6164BV)
X1372BV5244BV <- data.frame(X1372BV5244BV)
X1372BV5640BV <- data.frame(X1372BV5640BV)
X1372BV6164BV <- data.frame(X1372BV6164BV)
X5244BV5640BV <- data.frame(X5244BV5640BV)
X5244BV6164BV <- data.frame(X5244BV6164BV)
X5640BV6164BV <- data.frame(X5640BV6164BV)
X1372V5640V1372BV <- data.frame(X1372V5640V1372BV)
X1372V5640V5640BV <- data.frame(X1372V5640V5640BV)
X1372V5640V6164BV <- data.frame(X1372V5640V6164BV)
X1372V6164V1372BV <- data.frame(X1372V6164V1372BV)
X1372V6164V5640BV <- data.frame(X1372V6164V5640BV)
X1372V6164V6164BV <- data.frame(X1372V6164V6164BV)
X6164V5640V1372BV <- data.frame(X6164V5640V1372BV)
X6164V5640V5640BV <- data.frame(X6164V5640V5640BV)
X6164V5640V6164BV <- data.frame(X6164V5640V6164BV)
XAll3CardV <- data.frame(XAll3CardV)
XAll3Card1372BV <- data.frame(XAll3Card1372BV)
XAll3Card5640BV <- data.frame(XAll3Card5640BV)
XAll3Card6164BV <- data.frame(XAll3Card6164BV)
XAll3BankV <- data.frame(XAll3BankV)
XAll3Bank1372V <- data.frame(XAll3Bank1372V)
XAll3Bank5640V <- data.frame(XAll3Bank5640V)
XAll3Bank6164V <- data.frame(XAll3Bank6164V)
XAll13725640V <- data.frame(XAll13725640V)
XAll13726164V <- data.frame(XAll13726164V)
XAll56406164V <- data.frame(XAll56406164V)
XAll4CardV <- data.frame(XAll4CardV)
XAll4BankV <- data.frame(XAll4BankV)
XAll6V <- data.frame(XAll6V)
XAll8V <- data.frame(XAll8V)
s1 <- Macro["s1"]
s2 <- Macro["s2"]
s3 <- Macro["s3"]
y <- Macro["y"]
Macro2 <- data.frame(y, X1372C5244C, X1372C5640C, X1372C6164C, X1372C1372B, X1372C5244B, X1372C5640B, X1372C6164B,
X5244C5640C, X5244C6164C, X5244C1372B, X5244C5244B, X5244C5640B, X5244C6164B, X5640C6164C,
X5640C1372B, X5640C5244B, X5640C5640B, X5640C6164B, X6164C1372B, X6164C5244B, X6164C5640B, X6164C6164B, X1372B5244B, X1372B5640B, X1372B6164B, X5244B5640B, X5244B6164B, X5640B6164B, X1372C5640C1372B, X1372C5640C5640B, X1372C5640C6164B, X1372C6164C1372B, X1372C6164C5640B, X1372C6164C6164B, X6164C5640C1372B, X6164C5640C5640B, X6164C5640C6164B,
XAll3Card, XAll3Card1372B, XAll3Card5640B, XAll3Card6164B, XAll3Bank, XAll3Bank1372C, XAll3Bank5640C, XAll3Bank6164C, XAll13725640, XAll13726164, XAll56406164, XAll4Card, XAll4Bank, XAll6, XAll8, s1, s2, s3)
Macro3 <- data.frame(y, X1372V5244V, X1372V5640V, X1372V6164V, X1372V1372BV, X1372V5244BV, X1372V5640BV, X1372V6164BV,
X5244V5640V, X5244V6164V, X5244V1372BV, X5244V5244BV, X5244V5640BV, X5244V6164BV, X5640V6164V,
X5640V1372BV, X5640V5244BV, X5640V5640BV, X5640V6164BV, X6164V1372BV, X6164V5244BV, X6164V5640BV, X6164V6164BV, X1372BV5244BV, X1372BV5640BV, X1372BV6164BV, X5244BV5640BV, X5244BV6164BV, X5640BV6164BV, X1372V5640V1372BV, X1372V5640V5640BV, X1372V5640V6164BV, X1372V6164V1372BV, X1372V6164V5640BV, X1372V6164V6164BV, X6164V5640V1372BV, X6164V5640V5640BV, X6164V5640V6164BV,
XAll3CardV, XAll3Card1372BV, XAll3Card5640BV, XAll3Card6164BV, XAll3BankV, XAll3Bank1372V, XAll3Bank5640V, XAll3Bank6164V, XAll13725640V, XAll13726164V, XAll56406164V, XAll4CardV, XAll4BankV, XAll6V, XAll8V, s1, s2, s3)
Macro4 <- data.frame(c5640, c6164, b5640, b6164, v5640, v6164, bv5640, bv6164,
X5640C6164C, X5640C5640B, X5640C6164B, X6164C5640B, X6164C6164B, X5640B6164B, X6164C5640C5640B, X6164C5640C6164B, XAll56406164,
X5640V6164V, X5640V5640BV, X5640V6164BV, X6164V5640BV, X6164V6164BV, X5640BV6164BV, X6164V5640V5640BV, X6164V5640V6164BV, XAll56406164V)
Macroall <- data.frame(y, c1372, c5640, c6164, b1372, b5640, b6164, v1372, v5640, v6164, bv1372, bv5640, bv6164,
X1372C5640C, X1372C6164C, X1372C1372B, X1372C5640B, X1372C6164B,
X5640C6164C,
X5640C1372B, X5640C5640B, X5640C6164B, X6164C1372B, X6164C5640B, X6164C6164B, X1372B5640B, X1372B6164B, X5640B6164B, X1372C5640C1372B, X1372C5640C5640B, X1372C5640C6164B, X1372C6164C1372B, X1372C6164C5640B, X1372C6164C6164B, X6164C5640C1372B, X6164C5640C5640B, X6164C5640C6164B,
XAll3Card, XAll3Card1372B, XAll3Card5640B, XAll3Card6164B, XAll3Bank, XAll3Bank1372C, XAll3Bank5640C, XAll3Bank6164C, XAll13725640, XAll13726164, XAll56406164, XAll6,
X1372V5640V, X1372V6164V, X1372V1372BV, X1372V5640BV, X1372V6164BV,
X5640V6164V,
X5640V1372BV, X5640V5640BV, X5640V6164BV, X6164V1372BV, X6164V5640BV, X6164V6164BV, X1372BV5640BV, X1372BV6164BV, X5640BV6164BV, X1372V5640V1372BV, X1372V5640V5640BV, X1372V5640V6164BV, X1372V6164V1372BV, X1372V6164V5640BV, X1372V6164V6164BV, X6164V5640V1372BV, X6164V5640V5640BV, X6164V5640V6164BV,
XAll3CardV, XAll3Card1372BV, XAll3Card5640BV, XAll3Card6164BV, XAll3BankV, XAll3Bank1372V, XAll3Bank5640V, XAll3Bank6164V, XAll13725640V, XAll13726164V, XAll56406164V, XAll6V, s1, s2, s3)
答案 0 :(得分：1)
auto.arima占用了大部分时间，这意味着没有太多优化。每个auto.arima大约需要200毫秒。 1:6乘以16列乘以200毫秒即为19.2秒。在我的机器上，此解决方案在不启用任何并行内核的情况下要花费大约22秒才能运行。开销不要太寒酸。 最终编辑：使用future_lapply，我在2核i3上将其从22秒提高到了12秒。拥有32核，您应该看起来还不错。
最大的变化是，我为每个时间序列循环（即Macro）对您的rev(1:6)进行了一次子集设置。这有助于避免为每个变量名重复y子集。
然后，使用lapply而不是显式循环，该循环应该比for循环快。
最后一点，我仍然无法运行您的代码，因此不确定这些是否是您想要的结果。
library(future.apply)
plan(multiprocess)
all_outputs <- lapply(6:1,
function (z) {
x1 <- ts(Macro[-z, vars], start = c(2016, 3), frequency = 4)
y1 <- ts(Macro[-z, 'y'], start = c(2016, 3), frequency = 4)
t1 <- ts(Macro[nrow(Macro)-z+1, vars], start = c(2018, 4), frequency = 4)
fits <-
future_lapply(x1, function(x)
auto.arima(
y = y1,
xreg = x,
seasonal = TRUE
))
outputs <-
lapply(vars, function(x)
x = forecast(fits[[x]], xreg = t1[, x])$mean)
names(outputs) <- vars
outputs
}
)
#if you have data.table
data.table::rbindlist(all_outputs)
#or base works fine as well
do.call(rbind, all_outputs)
edit2：结果
> do.call(rbind, all_outputs)
c1372 c5244 c5640 c6164 b1372 b5244 b5640
[1,] 207.3153 243.6196 240.3115 195.4832 244.7843 231.6605 236.5413
[2,] 206.3054 241.976 241.5821 198.7039 243.2236 239.3933 239.69
[3,] 204.1035 244.3271 244.2875 218.5334 243.7765 239.1547 252.0341
[4,] 222.5313 242.494 234.2466 229.7297 242.8088 247.4714 242.9732
[5,] 228.2269 242.7452 222.5183 233.2577 242.0669 242.7832 242.8417
[6,] 237.058 241.8235 235.3313 242.1377 241.7233 241.8443 241.8192
b6164 v1372 v5244 v5640 v6164 bv1372 bv5244
[1,] 244.097 243.0404 242.4219 250.7803 245.2109 243.1929 230.8454
[2,] 245.59 239.6461 240.0976 249.8216 244.076 240.2225 239.4011
[3,] 248.9123 240.3455 241.308 256.1201 241.8166 239.2862 238.6731
[4,] 245.1561 240.3136 246.373 257.4908 243.991 241.2637 247.0656
[5,] 242.3743 241.8402 242.5925 252.1454 239.7479 242.9514 242.6109
[6,] 241.8072 241.3552 244.5711 237.4899 241.7374 241.8847 244.9614
bv5640 bv6164
[1,] 231.3937 241.8475
[2,] 231.5027 239.3111
[3,] 230.2004 239.2619
[4,] 230.8542 231.8769
[5,] 233.1609 236.7501
[6,] 232.2402 241.8176
修改：数据
library(scales)
library(foreach)
library(doParallel)
library(forecast)
library(future.apply)
plan(multiprocess) #for future_lapply
Macro <-
structure(
list(
qtrs = structure(
1:14,
.Label = c(
"15_Q3",
"15_Q4",
"16_Q1",
"16_Q2",
"16_Q3",
"16_Q4",
"17_Q1",
"17_Q2",
"17_Q3",
"17_Q4",
"18_Q1",
"18_Q2",
"18_Q3",
"QQ_New"
),
class = "factor"
),
y = c(
121.3,
131.1,
142.5,
156.4,
168.7,
176.2,
177,
186.6,
199.6,
208.4,
214,
226.2,
232.5,
233.3
),
c1372 = c(
0.51798059487155,
0.605074600778554,
0.70840580233259,
0.796638389230915,
0.800936365512504,
0.862507422705653,
0.906587776772603,
0.965869599669482,
1.02057681299029,
1.0173665712577,
1.00815541019123,
1.11026857023261,
1.12549360199319,
1.17070543044674
),
c5244 = c(
0.0158288398871533,
0.0186529717846534,
0.0335038479568057,
0.0322124481706554,
0.0473432307176583,
0.0372644166954006,
0.055124227441671,
0.0462947124597511,
0.0595395997947759,
0.079813226336006,
0.0632338684298483,
0.0359582444979424,
0.0399978873936274,
0.0363530147033467
),
c5640 = c(
0.0695411232121069,
0.0711030107194139,
0.0768960904393596,
0.0937721113616879,
0.0912072768529112,
0.0948627915873504,
0.0898598251896699,
0.102519015439631,
0.117307571608132,
0.116512410019832,
0.112621649435311,
0.113373707050245,
0.11920732067264,
0.11385677519257
),
c6164 = c(
0.165253620685311,
0.180939722142955,
0.204839371353829,
0.230388360169478,
0.245455819824873,
0.250222069413121,
0.267517323013963,
0.301455130772129,
0.312527568603722,
0.318684362849784,
0.336297671149745,
0.385321973576628,
0.393392171202544,
0.414026295628249
),
b1372 = c(
0.220276379575007,
0.232259423605283,
0.239015099925248,
0.29722406784095,
0.305759227349267,
0.314812674203001,
0.373507924872403,
0.376216626537958,
0.450679682818151,
0.422160030256414,
0.398670890305128,
0.380896038096525,
0.339513818723946,
0.365265284571949
),
b5244 = c(
0.0256963971001724,
0.0308736893223339,
0.0314727889765328,
0.0342560993718647,
0.0329261690808683,
0.0341169107838618,
0.0500316002161605,
0.057066652393088,
0.0637597978553195,
0.102100656473269,
0.109515398926193,
0.0509080775409312,
0.034576665601428,
0.037353167421955
),
b5640 = c(
0.0610914743954476,
0.0681070468175109,
0.0680584203087885,
0.0737178858316377,
0.0657525044040775,
0.0634389081514569,
0.0655890933419926,
0.0689747904574716,
0.0653176858840394,
0.0683221933318993,
0.0692822163266979,
0.0648739229545749,
0.0613089747918081,
0.0681802570906864
),
b6164 = c(
0.106769764392002,
0.117293493937739,
0.128632140410947,
0.146139699267301,
0.15999997720466,
0.170137316488036,
0.188733545209946,
0.192072924866328,
0.200314760101575,
0.206572493122192,
0.21531555211795,
0.187877279779437,
0.161952291803993,
0.160944253061549
),
v1372 = c(
0.00268999015293817,
0.00312395322452212,
0.00339511453015627,
0.00345686458302532,
0.00342490795325169,
0.0036875222492476,
0.00361618758896395,
0.00355297766248592,
0.00386182842589497,
0.00356454140879668,
0.00347191673410727,
0.00363595803623375,
0.00374222181870868,
0.00371078757415556
),
v5244 = c(
0.000480051602474059,
0.00042588395300854,
0.0005605459198973,
0.000529571165782351,
0.00057240403833901,
0.000468179333138233,
0.000653241119295764,
0.000455570432040571,
0.000535395675184177,
0.00138501873189088,
0.00114060122318986,
0.000320532455933637,
0.000333175133801828,
0.000314970929257286
),
v5640 = c(
0.000839152227642805,
0.000878653169087127,
0.00086250329626335,
0.000928749230480325,
0.000952705037621405,
0.0009145284719627,
0.000862662166602764,
0.000861675351344781,
0.000900555099811469,
0.000846321708899047,
0.000869990227889332,
0.000889602926022706,
0.000847332392691765,
0.000745645512078392
),
v6164 = c(
0.00174116886286925,
0.00190736857470478,
0.00204206516831707,
0.00208434471661794,
0.0022434016778137,
0.00215767033473045,
0.00216675412062837,
0.00211218329813293,
0.00222445645154173,
0.00210022505915819,
0.00196775099859493,
0.00205851514065652,
0.00187858647947073,
0.00198038712502613
),
bv1372 = c(
0.00142360941776777,
0.00151188642851632,
0.00157840305106086,
0.00168297006976765,
0.00157809381382463,
0.00180299614944991,
0.00285754565464732,
0.0026777621396315,
0.00314015380649578,
0.00293231409618566,
0.00290686161843522,
0.00248890293023165,
0.00168251123284542,
0.00179265933772828
),
bv5244 = c(
0.000582722401914161,
0.000711777965499918,
0.000761910243648493,
0.000805854835145839,
0.000736857013245957,
0.000833892120648163,
0.0013602408759186,
0.0015050207801102,
0.0016936381650882,
0.00295309680744017,
0.0031773319850428,
0.00106962198904438,
0.000593441969063344,
0.000574791244792
),
bv5640 = c(
0.00115351432401665,
0.00132428243672085,
0.00136224787475921,
0.00141606633583978,
0.00116049625522213,
0.000858609082150378,
0.000908098663997447,
0.000935982449156028,
0.000899912473850066,
0.000835053614508394,
0.000872837946479594,
0.000833516238462063,
0.000726891442062557,
0.000774037355521608
),
bv6164 = c(
0.000926271545004555,
0.00105864530300842,
0.00109611375444535,
0.00117219207771791,
0.00122508269987305,
0.00135585463133827,
0.00195926581029822,
0.00187620455518874,
0.00206572868014085,
0.00213169451258196,
0.00205259028597028,
0.00136013066654879,
0.000919533667669498,
0.0010609844820593
),
s1 = c(1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L,
1L, 0L, 0L, 0L, 1L, 0L),
s2 = c(0L, 1L, 0L, 0L, 0L, 1L, 0L,
0L, 0L, 1L, 0L, 0L, 0L, 1L),
s3 = c(0L, 0L, 1L, 0L, 0L, 0L,
1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L),
date = structure(
c(1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
.Label = "2018-09-30",
class = "factor"
)
),
class = "data.frame",
row.names = c(NA,-14L)
)
# Loads variables
vars_macro <- c("c1372", "c5244", "c5640", "c6164", "b1372", "b5244", "b5640",
"b6164", "v1372", "v5244", "v5640", "v6164", "bv1372", "bv5244",
"bv5640", "bv6164")
vars = c(vars_macro)
all_outputs <- lapply(6:1,
function (z) {
x1 <- ts(Macro[-z, vars], start = c(2016, 3), frequency = 4)
y1 <- ts(Macro[-z, 'y'], start = c(2016, 3), frequency = 4)
t1 <- ts(Macro[nrow(Macro)-z+1, vars], start = c(2018, 4), frequency = 4)
fits <-
future_lapply(x1, function(x)
auto.arima(
y = y1,
xreg = x,
seasonal = TRUE
))
outputs <-
lapply(vars, function(x)
x = forecast(fits[[x]], xreg = t1[, x])$mean)
names(outputs) <- vars
outputs
}
)
data.table::rbindlist(all_outputs)
do.call(rbind, all_outputs)