Question

我想在R中的向量上执行指数加权移动平均值（参数化定义here）。是否有比下面第一次尝试更好的实现？

我的第一次尝试是：

ewma <- function(x, a) {
  n <- length(x)
  s <- rep(NA,n)
  s[1] <- x[1]
  if (n > 1) {
    for (i in 2:n) {
      s[i] <- a * x[i] + (1 - a) * s[i-1]
    }
  }
  return(s)
}

y <- 1:1e7
system.time(s <- ewma(y,0.5))
#user  system elapsed 
#   2.48    0.00    2.50

在我的第二次尝试中，我认为通过矢量化可以做得更好：

ewma_vectorized <- function(x,a) {
  a <- 0.1
  n <- length(x)
  w <- cumprod(c(1, rep(1-a, n-1)))
  x1_contribution <- w * x[1]
  w <- a * w
  x <- x[-1]
  s <- apply(as.array(1:(n-1)), 1, function(i,x,w){sum(w[i:1] * x[1:i])}, x=x, w=w)
  s <- x1_contribution + c(0,s)
  return(s)
}

system.time(s <- ewma_vectorized(y,0.5))
# I stopped the program after it continued to run for 4min

我想我不应该对第二次尝试的结果感到惊讶。这是一个非常丑陋的矢量化尝试。但是必须有一些喜欢这样可以改善我的第一次尝试......对吗？

更新：

我确实找到了更好的实施here并按如下方式对其进行了调整：

ewma_vectorized_v2 <- function(x, a) {
  s1 <- x[1]
  sk <- s1
  s <- vapply(x[-1], function(x) sk <<- (1 - a) * x + a * sk, 0)
  s <- c(s1, s)
  return(s)
}

system.time(s <- ewma_vectorized_v2(y,0.5))
# user  system elapsed 
#   1.74    0.01    1.76

Answer 1

您可以使用stats::filter：

执行此操作

ewma.filter <- function (x, ratio) {
  c(filter(x * ratio, 1 - ratio, "recursive", init = x[1]))
}
set.seed(21)
x <- rnorm(1e4)
all.equal(ewma.filter(x, 0.9), ewma(x, 0.9))
# [1] TRUE

这比你第一次尝试的编译版本快一点：

ewma <- compiler::cmpfun(function(x, a) {
  n <- length(x)
  s <- rep(NA,n)
  s[1] <- x[1]
  if (n > 1) {
    for (i in 2:n) {
      s[i] <- a * x[i] + (1 - a) * s[i-1]
    }
  }
  return(s)
})
microbenchmark(ewma.filter(x,0.9), ewma(x, 0.9))
Unit: microseconds
                expr      min        lq   median       uq      max neval
 ewma.filter(x, 0.9)  318.508  341.7395  368.737  473.254 1477.000   100
        ewma(x, 0.9) 1364.997 1403.4015 1458.961 1503.876 2221.252   100

Answer 2

在我的机器上（R 3.3.2窗口），你第一次循环需要大约16秒。通过在函数定义之前添加行compiler::enableJIT(2)来启用jit编译，代码将在约1秒内运行。

无论如何，如果你真的想快点，我认为你应该使用C / C ++，正如你在下面的例子中看到的那样使用Rcpp：

library(Rcpp)

sourceCpp(
  code = 
    "
     #include <Rcpp.h>
     // [[Rcpp::export]]
     Rcpp::NumericVector ewmaRcpp(Rcpp::NumericVector x, double a){
       int n = x.length();
       Rcpp::NumericVector s(n);
       s[0] = x[0];
       if (n > 1) {
         for (int i = 1; i < n; i++) {
           s[i] = a * x[i] + (1 - a) * s[i-1];
         }
       }
       return s;
     }

    ")

y <- 1:1e7
system.time(s2 <- ewmaRcpp(y,0.5))
# user  system elapsed 
# 0.06    0.01    0.07

Answer 3

@digEmAll对Rcpp版本非常友好，但也请注意您可以使用TTR包，或者，正如其作者所说，我在帖子中使用的stats::filter()方法（现已解散） R Graph Gallery十年前。

无论如何，一个快速枪战的枪战显示Rcpp版本更快......这可能意味着我们的参数化错误：

R> sourceCpp("/tmp/ema.cpp")

R> library(TTR)

R> library(microbenchmark)

R> y <- as.numeric(1:1e6)   # else the sequence creates ints

R> microbenchmark(ewmaRcpp(y,0.5), EMA(y, n=10))
Unit: milliseconds
             expr      min       lq     mean   median       uq      max neval cld
 ewmaRcpp(y, 0.5)  2.43666  2.45705  3.06699  2.47283  2.51439  9.76883   100  a 
   EMA(y, n = 10) 15.13208 15.37910 21.36930 15.59278 17.26318 76.45934   100   b
R>

实际上，lambda=0.5是一种异常强烈的衰变，与一天的半衰期或N=1相对应。如果我用那个，差距甚至更广。

为了完整性，整个文件只能是Rcpp::sourceCpp() - ed：

#include <Rcpp.h>
// [[Rcpp::export]]
Rcpp::NumericVector ewmaRcpp(Rcpp::NumericVector x, double a){
  int n = x.length();
  Rcpp::NumericVector s(n);
  s[0] = x[0];
  if (n > 1) {
    for (int i = 1; i < n; i++) {
      s[i] = a * x[i] + (1 - a) * s[i-1];
    }
  }
  return s;
}

/*** R
library(TTR)
library(microbenchmark)

y <- as.numeric(1:1e6)   # else the sequence creates ints
microbenchmark(ewmaRcpp(y,0.5), EMA(y, n=1))
*/

快速R实现指数加权移动平均线？

3 个答案: