ブーリアンに基づいて一連の数値を返すよりエレガントな方法はありますか？

Question

は、ここで私は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)

私は数字のシーケンスが各FALSEから1から始まり、次のFALSEになるまで1ずつ増加返すようにしたいです。

結果として所望のベクターは、次のとおりです。

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

はここでこれを達成したコードですが、私はいつもどのように学ぶことをしようとしているR.でこれを行うには単純以上のエレガントな方法があります確信しています単純に仕事を終わらせるのではなく、Rで物事をより効率的にコーディングすることができます。

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

ここで便利な（しかし、使用/広く知られていない）ベースの機能を使用して、それを行うための一つの方法です：

> 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 

をそれを打破するには：ここで

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

は別です

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

それは、すべてのベクトル化されているので、速度が速くジョシュアのソリューション@よりも（速度は任意の懸念のある場合）：これらのような

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

問題がRcppでうまく動作する傾向があります。ベンチマークのためのフレームワークとして、借入の@ flodelのコード、

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の：

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 

あまりエレガントな、しかし、あなたはRコードを書いていたものにかなりくそ近いです。