Cuenta cuántos valores consecutivos son verdaderos

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 

Esta es una forma, basándose en el enfoque de Joshua: (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 

ACTUALIZAR . Solo por diversión, aquí hay otra forma de hacerlo, alrededor de 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) } 

Pruebe 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 compare los tiempos en un vector de un millón 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: los one-liners son más agradables y fáciles de entender, ¡pero no siempre los más rápidos!

Las publicaciones de William Dunlap sobre R-help son el lugar para buscar todo lo relacionado con longitudes de carrera. Su f7 de esta publicación 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 

rle “contará cuántas horas consecutivas el valor ha sido cero desde la última vez que no fue cero”, pero no en el formato de su “salida deseada”.

Tenga en cuenta las longitudes de los elementos donde 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 

One-liner, no exactamente súper 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))))