Cuenta cuántos valores consecutivos son verdaderos

Question

Tengo un valor por hora. Quiero contar cuántas horas consecutivas el valor ha sido cero desde la última vez que no fue cero. Este es un trabajo fácil para una hoja de cálculo o para un bucle, pero estoy esperando un snappy vectorizado de una sola línea para completar la tarea.

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) 

salida deseada:

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 

Answer 1

Aquí está una manera, basándose en el enfoque de Joshua rle: (EDITADO para usar seq_len y lapply según la sugerencia de Marek)

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

ACTUALIZACIÓN. Sólo por diversión, aquí hay otra manera de hacerlo, en torno a 5 veces más rápido:

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

probar un ejemplo:

> 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 

Ahora los tiempos Compara en un vector millones de longitud:

> 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 

Moraleja de la historia: las frases ingeniosas son más agradables y fáciles de entender, ¡pero no siempre las más rápidas!

Answer 2

rle se "cuente cuántas horas consecutivas el valor ha sido cero desde la última vez que no es cero era", pero no en el formato de su "salida deseada ".

Nota las longitudes de los elementos en los que los valores correspondientes son cero:

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 

Answer 3

de una sola línea, no exactamente superelegant:

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

Answer 4

Las publicaciones de William Dunlap sobre R-help son el lugar para buscar todo lo relacionado con las longitudes de ejecución. Su f7 de this post es

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

y en la situación actual f7(!x). En términos de rendimiento hay

> 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