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

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

Пожалуйста, редактировать ваш вопрос, чтобы показать код, который у вас есть. Вы должны включить хотя бы схему (но желательно минимальный воспроизводимый пример) кода, с которым у вас возникли проблемы, тогда мы постараемся помочь с конкретной проблемой. Вам также следует прочитать Как спросить.

Toby Speight 02.05.2018 12:41

@TobySpeight На этот вопрос был дан ответ и помечен как ответ довольно давно, так что я не совсем понимаю смысл этого комментария?

Robert Long 03.05.2018 09:41
14
2
921
3
Перейти к ответу Данный вопрос помечен как решенный

Ответы 3

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 мс.

Добавили новый раздел (2) с другим подходом.

G. Grothendieck 11.04.2018 13:09
Ответ принят как подходящий

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 

Метод двойного tabulate удивляет / впечатляет.

SymbolixAU 11.04.2018 23:52

Вы упоминаете «довольно большой» набор данных, поэтому вы можете использовать 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 возвращают "табличный" ответ. Акрун отформатировал его, чтобы включить заполненные нули, так что это потребует небольших затрат.

Другие вопросы по теме