0

我有以下数据:

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)]
}
4

1 回答 1

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]
于 2016-02-11T20:52:55.420 回答