优化rollapplyr自定义函数答案

【问题标题】：Optimizing rollapplyr custom function优化rollapplyr自定义函数
【发布时间】：2016-02-05 19:32:30
【问题描述】：

我有以下数据：

y <- data.table(cbind(week = rep(1:61,5352),
ID = rep(1:5352, each = 61), w = runif(326472), v = runif(326472)))
y$v[sample(1:326472, 10000, replace=FALSE)] <- NA

我正在运行下面的代码，该代码创建变量 v 的滚动平均值，忽略异常值和 NA。该代码正在运行，但性能很差。我确信有更有效的方法可以使用 apply 或类似的东西来运行它，但我未能成功创建一个更快的版本。谁能解释一下如何提高效率？

IDs <- unique(y$ID)
y$vol_m12 <- 0

for (i in 1:length(IDs)) {
  x <- y[ID==IDs[i]]

  outlier <- 0.2
  w_outlier <- quantile(x$w, c(outlier), na.rm = T)
  v_outlier <-quantile(x$v, c(1 - outlier), na.rm = T)

# Ignore outliers      
  x$v_temp <- x$v
  x$v_temp[((x$v_temp >= v_outlier)
                 & (x$w <= w_outlier))] <- NA

# Creating rolling mean
  y$vol_m12[y$ID==IDs[i]] <- x[, rollapplyr(v_temp, 12, (mean), fill = NA, na.rm=T)]
}

【问题讨论】：

This may be helpful
见：stackoverflow.com/questions/29851637/…。似乎对该 Rcpp 代码的小修改可能会成功。

标签： r data.table lapply rollapply

【解决方案1】：

感谢您的回复。根据 42 条建议，我生成了以下代码：

library(RcppRoll)
# Ignore outliers
y[, w_out := quantile(w, c(outlier), na.rm = T), by=ID]
y[, v_out := quantile(v, c(1-outlier), na.rm = T), by=ID]
y[((v <= v_out) & (w >= w_out)), v_temp := v]
y[,w_out := NULL]
y[,v_out := NULL]

y[, v_m12 := roll_mean(as.matrix(v_temp), n =12L, fill = NA,
                     align = c("right"), normalize = TRUE, na.rm = T), by = ID]

系统时间约为 0.59 秒，而下面使用 rollapplyr 的解决方案为 10.36 秒（但可能可以更有效地去除异常值）。

y[, v_m12 :=rollapplyr(v_temp, 12, (mean), fill = NA, na.rm=T), by = ID]

【讨论】：