有效计算R中的轧制行求和

时间:2013-10-30 15:19:40

标签: r rolling-computation

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

有关说明性示例,请考虑以下数据框:

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”。

有人可以帮助我们以一种我们可以扩展到大数据的方式优化此代码吗?

3 个答案:

答案 0 :(得分:4)

对于庞大的数据集,您应该使用package data.table。包动物园提供滚动方式,总和和应用的功能。

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>

答案 1 :(得分:1)

借用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))

答案 2 :(得分:1)

仅使用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