Оптимизация производительности для поиска диапазонов в tibble / data.frame

Question

У меня есть следующий набор данных (в действительности более 30 000 строк):

dt <- tibble::tibble(x=seq.Date(as.Date("2019-01-01"), as.Date("2019-01-10"), "days"), y=c(1,2,3,2,1,1,3,1,2,1))

A tibble: 10 x 2
   x              y
   <date>     <dbl>
 1 2019-01-01     1
 2 2019-01-02     2
 3 2019-01-03     3
 4 2019-01-04     2
 5 2019-01-05     1
 6 2019-01-06     1
 7 2019-01-07     3
 8 2019-01-08     1
 9 2019-01-09     2
10 2019-01-10     1

Я бы хотел определить диапазоны дат выше заданного порогового значения, например, y> = 2. Первая дата появления диапазона должна быть сохранена в отдельном столбце как «начало», а последняя дата появления как « конец". Каждая комбинация «начало» / «конец» должна быть сохранена в отдельной строке. Диапазоны отделены друг от друга значениями y, которые ниже порогового значения (например, y <2). Результат должен выглядеть следующим образом: </p>

result <- tibble::tibble(start=as.Date(c("2019-01-02", "2019-01-07", "2019-01-09")), end=as.Date(c("2019-01-04", "2019-01-07", "2019-01-09")))

A tibble: 3 x 2
   start      end       
   <date>     <date>    
 1 2019-01-02 2019-01-04
 2 2019-01-07 2019-01-07
 3 2019-01-09 2019-01-09

Мое текущее решение использует циклы for. Однако это приводит к очень медленному выполнению.

Есть идеи, как улучшить производительность и решить эту проблему более элегантно?

Спасибо за ваши идеи заранее.

Answer 1

Вот функция, которая идентифицирует группы последовательных значений вектора, характеризующего условие

f = function(x, min) {
    ## 'run length encoding' of values satisfying the condition
    r = rle(x > min)
    ## replace TRUE values with a grouping variable; FALSE values are coerced to 0
    ## (probably better to also replace r$values[!r$values] = NA)
    r$values[r$values] = seq_len(sum(r$values))
    ## expand the modified run length encoding to the shape of the original vector
    inverse.rle(r)
}

Для ваших данных у нас есть

> mutate(dt, grp = f(y, 1))
# A tibble: 10 x 3
   x              y   grp
   <date>     <dbl> <int>
 1 2019-01-01     1     0
 2 2019-01-02     2     1
 3 2019-01-03     3     1
 4 2019-01-04     2     1
 5 2019-01-05     1     0
 6 2019-01-06     1     0
 7 2019-01-07     3     2
 8 2019-01-08     1     0
 9 2019-01-09     2     3
10 2019-01-10     1     0

, и мы можем затем использовать стандартные операции dplyr

mutate(dt, grp = f(y, 1)) %>% 
    filter(grp != 0) %>% 
    group_by(grp) %>% 
    summarize(start = min(x), end = max(x), n = n())

с выводом

# A tibble: 3 x 4
    grp start      end            n
  <int> <date>     <date>     <int>
1     1 2019-01-02 2019-01-04     3
2     2 2019-01-07 2019-01-07     1
3     3 2019-01-09 2019-01-09     1

Answer 2

Это должно сработать и основано на идее, что разница дат минус 1 будет иметь кумулятивную сумму, равную друг другу. Вот почему мы можем группировать по нему.

dt%>%
  filter(y >= 2)%>%
  group_by(grouping = cumsum(c(0, diff.Date(x) - 1)))%>%
  summarize(start = min(x)
            , end = max(x))%>%
  select(-grouping)

# A tibble: 3 x 2
  start      end       
  <date>     <date>    
1 2019-01-02 2019-01-04
2 2019-01-07 2019-01-07
3 2019-01-09 2019-01-09