計算移動平均線/滾動 function 的快速方法，允許自定義權重

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 特定的權重/平滑（唯一的靈活性是使用參數wilder=TRUE或wilder=FALSE ）。 我需要實現my.roll.1的功能，但要更快。

Answer 1

如評論中所述，使用stats::filter的可能解決方案。

請注意以下 arguments：

• 邊 = 1 以便過濾器僅使用過去的值
• 系數順序倒置1/(n:1) ，因為濾波器計算從最近的值開始

my.roll[,test2:=filter(val,prop.table(1/n:1),sides=1),by=.(type)][]
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