vectorize cumsum per factor in R

Question

Sto provando a creare una colonna in un frame di dati molto grande (~ 2,2 milioni di righe) che calcola la somma cumulativa di 1 per ciascun livello di fattore e si ripristina quando viene raggiunto un nuovo livello di fattore. Di seguito sono riportati alcuni dati di base che assomigliano al mio.

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) 

vorrei che la variabile di uscita, cum.goodp, per assomigliare a questo:

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

Capisco che c'è un sacco là fuori utilizzando l'approccio canonico split-apply-combine, che , concettualmente è intuitivo, ma ho provato ad utilizzare il seguente:

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

Quando provo a eseguire questo codice è molto molto lento. Ho capito che la trasformazione è parte del motivo per cui (il "da" non aiuta neanche). Ci sono oltre 70K diversi valori per la variabile codice articolo, quindi dovrebbe essere probabilmente vettorizzato. C'è un modo per vettorializzare questo, usando cumsum? In caso contrario, qualsiasi aiuto sarebbe veramente apprezzato. Grazie mille.

Answer 1

Con l'esempio modificato di input/output è possibile utilizzare il seguente approccio di base R (tra gli altri):

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 

Nota: ho aggiunto la colonna cum.goodp all'ingresso df e creato una nuova colonna cum.goodpX in modo da poter facilmente confrontare i due.

Ma ovviamente è possibile utilizzare molti altri approcci con i pacchetti, sia suggerito da @MartinMorgan che, ad esempio, utilizzando dplyr o data.table, per citare solo due opzioni. Questi possono essere molto più veloci degli approcci di R di base per insiemi di dati di grandi dimensioni.

Ecco come sarebbe stato fatto in dplyr:

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

Un'opzione data.table era già prevista nei commenti alla tua domanda.

Answer 2

Un approccio di base R consiste nel calcolare l'abbondanza sull'intero vettore e acquisire la geometria delle sotto-liste utilizzando la codifica della lunghezza di esecuzione. Capire l'inizio di ciascun gruppo, e creare nuovi gruppi

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

riassumere questi come codifica run-length, e calcolare la somma complessiva

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

Quindi utilizzare la geometria per ottenere l'offset che ciascun somma incorporato deve essere corretto da

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

e calcolare il valore aggiornato

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

Ecco una funzione

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

Ecco il risultato applicato ai dati campione

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

ed è prestazioni

> 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 

La soluzione dplyr dura circa 70s.

soluzione @alexis_laz è elegante e 2 volte più veloce del mio

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