r - 在 R 中，如何将时间戳间隔数据拆分为常规插槽？

Question

我正在处理描述具有开始和结束时间的事件的数据。例如，它可以是以下形式:



我想将此数据转换为一种形式，以便我可以定期计算事件的发生次数，以便能够回答来自 13:15:00 发生了多少事件的问题。至 13:29:59和 13:30:00至 13:45:00等等。在上面的例子中，第二条记录可以简单地使用开始时间计算在第一个槽中，但不会在第二个规则间隔内被计算为“正在进行”，即使在结束时间被积分时也是如此。

为了以 15 分钟的间隔工作，我想出了一个笨拙的解决方案，它使用 tidyr::uncount将数据集“扩展”到 24*4=96在 24 小时内以 15 分钟为间隔，然后过滤指定间隔内的那些。

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

您也可以将每个 start_time 视为添加一个事件事件，将每个 end_time 视为将事件事件减少一个来解决此问题。这种方法可以让您识别任何给定时刻的事件事件，并且可以很好地扩展。 (我使用了类似的东西来计算数百万个事件，它基本上是即时的。)

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

然后可以直接绘制这些计数，或过滤输出数据框以查看它们。在这种情况下，事件 id 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)