data.table frollmean 很慢

Question

我正在尝试计算由其他两列聚合的大型 data.table（约 3000 万行）中一列的滚动平均值。滚动平均值应仅包括前面的 N 行值，而不是行值本身。为此，我必须基于 frollmean 函数定义自己的滚动均值函数。 (人数=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多分钟！我有一个合理的机器，内存充足，我觉得运行时间长与我的代码有关，而不是机器。

Answer 1

你能试试看它是否足够快:

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)[]

Answer 2

您可以尝试 frollapply，因为 frollmean 不能完全满足您的需求。您还可以优化应用于 window 的函数，因为您不需要非常复杂的操作。我已经尝试对您的函数进行一些修改，应该可以将您的时间减少大约 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

^{由 reprex package (v0.3.0)}

于 2020 年 2 月 17 日创建

data.table frollmean 很慢

data.table frollmean very slow

r

mean

data.table

rolling-computation