data.table frollmean очень медленный - PullRequest
Новая
       30

data.table frollmean очень медленный

0 голосов
/ 17 февраля 2020

Я пытаюсь вычислить скользящее среднее для столбца в большой таблице данных (~ 30M строк), объединенной двумя другими столбцами. Скользящее среднее должно включать только предыдущие значения N строк, а не само значение строки. Для этого мне нужно было определить собственную функцию скользящего среднего на основе функции frollmean. (N = 3) Применение функции к столбцу действительно очень медленное, что делает его довольно бесполезным.

Вот пример данных: 

require(data.table)
DT <- data.table(ID=c('A', 'A', 'A', 'A', 'A', 'A', 'B', 'B', 'B', 'C', 'C', 'C')
               , value_type =c('type 1', 'type 1','type 2','type 1','type 2','type 2','type 1','type 1','type 2','type 1','type 1','type 1')
               , value=c(1,4,7,2,3,5,1,6,8,2,2,3))
    DT
         ID value_type value
     1:  A     type 1     1
     2:  A     type 1     4
     3:  A     type 2     7
     4:  A     type 1     2
     5:  A     type 2     3
     6:  A     type 2     5
     7:  B     type 1     1
     8:  B     type 1     6
     9:  B     type 2     8
    10:  C     type 1     2
    11:  C     type 1     2
    12:  C     type 1     3

#this is the customised rolling function
lrollmean<-function(x){

  head(frollmean(c(NA,NA,NA,x), n = 3, fill = NA, algo ="exact", align="right", na.rm = TRUE)[-(1:2)], -1)

}

> DT[, roll_mean := lrollmean(value), by=.(ID, value_type)]
> DT
    ID value_type value roll_mean
 1:  A     type 1     1       NaN
 2:  A     type 1     4       1.0
 3:  A     type 2     7       NaN
 4:  A     type 1     2       2.5
 5:  A     type 2     3       7.0
 6:  A     type 2     5       5.0
 7:  B     type 1     1       NaN
 8:  B     type 1     6       1.0
 9:  B     type 2     8       NaN
10:  C     type 1     2       NaN
11:  C     type 1     2       2.0
12:  C     type 1     3       2.0

Эта операция занимает более 30 минут! У меня есть разумная машина с достаточным объемом оперативной памяти, и я чувствую, что длительное время операции связано с моим кодом, а не с машиной.

Ответы [ 2 ]

2 голосов
/ 17 февраля 2020

Можете ли вы попробовать и посмотреть, достаточно ли быстро: 

n <- 3L
DT[, roll_mean := {
        v <- if (.N - n >= 1L) c(seq.int(n), rep(n, .N-n)) else seq.int(min(n, .N))
        shift(frollmean(value, v, adaptive=TRUE))
    }, .(ID, value_type)]

Но если у вас большое количество небольших групп, вы можете попробовать: 

setorder(DT[, rn := .I], ID, value_type)
rid <- DT[, rowid(ID, value_type)]

DT[, roll_mean := shift(frollmean(value, n))]

ix <- DT[rid==3L, which=TRUE]
set(DT, ix, "roll_mean", DT[, shift(frollmean(value, n - 1L))][ix])

ix <- DT[rid==2L, which=TRUE]
set(DT, ix, "roll_mean", DT[, shift(value)][ix])

DT[rid==1L, roll_mean := NA_real_]
setorder(DT, rn)[]
1 голос
/ 17 февраля 2020

Вы можете попробовать frollapply, так как frollmean не полностью соответствует вашим потребностям. Вы также можете оптимизировать функцию, которую вы применяете к окну, так как вам не нужны очень сложные операции. Я пробовал несколько модификаций вашей функции, которые должны сократить ваше время примерно на 50%. 

library(data.table)
library(stringi)
N=1e6
set.seed(123)
DT <- data.table(ID=stri_rand_strings(N,3),
                 value=rnorm(N,5,5))
head(DT)
#>     ID      value
#> 1: HmP 12.2667538
#> 2: sw2 -2.2397053
#> 3: WtY  7.0911933
#> 4: SxS  0.4029431
#> 5: gZ6  8.6800795
#> 6: tF2  0.8228594
DT[,.(.N),by=ID][order(N)]
#>          ID  N
#>      1: HoR  1
#>      2: eNM  1
#>      3: I9h  1
#>      4: xjb  1
#>      5: eFH  1
#>     ---       
#> 234823: 34Y 15
#> 234824: Xcm 15
#> 234825: IOu 15
#> 234826: tob 16
#> 234827: f70 16

# Your function
lrollmean<-function(x){ 
  head(frollmean(c(NA,NA,NA,x), n = 3, fill = NA, algo ="exact", align="right", na.rm = TRUE)[-(1:2)], -1)
}

#Possible modifications:
lrollmean1<-function(x,n){
  frollapply(c(rep(NA,n),x),n+1,weighted.mean,c(rep(1,n),0),na.rm=T)[-(1:3)]
}
lrollmean2<-function(x,n){
  frollapply(c(rep(NA,n),x),n+1,function(x) sum(x*c(rep(1,n),0)/n,na.rm = T))[-(1:3)]
}
lrollmean3<-function(x){ # More optimized assuming n=3
  frollapply(c(NA,NA,NA,x),4,function(x) sum(x[1:3]/3,na.rm = T))[-(1:3)]
}


library(rbenchmark)

benchmark(original={DT[, roll_mean := lrollmean1(value,3), by=.(ID)]},
          a={DT[, roll_mean := lrollmean1(value,3), by=.(ID)]},
          b={DT[, roll_mean := lrollmean2(value,3), by=.(ID)]},
          c={DT[, roll_mean := lrollmean3(value), by=.(ID)]}
          ,replications = 1,order = 'relative')
#>       test replications elapsed relative user.self sys.self user.child
#> 4        c            1   6.740    1.000     6.829    0.000          0
#> 3        b            1   8.038    1.193     8.085    0.012          0
#> 1 original            1  13.599    2.018    13.692    0.000          0
#> 2        a            1  14.180    2.104    14.233    0.008          0
#>   sys.child
#> 4         0
#> 3         0
#> 1         0
#> 2         0

Создано в 2020-02-17 с помощью пакета prex (v0.3.0)

...