Question

我有以下数据：

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

Answer 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]

对于解决方案波纹管，系统时间约为.59秒，而对于10.36，使用rollapplyr（但可能有可能使异常值去除效率更高）。

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

优化rollapplyr自定义功能

1 个答案: