润滑-查找间隔和日期之间的重叠时间

时间:2019-10-23 06:52:16

标签: r lubridate

我有一个数据框,其日期和日期的移位开始和结束是这样的:

2nd_semester

我还有另一个带有公共假期日期的数据框,如下所示:

3rd_semester

我想用新列更新shift_time df,其中记录了在公共假日发生的轮班小时数-即,我想计算轮班间隔与任何公共假日之间的重叠(以小时为单位)适用。在上面的示例中,新变量的期望值为0、0、4。

有没有办法做到这一点而无需创建很多新变量(例如,差异时间,间隔,匹配日期)?

1 个答案:

答案 0 :(得分:7)

有内置的lubridate::int_overlaps,但仅返回逻辑值,而不返回它们重叠的时间。幸运的是,intersection函数具有用于Interval对象的方法。唯一的技巧是,如果没有重叠,它将返回length-NA,而不是length-{0。因此,我们可以像这样总结逻辑:

library(lubridate)

int_overlaps_numeric <- function (int1, int2) {
  stopifnot(c(is.interval(int1), is.interval(int2)))

  x <- intersect(int1, int2)@.Data
  x[is.na(x)] <- 0
  as.duration(x)
}

这将构造重叠的间隔,然后提取其长度(以秒为单位)。如果为NA,请将其更改为零,然后返回。 as.duration只是给我们印刷精美的字样。现在,您只需要给它两个间隔:

int1 <- as.interval(5, Sys.time())
int2 <- as.interval(5, Sys.time()+3)

int_overlaps_numeric(int1, int2)
"1.99299597740173s"

因此,您需要将所有假期划分为间隔,并将所有班次划分为间隔。大概您想将这些重叠与shift_time数据框中的其他数据相关联,因此我们将使用dplyr在其中进行所有工作。但是,您要针对所有假期的向量检查每个移位,因此我们应该添加另一个辅助函数(使用purrr::map)。

library(dplyr)
library(purrr)

check_shift_against_holidays <- function(shift, holidays) {
  map(shift, ~sum(int_overlaps_numeric(.x, holidays))) %>% 
    unlist() %>% 
    as.duration()
}

此函数采用两个间隔向量。对于第一个向量的每个元素,它计算与第二个向量的每个元素的重叠,然后将它们相加。然后将其从列表转换回向量,并将其重新分类为duration以进行漂亮的打印。需要注意的是,如果holidays向量中有任何重叠,则这些小时将被重复计算。

                               # days(1) since the holiday lasts all day
holiday_intervals <- as.interval(days(1), ymd(public_holidays$date))

shift_time %>% 
  mutate(
    shift = interval(ymd_hms(started_at), ymd_hms(ended_at)),
    holiday_hours = check_shift_against_holidays(shift, holiday_intervals)
  )
                started_at                 ended_at                                            shift     holiday_hours
1 2019-09-01 02:00:00 AEST 2019-09-01 11:30:00 AEST 2019-09-01 02:00:00 UTC--2019-09-01 11:30:00 UTC                0s
2 2019-09-02 05:00:00 AEST 2019-09-02 19:00:00 AEST 2019-09-02 05:00:00 UTC--2019-09-02 19:00:00 UTC                0s
3 2019-11-04 20:00:00 AEDT 2019-11-05 04:00:00 AEDT 2019-11-04 20:00:00 UTC--2019-11-05 04:00:00 UTC 14400s (~4 hours)

如果您真的反对创建任何新的中间变量,

shift_time %>% 
  mutate(
    holiday_hours = check_shift_against_holidays(
      ymd_hms(started_at) %--% ymd_hms(ended_at), 
      holiday_intervals
      )
  )
                started_at                 ended_at     holiday_hours
1 2019-09-01 02:00:00 AEST 2019-09-01 11:30:00 AEST                0s
2 2019-09-02 05:00:00 AEST 2019-09-02 19:00:00 AEST                0s
3 2019-11-04 20:00:00 AEDT 2019-11-05 04:00:00 AEDT 14400s (~4 hours)