В R, как я могу разбить данные интервала времени на обычные слоты?

Question

Я работаю с данными, описывающими события, имеющие время начала и окончания.Например, это может быть в форме:

Я хотел бы преобразовать эти данные в форму, где я мог бы подсчитать вхождения событийчерез равные промежутки времени, чтобы можно было ответить на вопрос, сколько событий происходило от 13:15:00 до 13:29:59 и 13:30:00 до 13:45:00 и так далее.В приведенном выше примере вторая запись может быть подсчитана в первом слоте просто с использованием времени начала, но не будет считаться «продолжающейся» во втором регулярном интервале, даже если время окончания было интегрировано.

Для работы с15-минутные интервалы Я нашел неуклюжее решение, которое использует tidyr::uncount, чтобы «расширить» набор данных до 24*4=96 15-минутных интервалов в течение 24-часового периода, а затем отфильтровать те, которые находятся внутри указанных интервалов.

library(tidyverse)
library(lubridate)
library(magrittr)

df1 <- tibble::tibble(
  id = c(1, 2),
  start_date = c(ymd_hms("2018-12-10 14:45:51", tz = "Australia/Brisbane"), 
                 ymd_hms("2018-12-10 13:29:37", tz = "Australia/Brisbane")),
  end_date = c(ymd_hms("2018-12-10 14:59:04", tz = "Australia/Brisbane"),
               ymd_hms("2018-12-10 14:02:37", tz = "Australia/Brisbane")))

df2 <- df1 %>% 
  mutate(episode = 96) %>% 
  tidyr::uncount(episode, .id = "sequence")

df2$int_start <- rep(
  seq(ymd_hms("2018-12-10 00:00:00", tz = "Australia/Brisbane"), 
      ymd_hms("2018-12-10 23:59:59", tz = "Australia/Brisbane"), 
      by = "15 mins"),
  2)

df2$int_end <- df2$int_start + 899

df2 %<>% 
  filter(int_end > start_date & int_start < end_date )

Это дает мне данные в нужном формате:

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

В Stata можно также использовать команду stsplit для выполнения чего-то подобного.Я пытался повозиться с survSplit из пакета survival, но также получилось много записей:

df1$status <- 1
df1$start_date <- as.numeric(df1$start_date)
df1$end_date <- as.numeric(df1$end_date)

df3 <- survSplit(Surv(end_date, status) ~., df1,
                 cut=seq(from=as.numeric(as.POSIXct("2018-12-10 00:00:00")), 
                         to=as.numeric(as.POSIXct("2018-12-10 00:00:00")) + 24*60*60, 
                         by=900), 
                 start = "start_int",
                 id="new_id",
                 episode ="episode")

df3$start_int <- as.POSIXct(df3$start_int, origin = "1970-01-01", tz = "Australia/Brisbane")
df3$start_date <- as.POSIXct(df3$start_date, origin = "1970-01-01", tz = "Australia/Brisbane")
df3$end_date <- as.POSIXct(df3$end_date, origin = "1970-01-01", tz = "Australia/Brisbane")

Есть какие-нибудь указатели на лучший способ решения такой задачи?

Answer 1

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

df2 <- df1 %>%
  gather(type, time, start_date:end_date) %>%
  mutate(event_chg = if_else(type == "start_date", 1, -1)) %>%
  arrange(time) %>%
  mutate(active_events = cumsum(event_chg))

df2
# A tibble: 4 x 5
#     id type       time                event_chg active_events
#  <dbl> <chr>      <dttm>                  <dbl>         <dbl>
#1     2 start_date 2018-12-10 13:29:37         1             1
#2     2 end_date   2018-12-10 14:02:37        -1             0
#3     1 start_date 2018-12-10 14:45:51         1             1
#4     1 end_date   2018-12-10 14:59:04        -1             0

ggplot(df2, aes(time, active_events)) + geom_step()

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

df2b <- df1 %>%
  gather(type, time, start_date:end_date) %>%
  mutate(event_chg = if_else(type == "start_date", 1, -1)) %>%
  #  NEW SECTION HERE
  bind_rows(data_frame(type = "marker",
               time = seq.POSIXt(ymd_h(2018121013, tz = "Australia/Brisbane"), 
                                 ymd_h(2018121016, tz = "Australia/Brisbane"), 
                                 by  = 15*60), # 15 minutes of seconds = 15*60
               event_chg = 0)) %>% 
  #  END OF NEW SECTION
  arrange(time) %>%
  mutate(active_events = cumsum(event_chg))

Тогда можно напрямую отобразить эти числа или отфильтровать кадр выходных данных, чтобы увидеть их. В этом случае событие с идентификатором 1 произошло полностью между двумя 15-минутными интервалами.

ggplot(df2b, aes(time, active_events, label = active_events)) + 
  geom_step() +
  geom_point(data = df2b %>% filter(type == "marker")) +
  geom_text(data = df2b %>% filter(type == "marker"), vjust = -0.5)