R/tidyverse 中的包围时间间隔答案

【问题标题】：Bracketing time intervals in R/tidyverseR/tidyverse 中的包围时间间隔
【发布时间】：2020-10-27 12:18:03
【问题描述】：

我需要弄清楚一天中的时间间隔和预定的几小时之间有多少时间重叠。

这是示例数据

require(tidyverse)
example <- tibble::tribble(
  ~`"Session"`, ~`"SessionStartTime"`,   ~`"SessionEndTime"`, ~`"TotalDuration"`,
            1L, "2020-09-10 09:05:50", "2020-09-11 05:50:02",             1244.2,
            2L, "2020-09-10 23:55:20", "2020-09-11 01:20:20",                 85,
            3L, "2020-09-11 01:11:30", "2020-09-11 02:12:02",   60.5333333333333,
            4L, "2020-09-11 02:20:30", "2020-09-11 03:00:02",   39.5333333333333
  )

这是我正在寻找的输出：

output <- tibble::tribble(
  ~Session,   ~`00:00-03:00`, ~`03:00-06:00`, ~`06:00-09:00`, ~`09:00-12:00`, ~`12:00-15:00`, ~`15:00-18:00`, ~`18:00-21:00`,   ~`21:00-00:00`,
        1L,        "3 hours",   "2.82 hours",             NA,             NA,             NA,             NA,             NA, "2.902778 hours",
        2L, "1.338889 hours",             NA,             NA,             NA,             NA,             NA,             NA,  "4.666667 mins",
        3L,  "60.53333 mins",             NA,             NA,             NA,             NA,             NA,             NA,               NA,
        4L, "2.341667 hours",    "2 seconds",             NA,             NA,             NA,             NA,             NA,               NA
  )

我尝试过 lubridate::interval，但遇到了会话与多个括号重叠以及会话跨越数天的问题。我也尝试过 chron 但无法处理第二天 5:00 和前一天 23:00 之间的差异。

【问题讨论】：

标签： r tidyverse lubridate

【解决方案1】：

这里有一些可以尝试的方法 - 尽管我确信还有比这更好的方法。

您可以使用lubridate 中的intersect 和interval 创建一个函数，以识别3 小时间隔的时间重叠。在这种情况下，要强制选择的 3 小时间隔从午夜开始，您需要一个从开始到结束时间的新序列。

一旦可以从开始时间和结束时间确定重叠，您就可以对示例数据中的每一行使用mapply。由于可能涉及多天，您可以group_bysession 和seq 时间间隔并总结。最后的pivot_wider 会将数据放入您想要的宽格式。请注意，最终的持续时间以秒为单位。

library(tidyverse)
library(lubridate)    

get_intervals <- function(session, start, end) {
  seq3h <- seq.POSIXt(floor_date(start, unit = "day"), 
                      ceiling_date(end, unit = "day"), 
                      "3 hours")
  seq3h_int <- interval(seq3h[-length(seq3h)], seq3h[-1])
  data.frame(
    session,
    seq = sapply(seq3h_int, 
                 function(x) paste(hour(int_start(x)), hour(int_end(x)), sep = "_")),
    overlap = sapply(seq3h_int, 
                     intersect, 
                     interval(start = start, end = end))
  )
}

do.call(rbind, 
        mapply(get_intervals, 
               example$Session, 
               example$SessionStartTime, 
               example$SessionEndTime, 
               SIMPLIFY = FALSE)
        ) %>%
  group_by(session, seq) %>%
    summarise(overlap = sum(overlap, na.rm = TRUE)) %>%
    pivot_wider(id_cols = session, 
                names_from = seq, 
                values_from = overlap, 
                names_prefix = "T")

输出

  session  T0_3 T12_15 T15_18 T18_21 T21_0  T3_6  T6_9 T9_12
    <int> <dbl>  <dbl>  <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl>
1       1 10800  10800  10800  10800 10800 10202     0 10450
2       2  4820      0      0      0   280     0     0     0
3       3  3632      0      0      0     0     0     0     0
4       4  2370      0      0      0     0     2     0     0

【讨论】：