Как ускорить/улучшить скользящую среднюю функцию?

Question

Мои данные 988, 785 общ. из 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 Гц. Я хочу рассчитать скользящее среднее Acceleration за каждые ID за период от 1 до 10 секунд. Я выполняю это, используя следующее:

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)) { 

Однако, это занимает несколько часов, чтобы пробежать мой набор данных и результаты в RStudio на моем Mac (подробности ниже) висит! Есть ли способ, которым я могу: 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

Я не уверен, если у вас есть другие итоговые функции в виду, но, по крайней мере, для среднего значения, вы можете ускорить функцию rollapply с помощью filter вместо: 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

Причина, по которой работает медленно, что

1. код в вопросе победил rollapply «s способность обнаруживать, что mean это передается путем присвоения mean к переменной и передача переменной. (В случае mean, rollapply звонки rollmean которые содержат оптимизационный код для этого случая). Если бы код в вопросе прошел mean напрямую или если он использовал rollmean, это было бы значительно быстрее.

2. filter не удаляет Nas так в течение яблок сравнений яблок один должен не использование na.rm = TRUE в rollapply. Если вы его используете, это также победит оптимизацию.

К примеру, в этом сравнении 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, длину данных и другие аспекты ввода, поскольку это только один тест.