Как обрабатывать перекрывающиеся даты в кадре данных в R

Question

У меня есть штатное рота, которое автоматически создается при загрузке данных. Время от времени даты начала и окончания не будут полностью правильными. Например, кто-то может быть в ротации между 01.04.2017 и 04.10.2009, но затем выходные данные разбивают этот период на две строки, например, с 01.04.2009 до 05.04.2009 и 05.04.2009. до 10/04/2019. Это показано в кадре данных StaffRota с желаемым выводом, показанным в StaffRota2.

#create some data - shows the raw data from the download
StaffRota<-data.frame(Name=c("Ian", "Ian", "Ian", "Fred","Fred","Mark","Alex","Ian","Fred","Ian","Fred","Fred"),
                      RotaStart=c("2019-04-01","2019-04-03", "2019-04-06","2019-04-02","2019-04-05","2019-04-02","2019-04-02","2019-07-01","2019-08-01","2019-04-12","2019-09-02","2019-09-06"),
                      RotaFinish=c("2019-04-03", "2019-04-06", "2019-04-10", "2019-04-05", "2019-04-10", "2019-04-10", "2019-04-05","2019-07-31","2019-08-30","2019-04-20","2019-09-04","2019-09-08"))
StaffRota$RotaStart<-as.Date(StaffRota$RotaStart, "%Y-%m-%d")
StaffRota$RotaFinish<-as.Date(StaffRota$RotaFinish, "%Y-%m-%d")

#how the dataframe should look
StaffRota2<-data.frame(Name=c("Ian", "Fred","Mark","Alex","Ian","Fred","Ian","Fred","Fred"),
                       RotaStart=c("2019-04-01","2019-04-02","2019-04-02","2019-04-02","2019-07-01","2019-08-01","2019-04-12","2019-09-02","2019-09-06"),
                       RotaFinish=c("2019-04-10","2019-04-10", "2019-04-10", "2019-04-05","2019-07-31","2019-08-30","2019-04-20","2019-09-04","2019-09-08"))

Я хочу преобразовать данные так, чтобы столбцы, в которых даты были разделены, как показано в StaffRota, были объединены в один непрерывный запуск. и дата окончания, как показано в StaffRota2. У кого-нибудь есть предложения?

Answer 1

Используя dplyr и lubridate, вы можете группировать по месяцам:

library(dplyr)
library(lubridate)

StaffRota %>%
    mutate(mnth = month(RotaFinish)) %>%
    group_by(Name, mnth) %>%
    slice(which.max(as.Date(RotaFinish, '%m/%d/%Y'))) %>%
    ungroup() %>%
    select(-mnth)  

# Name  RotaStart  RotaFinish
# <fct> <date>     <date>    
#1 Alex  2019-04-02 2019-04-05
#2 Fred  2019-04-05 2019-04-10
#3 Fred  2019-08-01 2019-08-30
#4 Ian   2019-04-06 2019-04-10
#5 Ian   2019-07-01 2019-07-31
#6 Mark  2019-04-02 2019-04-10

Редактировать

Вы также можете группировать по неделям, используя isoweek

StaffRota %>%
    mutate(wk = isoweek(RotaStart)) %>%
    group_by(Name, wk) %>%
    slice(which.max(as.Date(RotaFinish, '%m/%d/%Y'))) %>%
    ungroup() %>%
    select(-wk)

#  Name  RotaStart  RotaFinish
#  <fct> <date>     <date>    
#1 Alex  2019-04-02 2019-04-05
#2 Fred  2019-04-05 2019-04-10
#3 Fred  2019-08-01 2019-08-30
#4 Ian   2019-04-06 2019-04-10
#5 Ian   2019-04-12 2019-04-20
#6 Ian   2019-07-01 2019-07-31
#7 Mark  2019-04-02 2019-04-10

Изменить 2

другой вариант, основанный на ваших изменениях, заключается в создании индекса для группировки данных, а не в зависимости от недели / месяца:

StaffRota %>%
    arrange(Name, RotaStart) %>%
    group_by(Name) %>%
    mutate(indx = c(0, cumsum(as.numeric(lead(RotaStart)) > cummax(as.numeric(RotaFinish)))[-n()])) %>%
    group_by(Name, indx) %>%
    summarise(RotaStart = first(RotaStart), RotaFinish = last(RotaFinish)) %>%
    ungroup() %>%
    select(-indx)

#  Name  RotaStart  RotaFinish
#  <fct> <date>     <date>    
#1 Alex  2019-04-02 2019-04-05
#2 Fred  2019-04-02 2019-04-10
#3 Fred  2019-08-01 2019-08-30
#4 Fred  2019-09-02 2019-09-04
#5 Fred  2019-09-06 2019-09-08
#6 Ian   2019-04-01 2019-04-10
#7 Ian   2019-04-12 2019-04-20
#8 Ian   2019-07-01 2019-07-31
#9 Mark  2019-04-02 2019-04-10

Answer 2

Другое решение может использовать комбо lead() / lag(), а также некоторые из более новых library(tidyr) поворотных функций.

Проще говоря, мы поворачиваемся долго, упорядочиваем, ищем повторяющиеся даты, фильтруемих, затем дублируйте типы Rota и отфильтруйте их. Широкий круг дает нам желаемый результат:

library(tidyverse)

StaffRota <-
  tribble(
    ~Name,  ~RotaStart,   ~RotaFinish,
    "Ian",  "2019-04-01", "2019-04-03",
    "Ian",  "2019-04-03", "2019-04-06",
    "Ian",  "2019-04-06", "2019-04-10",
    "Fred", "2019-04-02", "2019-04-05",
    "Fred", "2019-04-05", "2019-04-10",
    "Mark", "2019-04-02", "2019-04-10",
    "Alex", "2019-04-02", "2019-04-05",
    "Ian",  "2019-07-01", "2019-07-31",
    "Fred", "2019-08-01", "2019-08-30",
    "Ian",  "2019-04-12", "2019-04-20",
    "Fred", "2019-09-02", "2019-09-04",
    "Fred", "2019-09-06", "2019-09-08")

StaffRota %>%
  pivot_longer(RotaStart:RotaFinish,
               names_to = "Rota",
               values_to = "Date") %>%
  group_by(Name) %>%
  arrange(Name, Date) %>% 
  filter(Date != lag(Date, default = +Inf)) %>%
  filter(Rota != lead(Rota, default = -Inf)) %>% 
  group_by(Name, Rota) %>%
  mutate(n = 1:n()) %>%
  pivot_wider(
    id_cols = c(Name, n),
    names_from = Rota,
    values_from = Date
  ) %>% 
  select(-n)
#> # A tibble: 9 x 3
#> # Groups:   Name [4]
#>   Name  RotaStart  RotaFinish
#>   <chr> <chr>      <chr>     
#> 1 Alex  2019-04-02 2019-04-05
#> 2 Fred  2019-04-02 2019-04-10
#> 3 Fred  2019-08-01 2019-08-30
#> 4 Fred  2019-09-02 2019-09-04
#> 5 Fred  2019-09-06 2019-09-08
#> 6 Ian   2019-04-01 2019-04-10
#> 7 Ian   2019-04-12 2019-04-20
#> 8 Ian   2019-07-01 2019-07-31
#> 9 Mark  2019-04-02 2019-04-10

^{Создан в 2019-10-15 пакетом Представить (v0.3.0)}