如何加快/改进滚动平均功能？

Question

我的数据是988，785 obs。 3个变量。下面是我的数据的一个较小示例：

Names <- c("Jack", "Jill", "John")
RawAccelData <- data.frame(
  Sample = as.numeric(rep(1:60000, each = 3)),
  Acceleration = rnorm(6000),
  ID = rep((Names), each = 60000)
)

我设备的采样率为 100 Hz。我希望在 1 到 10 秒的时间内为每个 ID 计算 Acceleration 的滚动平均值。我使用以下方法执行此操作：

require(dplyr)
require(zoo)

for (summaryFunction in c("mean")) {
  for ( i in seq(100, 1000, by = 100)) {
    tempColumn <- RawAccelData %>%
      group_by(ID) %>%
      transmute(rollapply(Acceleration,
                          width = i, 
                          FUN = summaryFunction, 
                          align = "right", 
                          fill = NA, 
                          na.rm = T))
    colnames(tempColumn)[2] <- paste("Rolling", summaryFunction, as.character(i), sep = ".")
    RawAccelData <- bind_cols(RawAccelData, tempColumn[2])
  }
}

但是，我现在需要计算 1 到 10 分钟内的滚动。我可以通过使用上面的代码并替换为以下行来做到这一点：

for ( i in seq(6000, 60000, by = 6000)) {

但是，运行通过我的数据集需要几个小时，并导致我的 Mac（详情见下文）上的 RStudio 挂起！有什么方法可以 a) 整理上面的代码或 b) 使用不同的包/方法来实现更快的结果？

谢谢。

R version 3.2.3 (2015-12-10)
Platform: x86_64-apple-darwin13.4.0 (64-bit)
Running under: OS X 10.10.5 (Yosemite)

locale:
[1] en_AU.UTF-8/en_AU.UTF-8/en_AU.UTF-8/C/en_AU.UTF-8/en_AU.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] zoo_1.7-12  dplyr_0.4.3

loaded via a namespace (and not attached):
 [1] lazyeval_0.1.10 magrittr_1.5    R6_2.1.1        assertthat_0.1  parallel_3.2.3  DBI_0.3.1      
 [7] tools_3.2.3     Rcpp_0.12.2     grid_3.2.3      lattice_0.20-33

Answer 1

我不确定您是否想到了其他汇总函数，但至少就平均而言，您可以使用 filter 来加速 rollapply 函数： transmute(stats::filter(Acceleration,rep(1/i,i),sides=1))

（在此处查看其他选项：Calculating moving average in R）使用 system.time，这使我从 117 秒加速到 4 秒！！

您还可以并行执行一些 for 循环。而不是

for ( i in seq(6000, 60000, by = 6000)) {

尝试：

library(parallel)
for (summaryFunction in c("mean")) {
  rollCols = mclapply (seq(100, 1000, by = 100),function(i){
    tempColumn <- RawAccelData %>%
    group_by(ID) %>%
    transmute(stats::filter(Acceleration,rep(1/i,i),sides=1))
    colnames(tempColumn)[2] <- paste("Rolling", summaryFunction, as.character(i), sep = ".")
    return(tempColumn[2])
  })
}

RawAccelData = cbind(RawAccelData,do.call(cbind,rollCols))

这使我从 72 秒加快到 40 秒，但这取决于您的计算机有多少个内核。

Answer 2

之所以运行慢是因为

问题中的代码已经击败了 rollapply 通过将 mean 分配给变量并传递该变量来检测正在传递 mean 的能力. （在 mean 的情况下，rollapply 调用 rollmean，其中包含针对该情况的优化代码）。如果问题中的代码直接通过 mean 或使用 rollmean ，它会快得多。
filter 不会删除 NA，因此对于同类比较，应该不在 [=12= 中使用 na.rm = TRUE ].如果您确实使用它，那么它也会破坏优化。

例如，在此比较中 rollapply 的运行速度是 filter 的两倍多：

library(zoo)
library(rbenchmark)

set.seed(123)
r <- rnorm(10000)
benchmark(filter = stats::filter(r, rep(1/100,100), sides = 1),
          rollapply = rollapplyr(r, 100, mean, fill = NA))[1:4]

给予：

       test replications elapsed relative
1    filter          100    3.75    2.119
2 rollapply          100    1.77    1.000

当然，速度可能会根据 width、数据长度和输入的其他方面而有所不同，因为这只是一个测试。

如何加快/改进滚动平均功能？

How to speed up/ improve rolling average function?

r

zoo

dplyr

rollapply