Найдите распределение последовательных нулей

У меня есть вектор, скажем 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)

Ответ 1

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

Ответ 2

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).

Заметка

Я проверил скорость с length(x) 2000 года и (1) занял около 1,6 мс на моем ноутбуке и (2) занял около 9 мс.

Ответ 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

Замечания:

Функции Mine и G возвращают ответ "table" -style. Akrun отформатировал его, чтобы включить проложенные нули, так что понесут небольшую стоимость.