r - 快速计算允许自定义权重的移动平均/滚动函数的方法

Question

可以使用 TTR:SMA() 或 TTR::EMA() 但它们不允许自定义权重。我想到的一种解决方案是使用 data.table::frollapply:

library(data.table)
x <- data.table(type=rep(1:100, 10000), val=sample(1:1000000, 1000000))

my.roll.2 <- function(x, weights=NULL) {
    n <- length(x)
    if(is.null(weights)) weights <- 1/(1:n)
    sum(weights[1:n]*x, na.rm=T)/sum(weights[1:n])
}

my.roll.1 <- function(x, n, name, ref.col, val.col, weights=NULL) {
    x[, (name) := frollapply(get(val.col), n, my.roll.2, weights=weights), by=ref.col]
}

然而，my.roll.1 的性能不是很好(与其他输入数据相比，它的性能呈指数级下降):

library(microbenchmark)
library(TTR)
n <- 10
name <- 'test'
microbenchmark(
    my.roll=my.roll.1(x, n, name, 'type', 'val')
  , frollmean=x[, (name):=data.table::frollmean(val, n), type]
  , EMA=x[, (name):=TTR::EMA(val, n), type]
  , times=10L
)

结果:

Unit: milliseconds
      expr       min        lq       mean     median        uq       max neval
   my.roll 7661.0278 7666.0732 7698.69693 7693.28025 7708.6880 7778.6171    10
 frollmean   17.1724   17.6321   19.54878   19.56485   20.9490   23.5549    10
       EMA   43.0090   43.7332   45.92251   45.79210   47.2391   51.9399    10

data.table::frollmean 非常快(用 C 语言实现)但它不使用任何权重。 TTR::EMA 仅使用 EMA 特定权重/平滑(唯一的灵 active 是使用参数 wilder=TRUE 或 wilder=FALSE) .我的需求是实现 my.roll.1 的功能，但要更快。

Answer 1

如评论中所述，使用 stats::filter 的可能解决方案。

注意以下参数:

• sides = 1 以便过滤器仅使用过去的值
• 系数倒序 1/(n:1) 因为过滤器计算从最近的值开始

my.roll[,test2:=filter(val,prop.table(1/n:1),sides=1),by=.(type)]
# Conversion from ts to numeric
my.roll[,test2:=as.numeric(test2)][]

# type    val     test    test2
# <int>  <int>    <num>    <num>
#       1:     1 955625       NA       NA
#       2:     2 979596       NA       NA
#       3:     3 578778       NA       NA
#       4:     4 174631       NA       NA
#       5:     5 459947       NA       NA
# ---                               
#  999996:    96 191233 620505.8 620505.8
#  999997:    97 626522 398615.6 398615.6
#  999998:    98 527846 565061.2 565061.2
#  999999:    99 480277 537305.9 537305.9
# 1000000:   100 757433 395458.3 395458.3

all.equal(my.roll$test,my.roll$test2)
#[1] TRUE

速度比较:

microbenchmark::microbenchmark(
  my.roll=my.roll.1(x, n, name, 'type', 'val'),
  filter={my.roll[,test2:=filter(val,prop.table(1/n:1),sides=1),by=.(type)][];
          my.roll[,test2:=as.numeric(test2)][]
          }
  , times=10L
)

Unit: milliseconds
    expr       min        lq       mean     median        uq       max neval
 my.roll 2194.3200 2203.3726 2264.67423 2245.04510 2314.2377 2401.1156    10
  filter   73.1602   76.3098   78.18358   77.25665   80.4204   85.0567    10