Lubridate - Найти время перекрытия между интервалом и датой - PullRequest
6 голосов
/ 23 октября 2019

У меня есть фрейм данных с началом и концом смены в формате datetime, например:

shift_time <- data.frame(
  started_at = c("2019-09-01 02:00:00 AEST", "2019-09-02 05:00:00 AEST", "2019-11-04 20:00:00 AEDT"),
  ended_at = c("2019-09-01 11:30:00 AEST", "2019-09-02 19:00:00 AEST", "2019-11-05 04:00:00 AEDT")
)

У меня есть еще один фрейм данных с датами государственных праздников, например:

public_holidays <- data.frame(
  hol_name = c('Cup Day', 'Christmas'),
  date = c("2019-11-05", "2019-12-25")
)

Я хочуобновите shift_time df новым столбцом, в котором записано количество часов смены, имевшей место в праздничный день, т. е. я хочу вычислить перекрытие (в часах) между интервалом смены и любым применимым государственным праздником. В приведенном выше примере ожидаемые значения для новой переменной будут 0, 0, 4.

Есть ли способ сделать это, который не требует создания большого количества новых переменных (например, разностей, интервалов,совпадающие даты)?

1 Ответ

7 голосов
/ 30 октября 2019

Есть встроенный lubridate::int_overlaps, но он возвращает только логическое значение, а не то, как долго они перекрываются. К счастью, функция intersection имеет метод для Interval объектов. Единственная хитрость в том, что если нет перекрытия, возвращается длина - NA, а не длина - 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)
...