Une façon plus élégante de retourner une séquence de nombres basée sur des booléens?

Question

Voici un échantillon de booléens je dans le cadre d'un data.frame:

atest <- c(FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE)

Je veux retourner une séquence de nombres commençant à 1 de chaque FAUX et une augmentation de 1 jusqu'à la prochaine FAUX.

Le résultat vecteur souhaité est:

[1] 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 

Voici le code qui accomplit, mais je suis sûr qu'il ya une plus simple ou plus élégante façon de le faire dans l'affaire R. Je suis toujours essayer d'apprendre coder les choses plus efficacement dans R plutôt que simplement faire le travail.

result <- c() 
x <- 1 
for(i in 1:length(atest)){ 
    if(atest[i] == FALSE){ 
     result[i] <- 1 
     x <- 1 
    } 
    if(atest[i] != FALSE){ 
     x <- x+1 
     result[i] <- x 
    } 
} 

Answer 1

est ici une façon de le faire, en utilisant des fonctions de base à portée de main (mais pas largement connues/utilisées):

> sequence(tabulate(cumsum(!atest))) 
[1] 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 

Pour le briser:

> # return/repeat integer for each FALSE 
> cumsum(!atest) 
[1] 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 
> # count the number of occurrences of each integer 
> tabulate(cumsum(!atest)) 
[1] 10 10 1 
> # create concatenated seq_len for each integer 
> sequence(tabulate(cumsum(!atest))) 
[1] 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 

Answer 2

Voici une autre approche utilisant d'autres fonctions connues:

seq_along(atest) - cummax(seq_along(atest) * !atest) + 1L 

Parce qu'il est tout vectorisé, il est nettement plus rapide que la solution de @ Joshua (si la vitesse est de toute préoccupation):

f0 <- function(x) sequence(tabulate(cumsum(!x))) 
f1 <- function(x) {i <- seq_along(x); i - cummax(i * !x) + 1L} 
x <- rep(atest, 10000) 

library(microbenchmark) 
microbenchmark(f0(x), f1(x)) 
# Unit: milliseconds 
# expr  min  lq median  uq  max neval 
# f0(x) 19.386581 21.853194 24.511783 26.703705 57.20482 100 
# f1(x) 3.518581 3.976605 5.962534 7.763618 35.95388 100 

identical(f0(x), f1(x)) 
# [1] TRUE 

Answer 3

Des problèmes tels que ceux-ci ont tendance à travailler bien avec Rcpp. code d'emprunt @ flodel en tant que cadre pour l'analyse comparative,

boolseq.cpp 
----------- 

#include <Rcpp.h> 
using namespace Rcpp; 

// [[Rcpp::export]] 
IntegerVector boolSeq(LogicalVector x) { 
    int n = x.length(); 
    IntegerVector output = no_init(n); 
    int counter = 1; 
    for (int i=0; i < n; ++i) { 
    if (!x[i]) { 
     counter = 1; 
    } 
    output[i] = counter; 
    ++counter; 
    } 
    return output; 
} 

/*** R 
x <- c(FALSE, sample(c(FALSE, TRUE), 1E5, TRUE)) 

f0 <- function(x) sequence(tabulate(cumsum(!x))) 
f1 <- function(x) {i <- seq_along(x); i - cummax(i * !x) + 1L} 

library(microbenchmark) 
microbenchmark(f0(x), f1(x), boolSeq(x), times=100) 

stopifnot(identical(f0(x), f1(x))) 
stopifnot(identical(f1(x), boolSeq(x))) 
*/ 

sourceCpp ing il me donne:

Unit: microseconds 
     expr  min  lq  median   uq  max neval 
     f0(x) 18174.348 22163.383 24109.5820 29668.1150 78144.411 100 
     f1(x) 1498.871 1603.552 2251.3610 2392.1670 2682.078 100 
boolSeq(x) 388.288 426.034 518.2875 571.4235 699.710 100 

moins élégant, mais diablement à ce que vous écrivez avec le code R.