Как суммировать временные интервалы по дням: сколько интервалов включает определенный день?

Question

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

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

Пример данных:

require(tidyverse)
require(lubridate)

x <- tribble(~start, ~end,
        today()-5, today()-3,
        today()-4, today()-2,
        today()-3, today()-1)


x <- x %>% mutate(dtint = interval(start, end))
x
#> # A tibble: 3 x 3
#>   start      end        dtint                         
#>   <date>     <date>     <Interval>                    
#> 1 2019-10-13 2019-10-15 2019-10-13 UTC--2019-10-15 UTC
#> 2 2019-10-14 2019-10-16 2019-10-14 UTC--2019-10-16 UTC
#> 3 2019-10-15 2019-10-17 2019-10-15 UTC--2019-10-17 UTC

mydays <- seq(min(x$start), max(x$end), by = "day") %>% enframe(name = NULL, value = "eachday")
mydays
#> # A tibble: 5 x 1
#>   eachday   
#>   <date>    
#> 1 2019-10-13
#> 2 2019-10-14
#> 3 2019-10-15
#> 4 2019-10-16
#> 5 2019-10-17

#Expected result:
mydays %>% add_column(expected_result = c(1, 2, 3, 2, 1))
#> # A tibble: 5 x 2
#>   eachday    expected_result
#>   <date>               <dbl>
#> 1 2019-10-13               1
#> 2 2019-10-14               2
#> 3 2019-10-15               3
#> 4 2019-10-16               2
#> 5 2019-10-17               1

^{Создано в 2019-10-18 с помощью пакета представить (v0.3.0)}

Мне также понадобится возможность сделать это на сгруппированных столбцах, чтобы можно было вычислять такие вещи, как итоги по демографическим свойствам.

Есть ли эффективный способ сделать это в tidyverse / lubridate?

Answer 1

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

# Example data
library(tidyverse)
set.seed(42)
x <- tibble(demographic = sample(LETTERS[1:3], 100, replace = T),
            start = as.Date("2019-01-01") + runif(100, 0, 30),
            end = start + runif(100, 1, 50))
## A tibble: 6 x 3
#  demographic start      end       
#  <chr>       <date>     <date>    
#1 C           2019-01-19 2019-03-05
#2 C           2019-01-07 2019-02-02
#3 A           2019-01-07 2019-02-19
#4 C           2019-01-12 2019-02-04
#5 B           2019-01-29 2019-02-07
#6 B           2019-01-29 2019-02-21

Сначала мы приведем его в длинный формат. Затем посчитайте каждую начальную дату как увеличивающуюся, каждую конечную дату увеличивающуюся вниз. Затем мы группируем по демографическим показателям и берем суммарную сумму этих приращений вверх и вниз.

x %>%
  pivot_longer(-demographic, "col", values_to = "date") %>%
  mutate(change = if_else(col == "start", 1, -1)) %>%
  arrange(demographic, date) %>%
  group_by(demographic) %>%
  mutate(count = cumsum(change)) %>%
  ungroup() %>%

  ggplot(aes(date, count, color = demographic)) +
  geom_step()

Answer 2

Один параметр, включающий dplyr, tidyr и lubridate, может быть:

x %>%
 mutate(eachday = list(seq.Date(min(start), max(end), by = "1 day"))) %>%
 unnest(eachday) %>%
 group_by(eachday) %>%
 summarise(overlap = sum(int_overlaps(dtint, interval(eachday, eachday))))

  eachday    overlap
  <date>       <int>
1 2019-10-13       1
2 2019-10-14       2
3 2019-10-15       3
4 2019-10-16       2
5 2019-10-17       1

Сначала он создает список дат между первой и последней датой в данных и удаляет их. Затем он группирует по датам и суммирует перекрытие между интервалом dtint и интервалом для дат.

Answer 3

Вот вариант с data.table. Преобразуйте «data.frame» в «data.table» (setDT 0, создайте столбец seq из min из «start» и max из «end», затем объедините с исходным набором данных, используяне равное объединение и получить счет (.N)

library(data.table)
setDT(x)[x[, .(eachday = seq(min(start), max(end), by = '1 day'))],
        .(eachday, overlap = .N), on = .(start <= eachday,
            end >= eachday ), by = .EACHI][, .(eachday, overlap)]
#       eachday overlap
#1: 2019-10-13       1
#2: 2019-10-14       2
#3: 2019-10-15       3
#4: 2019-10-16       2
#5: 2019-10-17       1