vectorize cumsum theo hệ số R

Question

Tôi đang cố gắng tạo cột trong một khung dữ liệu rất lớn (~ 2,2 triệu hàng) để tính tổng tích luỹ của 1 cho mỗi cấp độ nhân tố và đặt lại khi đạt đến mức hệ số mới. Dưới đây là một số dữ liệu cơ bản giống với dữ liệu của riêng tôi.

itemcode <- c('a1', 'a1', 'a1', 'a1', 'a1', 'a2', 'a2', 'a3', 'a4', 'a4', 'a5', 'a6', 'a6', 'a6', 'a6') 
goodp <- c(0, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1) 
df <- data.frame(itemcode, goodp) 

Tôi muốn biến đầu ra, cum.goodp, trông như thế này:

cum.goodp <- c(0, 1, 2, 0, 1, 1, 2, 0, 0, 1, 1, 1, 2, 0, 1) 

Tôi nhận được rằng có rất nhiều trên mạng bằng cách sử dụng split-áp-kết hợp phương pháp kinh điển, mà , khái niệm là trực quan, nhưng tôi đã thử sử dụng các mục sau:

k <- transform(df, cum.goodp = goodp*ave(goodp, c(0L, cumsum(diff(goodp != 0)), FUN = seq_along, by = itemcode))) 

Khi tôi cố gắng chạy mã này, nó rất chậm. Tôi nhận được sự biến đổi đó là một phần của lý do tại sao ('by' cũng không giúp được gì). Có hơn 70K giá trị khác nhau cho biến itemcode, vì vậy nó có thể được vectorized. Có cách nào để vectorize này, bằng cách sử dụng cumsum? Nếu không, bất kỳ sự giúp đỡ nào cũng sẽ được đánh giá cao. Cám ơn rất nhiều.

Answer 1

Với ví dụ sửa đổi đầu vào/đầu ra bạn có thể sử dụng phương pháp tiếp cận cơ sở sau đây R (số những người khác):

transform(df, cum.goodpX = ave(goodp, itemcode, cumsum(goodp == 0), FUN = cumsum)) 
# itemcode goodp cum.goodp cum.goodpX 
#1  a1  0   0   0 
#2  a1  1   1   1 
#3  a1  1   2   2 
#4  a1  0   0   0 
#5  a1  1   1   1 
#6  a2  1   1   1 
#7  a2  1   2   2 
#8  a3  0   0   0 
#9  a4  0   0   0 
#10  a4  1   1   1 
#11  a5  1   1   1 
#12  a6  1   1   1 
#13  a6  1   2   2 
#14  a6  0   0   0 
#15  a6  1   1   1 

Lưu ý: Tôi đã thêm cột cum.goodp vào đầu vào df và đã tạo một cột mới cum.goodpX để bạn có thể dễ dàng so sánh hai cột. Tuy nhiên, tất nhiên bạn có thể sử dụng nhiều cách tiếp cận khác với các gói, hoặc những gì @MartinMorgan đề xuất hoặc ví dụ bằng cách sử dụng dplyr hoặc data.table, để đặt tên chỉ là hai tùy chọn. Chúng có thể nhanh hơn rất nhiều so với phương pháp R cơ sở cho các tập dữ liệu lớn.

Sau đây là cách nó sẽ được thực hiện trong dplyr:

library(dplyr) 
df %>% 
    group_by(itemcode, grp = cumsum(goodp == 0)) %>% 
    mutate(cum.goodpX = cumsum(goodp)) 

Một lựa chọn data.table đã được cung cấp trong các ý kiến ​​cho câu hỏi của bạn.

Answer 2

Phương pháp R cơ sở là tính toán cumsum trên toàn bộ vectơ và chụp hình học của các danh sách con bằng cách sử dụng mã hóa độ dài chạy. Chỉ ra sự bắt đầu của mỗi nhóm, và tạo các nhóm mới

start <- c(TRUE, itemcode[-1] != itemcode[-length(itemcode)]) | !goodp 
f <- cumsum(start) 

Tóm tắt những như một mã chạy dài, và tính toán số tiền tổng

r <- rle(f) 
x <- cumsum(x) 

Sau đó sử dụng hình học để bù đắp rằng mỗi tổng nhúng cần phải được sửa chữa bởi

offset <- c(0, x[cumsum(r$lengths)]) 

và tính giá trị cập nhật

x - rep(offset[-length(offset)], r$lengths) 

Dưới đây là một chức năng

cumsumByGroup <- function(x, f) { 
    start <- c(TRUE, f[-1] != f[-length(f)]) | !x 
    r <- rle(cumsum(start)) 
    x <- cumsum(x) 
    offset <- c(0, x[cumsum(r$lengths)]) 
    x - rep(offset[-length(offset)], r$lengths) 
} 

Dưới đây là kết quả áp dụng cho các dữ liệu mẫu

> cumsumByGroup(goodp, itemcode) 
[1] 0 1 2 0 1 1 2 0 0 1 1 1 2 0 1 

và hiệu suất của nó

> n <- 1 + rpois(1000000, 1) 
> goodp <- sample(c(0, 1), sum(n), TRUE) 
> itemcode <- rep(seq_along(n), n) 
> system.time(cumsumByGroup(goodp, itemcode)) 
    user system elapsed 
    0.55 0.00 0.55 

Giải pháp dplyr mất khoảng 70s.

giải pháp @alexis_laz vừa thanh lịch và nhanh hơn 2 lần so với tôi

cumsumByGroup1 <- function(x, f) { 
    start <- c(TRUE, f[-1] != f[-length(f)]) | !x 
    cs = cumsum(x) 
    cs - cummax((cs - x) * start) 
}