查找连续零的分布

Question

我有一个向量，比如x，它只包含整数0、1 和2。例如；

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

从中我想提取每个“模式”中出现多少次零。在这个简单的例子中，它自己出现了 3 次，两次出现在 00 中，恰好出现一次 000，所以我想输出如下内容：

0      3
00     2
000    1

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

Answer 1

1) rle 像这样使用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 次一零，2 次二零和 1 次三零。

如果运行时间很长，问题中的输出格式实际上并不可行，但只是为了好玩：

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) 所示。

注意

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

Answer 2

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

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

基准测试

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

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

您提到了一个“相当大”的数据集，因此您可以通过 Rcpp 使用 C++ 来加快速度（但是，基准测试显示基本 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

---

注意：

Mine 和 G 的函数返回一个“表格”样式的答案。 Akrun 已将其格式化为包含填充零，因此会产生少量成本。