Conta quanti valori consecutivi sono veri

Ho un valore orario. Voglio contare quante ore consecutive il valore è stato zero dall’ultima volta che non era zero. Questo è un lavoro facile per un foglio di calcolo o per un ciclo, ma spero in un one-liner con vettorializzazione scattante per svolgere il compito.

x <- c(1, 0, 1, 0, 0, 0, 1, 1, 0, 0) df <- data.frame(x, zcount = NA) df$zcount[1] <- ifelse(df$x[1] == 0, 1, 0) for(i in 2:nrow(df)) df$zcount[i] <- ifelse(df$x[i] == 0, df$zcount[i - 1] + 1, 0) 

Output desiderato:

 R> df x zcount 1 1 0 2 0 1 3 1 0 4 0 1 5 0 2 6 0 3 7 1 0 8 1 0 9 0 1 10 0 2 

Ecco un modo, rle sull’approccio di Joshua: (MODIFICATO per usare seq_len e lapply come lapply da Marek)

 > (!x) * unlist(lapply(rle(x)$lengths, seq_len)) [1] 0 1 0 1 2 3 0 0 1 2 

AGGIORNAMENTO Solo per i calci, ecco un altro modo per farlo, circa 5 volte più veloce:

 cumul_zeros < - function(x) { x <- !x rl <- rle(x) len <- rl$lengths v <- rl$values cumLen <- cumsum(len) z <- x # replace the 0 at the end of each zero-block in z by the # negative of the length of the preceding 1-block.... iDrops <- c(0, diff(v)) < 0 z[ cumLen[ iDrops ] ] <- -len[ c(iDrops[-1],FALSE) ] # ... to ensure that the cumsum below does the right thing. # We zap the cumsum with x so only the cumsums for the 1-blocks survive: x*cumsum(z) } 

Prova un esempio:

 > cumul_zeros(c(1,1,1,0,0,0,0,0,1,1,1,0,0,1,1)) [1] 0 0 0 1 2 3 4 5 0 0 0 1 2 0 0 

Ora confronta i tempi su un vettore di milioni di lunghezza:

 > x < - sample(0:1, 1000000,T) > system.time( z < - cumul_zeros(x)) user system elapsed 0.15 0.00 0.14 > system.time( z < - (!x) * unlist( lapply( rle(x)$lengths, seq_len))) user system elapsed 0.75 0.00 0.75 

Morale della trama: gli one-liner sono più belli e più facili da capire, ma non sempre il più veloce!

I post di William Dunlap su R-help sono il posto dove cercare tutto ciò che riguarda le tirature. La sua f7 da questo post è

 f7 < - function(x){ tmp<-cumsum(x);tmp-cummax((!x)*tmp)} 

e nella situazione attuale f7(!x) . In termini di prestazioni c'è

 > x < - sample(0:1, 1000000, TRUE) > system.time(res7 < - f7(!x)) user system elapsed 0.076 0.000 0.077 > system.time(res0 < - cumul_zeros(x)) user system elapsed 0.345 0.003 0.349 > identical(res7, res0) [1] TRUE 

“contiamo quante ore consecutive il valore è stato zero dall’ultima volta che non era zero”, ma non nel formato del “risultato desiderato”.

Notare le lunghezze per gli elementi in cui i valori corrispondenti sono zero:

 rle(x) # Run Length Encoding # lengths: int [1:6] 1 1 1 3 2 2 # values : num [1:6] 1 0 1 0 1 0 

One-liner, non esattamente super elegante:

 x < - c(1, 0, 1, 0, 0, 0, 1, 1, 0, 0) unlist(lapply(split(x, c(0, cumsum(abs(diff(!x == 0))))), function(x) (x[1] == 0) * seq(length(x))))