R：是否有每个 window 具有修剪值的滚动平均函数？

Question

我正在尝试做一个移动平均线（类似于 RcppRoll 中的 roll_mean），除了 each window，我想 trim 异常值（例如，只取值的第 5-95 个百分位数）。

举个例子，给定 window 的

v <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)

鉴于我想要第 10-90 个百分位的值，我应该得到 5.5 的答案（1 和 10 将被排除，其余值取平均值（2 到 9）。

很遗憾，我无法为此使用 RcppRoll::roll_mean 之类的函数，因为 trim 需要在每次滚动时完成 window。

我能够通过向 zoo::rollapply 提供自定义均值函数来做到这一点 - 但它对于我的用例（> 1e6 行）来说工作太慢了。

我查看了各种支持滚动函数的包（例如 RcppRoll、zoo、TTR、caTools、roll 等）但是 none 似乎支持此 trim 功能。

我正在考虑使用 Rcpp 构建自定义的快速滚动功能，但我对该框架相对不熟悉。不知道有没有更好的解决办法。

如有任何帮助，我们将不胜感激。

Answer 1

我想你可以做类似的事情

rollapply(data, 10, function(x) mean(x[x>=quantile(x,0.1) & x<=quantile(x,0.9)]))

Answer 2

这是 base-R 中的一个函数，它比 zoo::rollapply 快很多。进一步简化它可能是可能的，但该原则似乎有效。它通过使用 'rolling' 排序向量 vec 避免对每个 window 进行排序，并在 window 滚动时为新旧元素更新它。

require(zoo) #just for comparison at the end
require(microbenchmark)
data <- sample(1:100,1000,TRUE)

rollMeanTrim <- function(dat,window,trim){
   n <- length(dat)-window+1
   out <- rep(NA,n)
   exc <- round(trim*window)
   vec <- sort(dat[1:window])
   out[1] <- mean(vec[(1+exc):(window-exc)])
   for(i in 2:n){
      old <- dat[i-1]
      new <- dat[i+window-1]
      oldpos <- match(old,vec)
      vec <- vec[-oldpos]
      newpos <- match(1,sign(vec-new))
      if(is.na(newpos)) {
         vec <- c(vec,new)
      } else if(newpos==1) {
         vec <- c(new,vec)
      } else {
         vec <- c(vec[1:(newpos-1)],new,vec[newpos:(window-1)])
      }
      out[i] <- mean(vec[(1+exc):(window-exc)])
   }
   return(out)
}

microbenchmark(rollMeanTrim(data,10,0.1),rollapply(data, 10, mean, trim=0.1))

Unit: milliseconds
                                  expr      min       lq     mean   median       uq      max neval
           rollMeanTrim(data, 10, 0.1)  63.4825  81.2573 149.4777  98.8031 146.4868 1163.929   100
 rollapply(data, 10, mean, trim = 0.1) 213.8742 330.3273 659.2942 412.7529 773.4881 2761.591   100

R：是否有每个 window 具有修剪值的滚动平均函数？

R: Is there a rolling mean function with trimmed values for each window?

r

rcpp