R / tidyverse中的包围时间间隔

如何解决R / tidyverse中的包围时间间隔

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

这是示例数据

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`,"3 hours","2.82 hours",NA,"2.902778 hours","1.338889 hours","4.666667 mins","60.53333 mins","2.341667 hours","2 seconds",NA
  )

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

解决方法

这里是可以尝试的方法-尽管我敢肯定还有比这更好的方法。

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

一旦可以从开始和结束时间确定重叠，则可以对示例数据中的每一行使用mapply。由于可能需要花费多天，因此可以group_by和session时间间隔进行总结。最后的seq将数据放入您想要的宽格式。请注意，最后的持续时间以秒为单位。

pivot_wider

输出

library(tidyverse)
library(lubridate)    

get_intervals <- function(session,start,end) {
  seq3h <- seq.POSIXt(floor_date(start,unit = "day"),ceiling_date(end,"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")