2013-07-23 66 views
11

這裏是布爾的樣品我有一個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開始的數字序列,直到下一個假加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 
    } 
} 
+1

在for循環中重新分配(「增長」)一個對象對於R來說是一個很大的禁忌。它關於你能做的最慢的事情。 –

+0

我知道我嘗試了一個sapply,但只是想獲得基本的邏輯。您的解決方案正是我一直在尋找的。 – tcash21

回答

19

下面是做到這一點的一種方式,用好用(但不廣爲人知/使用)的基礎功能:

> 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 
+1

我已經+1了,但我會再次做,因爲解釋真的很有幫助! – Thomas

+2

@Joshua Ulrich +1爲這個偉大的解決方案;但如果第一個元素不是'FALSE',它就會失敗:'sequence(tabulate(cumsum(!atest [-1])))' – sgibb

+1

@sgibb:在我回答之前,我沒有嘗試OP的代碼,但我看到如果第一個元素不是'FALSE',它將從2開始第一個序列。這似乎與他們的文本不一致,「我想從每個FALSE開始以1開始返回一個數字序列,並增加1,直到下一個FALSE。」 –

5

這裏是另一個使用其他熟悉功能的方法:

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 
+1

+1稍微更神祕,但一個不錯的加速! –

2

像這些問題往往與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荷蘭國際集團它給了我:

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代碼編寫。

+0

+1炫耀! :-P –