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

Question

Voici un exemple de booléens que j'ai inclus dans 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 souhaite renvoyer une séquence de nombres commençant à 1 à partir de chaque FALSE et augmentant de 1 jusqu'au prochain FALSE.

Le vecteur désiré qui en résulte est le suivant :

[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 permet d'y parvenir, mais je suis sûr qu'il existe un moyen plus simple ou plus élégant de le faire en R. J'essaie toujours d'apprendre à coder les choses plus efficacement en R plutôt que de me contenter de 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

Voici une façon de le faire, en utilisant des fonctions de base pratiques (mais peu 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 résumer :

> # 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 familières :

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

Comme tout est vectorisé, cette solution est nettement plus rapide que celle de @Joshua (si la vitesse est importante) :

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

Les problèmes de ce type ont tendance à bien fonctionner avec Rcpp . Emprunt du code de @flodel comme cadre de référence,

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 Il s'agit d'un outil de travail qui me permet d'avoir une vue d'ensemble de la situation :

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 assez proche de ce que vous écriviez avec le code R.