r - 循环和引导脚本运行时间过长

标签 r loops

我有以下 R需要 24 小时以上但最终在 Windows 10 上运行的脚本的 10-gigabyte ramcore M7 .该脚本执行以下操作:

这是我想要用 R 做的事情

  • A.我已经生成了 50 个时间序列数据集。

  • B.我将相同的时间序列数据集切成以下大小的 block :2,3,...,48,49让我从上面的步骤 1 中形成了 48 个不同的时间序列。

  • C.我将每个 48 个时间序列数据集划分为 traintest设置所以我可以使用 rmse Metrics中的函数包以获取步骤 2 中形成的 48 个子序列的均方根误差 (RMSE)。

  • D.然后根据其 block 大小将每个系列的 RMSE 制成表格

  • E.我得到了最好的ARIMA每个 48 个不同时间序列数据集的模型。

我的 R 脚本

# simulate arima(1,0,0)
library(forecast)
library(Metrics)

n=50
phi <- 0.5
set.seed(1)

wn <- rnorm(n, mean=0, sd=1)
ar1 <- sqrt((wn[1])^2/(1-phi^2))

for(i in 2:n){
  ar1[i] <- ar1[i - 1] * phi + wn[i]
}
ts <- ar1

t <- length(ts)    # the length of the time series
li <- seq(n-2)+1   # vector of block sizes to be 1 < l < n (i.e to be between 1 and n exclusively)

# vector to store block means
RMSEblk <- matrix(nrow = 1, ncol = length(li))
colnames(RMSEblk) <-li

for (b in 1:length(li)){
    l <- li[b]# block size
    m <- ceiling(t / l)                                 # number of blocks
    blk <- split(ts, rep(1:m, each=l, length.out = t))  # divides the series into blocks

    # initialize vector to receive result from for loop
    singleblock <- vector()                     
    for(i in 1:1000){
        res<-sample(blk, replace=T, 10000)        # resamples the blocks
        res.unlist<-unlist(res, use.names = F)    # unlist the bootstrap series
        # Split the series into train and test set
        train <- head(res.unlist, round(length(res.unlist) * 0.6))
        h <- length(res.unlist) - length(train)
        test <- tail(res.unlist, h)

        # Forecast for train set
        model <- auto.arima(train)
        future <- forecast(test, model=model,h=h)
        nfuture <- as.numeric(future$mean)        # makes the `future` object a vector            
        RMSE <- rmse(test, nfuture)               # use the `rmse` function from `Metrics` package

        singleblock[i] <- RMSE # Assign RMSE value to final result vector element i
    }

    RMSEblk[b] <- mean(singleblock) # store into matrix
}

RMSEblk

R脚本实际运行,但需要超过 24 小时才能完成。 loops 中的运行次数(10000 和 1000)是使任务完美的最低要求。

请问我该怎么做才能在更短的时间内完成脚本?

最佳答案

tl;dr你可能不得不以某种方式并行化它。


一个问题是您正在增长一个对象;也就是说,首先分配一个长度为零的向量( singleblock <- vector() ),然后一次增加一个元素( singleblock[i] <- RMSE )。如 R Inferno 第 2 章所述,这是 super 低效的。对于这个示例,它慢了 5 倍。

f1 <- function(x) { p <- numeric(0); for (i in 1:1000) p[i] <- 0 }
f2 <- function(x) { p <- numeric(1000); for (i in 1:1000) p[i] <- 0 }
microbenchmark(f1(),f2())
## Unit: microseconds
##  expr     min       lq      mean  median      uq     max neval cld
##  f1() 202.519 207.2105 249.84095 210.574 221.340 3504.95   100   b
##  f2()  40.274  40.6710  69.83741  40.9615  42.8275 2811.779   100  a 

但是:这并不重要。低效版本(增长向量)需要 210 微秒的中位时间。

microbenchmark(auto.arima(train),times=20L)
## Unit: milliseconds
##               expr      min       lq     mean   median       uq      max neval
##  auto.arima(train) 630.7335 648.3471 679.2703 657.6697 668.0563 829.1648    20

您的auto.arima()调用大约需要 660 毫秒 - 大约长 3000 倍。使用类似的 microbenchmark调用预测步骤给出的中值时间约为 20 毫秒。

你可以做更正式的profiling , 或按此处显示的点点滴滴继续,但我在您的代码中看不到任何看起来需要很长时间的东西(我可能会检查 sample() 下一个,但我怀疑它是否与 auto.arima() 相当.)

除非您能找到 auto.arima() 的更快版本(我对此表示怀疑),或者剥离一些东西(例如限制搜索空间),你唯一剩下的选择就是并行化。您可以使用许多不同的工具在许多不同的级别上执行此操作,但首先要查看的是 parallel option to auto.arima。 .您可能会选择并行化循环(在“R 中的并行计算”上进行网络搜索会提供大量资源);请注意,尝试在多个级别上进行并行化可能会给您带来麻烦。

PS 粗略计算(48000 * 660 毫秒)大约需要 9 小时 - 只占大约 1/3 的时间(我原本预计它会达到 80% 左右);也许你的处理器比我的慢?

关于r - 循环和引导脚本运行时间过长,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/61979057/

相关文章:

c++ - RapidJSON/C++ : Better ways to create objects/arrays?

r - R 中 if-else 中的逻辑运算符

r - 使用 R 合并不同排序的表

r - tidyverse:一个变量与 data.frame 中所有其他变量的交叉表

python - 如何从 R reticulate 调用 Python 方法

c++ - 在 C++ 中使用字符串数组多次运行一个函数

python - 如何自动构建多个列表

python - 基于 if 循环合并两个列表的内容

r - 如何在 R 中动态改变数据框中的列

r - knitr kable 将单元格文本格式化为有序列表