효율적인 롤링 행 합계 계산 R

Question

조건이 포함 된 데이터 프레임에서 열의 롤링 행 합계를 계산해야합니다. 내가 가진 데이터에는 "sku"에 대한 여러 관찰이 있습니다. 내가 원하는 것은 "sku"의 모든 값에 대해 5 개의 연속적인 행의 합을 계산하는 것입니다. 나는 "sku"에 대해 5 번 연속 관측 할 수없는 단계에 이르렀을 때, 해당 값에 대한 나머지 행 관측치를 합산합니다. 우리가 각각 "SKU"값의 5 개 롤링 값을 변수 "TF"를 요약 할이 dataframe에서

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") 

: 예시적인 예

다음 데이터 프레임을 고려한다.

우리는 달성 할 수있었습니다 그 다음 코드를 사용 :

"day_5는"우리가 원하는 정확히 무엇을 우리에게 제공하지만, 우리가이 작업을 실행해야으로이 방법은 매우 비효율적 인 것으로 판명

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

열 수천 개의 "sku"값을 가진 수백만 행의 데이터

큰 데이터까지 확장 할 수있는 방식으로이 코드를 최적화하는 데 도움을 줄 수 있습니까?

Answer 1

거대한 데이터 세트의 경우 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> 

Answer 2

로널드에서 함수를 차입, 간단한 방법은 사용할 수 있습니다 :

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

Answer 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