R вычисляет общее количество дней в массиве с пробелами / перекрытиями между датами

Question

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

id <- c("Joe" ,"Joe" ,"Joe" ,"Joe" ,"Joe")
work_start <- as.Date(c("2004-06-23", "2005-04-20", "2005-05-24", "2014-05-01", "2018-04-01"))
work_end <- as.Date(c("2014-04-30", "2010-03-11", "2005-07-05", "2018-03-31", "2019-03-31"))

df <- data.frame(id, work_start, work_end)

Я хочу рассчитать общее количество дней, в течение которых Джо работал, также с учетом дней подряд - поэтому в приведенном выше примере это будет быть непрерывным периодом с 23 июня 2004 года по 31 марта 2019 года (поскольку разрыв между 30 апреля 2014 года и 1 мая 2014 года является последовательным днем).

Я пытаюсь сделать это путем расчета последнего доступного дня и часть процесса, описанного ниже, но не знаете, как мне записать его в al oop в dplyr, или это вообще правильный подход к решению этой проблемы? Любая помощь высоко ценится.

library(dplyr)


df <- df %>%
  group_by(id) %>%
  arrange(id, work_start, work_end) %>%
  mutate(last_work_end = lag(work_end)) %>%
  mutate(last_work_end = if_else(lag(last_work_end) > last_work_end & is.finite(lag(last_work_end)),
                              lag(last_work_end),
                              last_work_end)) %>%
  mutate(last_work_end = if_else(lag(last_work_end) > last_work_end & is.finite(lag(last_work_end)),
                              lag(last_work_end),
                              last_work_end)) %>%
  ungroup()

Answer 1

Вот вариант с использованием data.table

library(data.table)
setDT(df)[order(id, work_start, work_end), 
    g := cumsum(work_start - 1L > shift(cummax(as.integer(work_end)), fill=0L)), id][,
        c("first_work_start","last_work_end") := .(min(work_start), max(work_end)), .(id, g)]

вывод:

    id work_start   work_end g first_work_start last_work_end
1: Joe 2004-06-23 2014-04-30 1       2004-06-23    2019-03-31
2: Joe 2005-04-20 2010-03-11 1       2004-06-23    2019-03-31
3: Joe 2005-05-24 2005-07-05 1       2004-06-23    2019-03-31
4: Joe 2014-05-01 2018-03-31 1       2004-06-23    2019-03-31
5: Joe 2018-04-01 2019-03-31 1       2004-06-23    2019-03-31

Ссылка: Как сгладить / объединить перекрывающиеся периоды времени

Answer 2

Вы можете попробовать:

library(dplyr)

df <- df %>%
  arrange(id, work_start, work_end) %>%
  group_by(id) %>%
  mutate(cumMaxDate = setattr(cummax(unclass(work_end)), "class", "Date")) %>%
  group_by(id, idx = cumsum(+(work_start > (lag(cumMaxDate, default = first(cumMaxDate)) + 1)))) %>%
  summarise(work_start = min(work_start), work_end = max(cumMaxDate), duration = difftime(work_end, work_start)) %>%
  ungroup() %>% select(-idx)

Вывод:

# A tibble: 1 x 4
  id    work_start work_end   duration 
  <fct> <date>     <date>     <drtn>   
1 Joe   2004-06-23 2019-03-31 5394 days

Обратите внимание, что если бы у Джо было два непоследовательных периода, то вам потребуется group_by(id) снова после последнего ungroup и просто сделайте mutate(duration = sum(duration) или подобное.

С другой стороны, если вы много работаете с данными такого типа (например, полученными в системах CRM или HCM), вы можете взглянуть на моя посылка neatRanges. Вышеупомянутая проблема может быть решена следующим образом:

# install.packages('neatRanges')

library(dplyr) # Just for the purpose of using the pipes and `mutate`

df %>%
  neatRanges::collapse_ranges(., groups = 'id', start_var = 'work_start', end_var = 'work_end') %>%
  mutate(duration = difftime(work_end, work_start))

Вывод:

   id work_start   work_end  duration
1 Joe 2004-06-23 2019-03-31 5394 days

Обратите внимание, что пакет все еще находится на ранних этапах, однако по крайней мере функция collapse_ranges была До некоторой степени проверено в бою - с другой стороны, если у вас есть предложения по улучшению или вы найдете какие-либо ошибки, о которых вы можете сообщить на GitHub .