有效地计算 R 中的滚动行总和答案

【问题标题】：Efficiently calculating rolling row summation in R有效地计算 R 中的滚动行总和
【发布时间】：2013-11-10 07:02:56
【问题描述】：

我需要计算数据框中涉及条件的列的滚动行总和。我拥有的数据对“sku”有多个观察结果。我想要的是为“sku”的每个值计算 5 个连续行的总和。如果我达到一个阶段，我没有对“sku”进行 5 次连续观察，我们将总结该相应值的剩余行观察结果。

作为一个说明性示例，请考虑以下数据框：

data <- structure(list(sku = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
                           2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
                           3L, 3L, 3L, 3L), tf = c(50.79, 46.39, 47.85, 45.79, 44.46, 49.99, 
                                                   46.12, 44.4, 41.21, 53.7, 53.9, 44.91, 59.64, 41.96, 52.26, 43.48, 
                                                   46.93, 51.2, 54.31, 42.5, 47.2, 57.54, 63.23, 48.98, 52.38, 59.9, 
                                                   53.01, 50.35, 41.86, 46.42)), .Names = c("sku", "tf"), row.names = c(NA, 
                                                  -30L), class = "data.frame")

在这个数据框中，我们要为每个“sku”值的 5 个滚动值求和变量“tf”。

我们已经能够使用以下代码实现这一点：

data[,c("day_5")]<-unlist(mapply(function(y){
end1<-(which(data$sku==unique(data$sku)[y]))[length(which(data$sku==unique(data$sku)[y]))]  
start<-(which(data$sku==unique(data$sku)[y]))[1]
d<-data$tf[start:end1]
r<-mapply(function(x){if (x+4 <= length(d)) {sum(d[x:(x+4)])} else {sum(d[x:length(d)])}},1:length(d))
},1:length(unique(data$sku))))

“day_5”列准确地为我们提供了我们想要的结果，但这种方法效率非常低，因为我们必须对具有数千个“sku”值的数百万行数据运行此操作。

有人可以帮助我们优化这段代码，让我们可以将其扩展到大数据吗？

【问题讨论】：

zoo 包有很多滚动功能，包括rollsum

标签： r rolling-computation

【解决方案1】：

对于庞大的数据集，您应该使用包 data.table。包 zoo 提供滚动均值、求和和应用的功能。

library(data.table)
DT <- data.table(data)

library(zoo)
fun <- function(x, i) {
  x <- c(x, rep(0, i-1))
  rollsumr(x, k=i)
}

DT[, day_5a:=fun(tf,5), by=sku]
print(DT)

#     sku    tf  day_5 day_5a
# 1:    1 50.79 235.28 235.28
# 2:    1 46.39 234.48 234.48
# 3:    1 47.85 234.21 234.21
# 4:    1 45.79 230.76 230.76
# 5:    1 44.46 226.18 226.18
# 6:    1 49.99 181.72 181.72
# 7:    1 46.12 131.73 131.73
# 8:    1 44.40  85.61  85.61
# 9:    1 41.21  41.21  41.21
# 10:   2 53.70 254.11 254.11
# 11:   2 53.90 252.67 252.67
#<snip>

【讨论】：

【解决方案2】：

借用 Ronald 的函数，一个更简单的方法可能是使用：

fun <- function(x, i) {
  x <- c(x, rep(0, i-1))
  rollsumr(x, k=i)
}
data$day_5_a <- ave(data$tf, data$sku, FUN= function(x) fun(x, 5))

【讨论】：

我不认为ave 更简单。但是，如果有数百万个观测值和数千个组，它会慢得多。

【解决方案3】：

仅使用base（显然比data.table效率低且优雅）：

data_ls <- split(data, data$sku)

res <- lapply(data_ls, 
           function(z) sapply(1:length(z$tf), 
               function(vec, x) { sum(vec[x:(x+4)], na.rm = T) }, 
                 vec = z$tf))

data$day_5 <- unlist(res)

#> data
#   sku    tf  day_5
#1    1 50.79 235.28
#2    1 46.39 234.48
#3    1 47.85 234.21
#4    1 45.79 230.76
#5    1 44.46 226.18
#6    1 49.99 181.72
#7    1 46.12 131.73
#8    1 44.40  85.61
#9    1 41.21  41.21
#10   2 53.70 254.11
#11   2 53.90 252.67
#12   2 44.91 242.25

【讨论】：

请不要使用两个嵌套循环。如果你想留在基地，这里有可能与ave或tapply等功能结合使用：fun <- function(x, i) rev(na.omit(filter(c(rep(0,i-1),rev(x)),rep(1,i),sides=1)))
@Roland：嗯，很好！谢谢！我想你应该编辑你的答案添加一个base 替代方法，我会删除这种方法，而不是使用你的函数编辑它。
我认为您不应该为此使用 base。问题标题要求效率，我认为您无法击败 data.table。
@Roland：我在filter 中挖了一点，最后找到了filter.c。我当然不知道发生了什么，但fors 引起了我的注意。 filter loop 也像吗？如果是这样，它是否比lapplys 更有效？但是，如果我错过了一些明显的东西，请原谅我的无知；我只是好奇。
严格来说是的，但这是一种特殊情况，因为您向它传递了一个 R 函数，这使得它类似于 for 循环（也是用 C 实现的）。 R中的循环非常快。内部发生的事情（例如，对 R 函数的重复评估）很慢。向量化函数不计算 R 函数。