查找连续零的分布

Question

我有一个向量,说x只包含整数0,1和2.例如;

x <- c(0,1,0,2,0,0,1,0,0,1,0,0,0,1,0)

由此我想提取每个"模式"中出现零次的次数.在这个简单的例子中,它自己出现三次,两次00和一次出现000,所以我想输出如下内容:

0      3
00     2
000    1

我的实际数据集非常大(向量中1000-2000个元素),至少理论上连续零的最大数量是 length(x)

Answer 1

1)使用rle和table喜欢这样.不需要包裹.

tab <- with(rle(x), table(lengths[values == 0]))

赠送:

> tab
1 2 3 
3 2 1 

要么

> as.data.frame(tab)
  Var1 Freq
1    1    3
2    2    2
3    3    1

也就是说,有3次运行,一次零,两次运行两次零,一次运行三次零.

如果有很长的运行时问题中的输出格式是不可行的,但这里只是为了好玩它:

data.frame(Sequence = strrep(0, names(tab)), Freq = as.numeric(tab))

赠送:

  Sequence Freq
1        0    3
2       00    2
3      000    1

2)gregexpr另一种可能性是使用正则表达式:

tab2 <- table(attr(gregexpr("0+", paste(x, collapse = ""))[[1]], "match.length"))

赠送:

> tab2
1 2 3 
3 2 1 

其他输出格式可以如(1)中那样导出.

注意

我检查了length(x)2000 的速度和(1)在我的笔记本电脑上花了大约1.6毫秒,(2)花了大约9毫秒.

Answer 2

1)我们可以使用rleid从data.table

data.table(x)[, strrep(0, sum(x==0)) ,rleid(x == 0)][V1 != "",.N , V1]
#    V1 N
#1:   0 3
#2:  00 2
#3: 000 1

2)或者我们可以使用tidyverse

library(tidyverse)
tibble(x) %>%
    group_by(grp = cumsum(x != 0)) %>% 
    filter(x == 0)  %>% 
    count(grp) %>% 
    ungroup %>% 
    count(n)
# A tibble: 3 x 2
#     n    nn
#   <int> <int>
#1     1     3
#2     2     2
#3     3     1

3) 或者我们可以使用tabulate与rleid

tabulate(tabulate(rleid(x)[x==0]))
#[1] 3 2 1

基准

通过检查system.time@ SymbolixAU的数据集

system.time({
  tabulate(tabulate(rleid(x2)[x2==0]))
 })
#  user  system elapsed 
#  0.03    0.00    0.03 

与Rcpp功能相比,上面并没有那么糟糕

 system.time({
  m <- zeroPattern(x2)
  m[m[,2] > 0, ]
})
#   user  system elapsed 
#   0.01    0.01    0.03 

使用microbenchmark,删除消耗更多时间的方法(基于@ SymbolixAU的比较)并启动新的比较.请注意,这里也不是苹果到苹果,但它仍然比以前的比较更加相似,data.table有一些开销以及一些格式来复制OP的预期输出

microbenchmark(
    akrun = {
        tabulate(tabulate(rleid(x2)[x2==0]))
    },
    G = {
        with(rle(x2), table(lengths[values == 0]))
    },
    sym = {
        m <- zeroPattern(x2)
        m[m[,2] > 0, ]
    },
    times = 5, unit = "relative"
)
#Unit: relative
#  expr      min       lq     mean   median       uq      max neval cld
# akrun 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000     5  a 
#     G 6.049181 8.272782 5.353175 8.106543 7.527412 2.905924     5   b
#   sym 1.385976 1.338845 1.661294 1.399635 3.845435 1.211131     5  a 

Answer 3

你提到了一个"非常大"的数据集,所以你可以利用C++来Rcpp提高速度(但是,基准测试表明基础rle解决方案相当快)

功能可以是

library(Rcpp)

cppFunction('Rcpp::NumericMatrix zeroPattern(Rcpp::NumericVector x) {
  int consecutive_counter = 0;
  Rcpp::IntegerVector iv = seq(1, x.length());

  Rcpp::NumericMatrix m(x.length(), 2);  
  m(_, 0) = iv;

  for (int i = 0; i < x.length(); i++) {
    if (x[i] == 0) {
      consecutive_counter++;
    } else if (consecutive_counter > 0) {
      m(consecutive_counter-1, 1)++;
      consecutive_counter = 0;
    }
  }
  if (consecutive_counter > 0) {
    m(consecutive_counter-1, 1)++;
  }

  return m;
}')

这为您提供了连续零的计数矩阵

x <- c(0,1,0,2,0,0,1,0,0,1,0,0,0,1,0)

zeroPattern(x)
m <- zeroPattern(x)
m[m[,2] > 0, ]
#      [,1] [,2]
# [1,]    1    3
# [2,]    2    2
# [3,]    3    1  

在更大的数据集上,我们注意到速度的提高

set.seed(20180411)
x2 <- sample(x, 1e6, replace = T)

m <- zeroPattern(x2)
m[m[,2] > 0, ]

library(microbenchmark)
library(data.table)
microbenchmark(
    akrun = {
        data.table(x2)[, strrep(0, sum(x2==0)) ,rleid(x2 == 0)][V1 != "",.N , V1]
    },
    G = {
        with(rle(x2), table(lengths[values == 0]))
    },
    sym = {
        m <- zeroPattern(x2)
        m[m[,2] > 0, ]
    },
    times = 5
)

# Unit: milliseconds
#  expr        min         lq      mean    median        uq       max neval
# akrun 3727.66899 3782.19933 3920.9151 3887.6663 4048.2275 4158.8132     5
#     G  236.69043  237.32251  258.4320  246.1470  252.1043  319.8956     5
#   sym   97.54988   98.76986  190.3309  225.2611  237.5781  292.4955     5

注意:

我和G的功能正在回归"桌子式"答案.Akrun已将其格式化为包含填充零,因此会产生轻微的成本.