Un moyen efficace de supprimer des lignes avec des temps qui se chevauchent

J'ai un long ensemble de données avec des colonnes représentant les heures de début et de fin, et je veux supprimer une ligne si elle chevauche une autre et a une priorité plus élevée (par exemple 1 est la priorité la plus élevée). Mes données d'exemple sont

library(tidyverse)
library(lubridate)
times_df <- tibble(start = as_datetime(c("2019-10-05 14:05:25", 
    "2019-10-05 17:30:20", 
    "2019-10-05 17:37:00", 
    "2019-10-06 04:43:55", 
    "2019-10-06 04:53:45")), 
    stop = as_datetime(c("2019-10-05 14:19:20",
    "2019-10-05 17:45:15", 
    "2019-10-05 17:50:45", 
    "2019-10-06 04:59:00",
    "2019-10-06 05:07:10")), priority = c(5,3,4,3,4))

La façon dont j'ai trouvé attaque le problème en arrière en trouvant les chevauchements avec une valeur de priorité plus élevée, puis en utilisant un anti_joinpour les supprimer de la trame de données d'origine. Ce code ne fonctionne pas s'il y a trois périodes chevauchant le même point de temps et je suis sûr qu'il existe un moyen plus efficace et fonctionnel de le faire.

dropOverlaps <- function(df) {
    drops <- df %>% 
        filter(stop > lead(start) | lag(stop) > start) %>% 
        mutate(group = ({seq(1, nrow(.)/2)} %>% 
        rep(each=2))) %>% 
        group_by(group) %>% 
        filter(priority == max(priority))
    anti_join(df, drops)
}

dropOverlaps(times_df)
#> Joining, by = c("start", "stop", "priority")
#> # A tibble: 3 x 3
#>   start               stop                priority
#>   <dttm>              <dttm>                 <dbl>
#> 1 2019-10-05 14:05:25 2019-10-05 14:19:20        5
#> 2 2019-10-05 17:30:20 2019-10-05 17:45:15        3
#> 3 2019-10-06 04:43:55 2019-10-06 04:59:00        3

Quelqu'un peut-il m'aider à obtenir la même sortie mais avec une fonction plus propre? Bonus s'il peut gérer une entrée avec trois périodes de temps ou plus qui se chevauchent toutes.

Voici une data.tablesolution utilisant foverlapspour détecter les enregistrements qui se chevauchent (comme déjà mentionné par @GenesRus). Les enregistrements qui se chevauchent sont affectés à des groupes pour filtrer l'enregistrement avec max. priorité dans le groupe. J'ai ajouté deux enregistrements supplémentaires à vos données d'exemple, pour montrer que cette procédure fonctionne également pour trois enregistrements qui se chevauchent ou plus:

Edit: j'ai modifié et traduit la solution de @ pgcudahy data.tablequi donne un code encore plus rapide:

library(data.table)
library(lubridate)

times_df <- data.frame(
  start = as_datetime(
    c(
      "2019-10-05 14:05:25",
      "2019-10-05 17:30:20",
      "2019-10-05 17:37:00",
      "2019-10-06 04:43:55",
      "2019-10-06 04:53:45",
      "2019-10-06 04:53:46",
      "2019-10-06 04:53:47"
    )
  ),
  stop = as_datetime(
    c(
      "2019-10-05 14:19:20",
      "2019-10-05 17:45:15",
      "2019-10-05 17:50:45",
      "2019-10-06 04:59:00",
      "2019-10-06 05:07:10",
      "2019-10-06 05:07:11",
      "2019-10-06 05:07:12"
    )
  ),
  priority = c(5, 3, 4, 3, 4, 5, 6)
)

resultDT <- setDT(times_df, key="start")[!(stop >= shift(start, type="lead", fill = TRUE) & priority > shift(priority, type="lead", fill = TRUE)) &
                                         !(start <= shift(stop, type="lag", fill = FALSE) & priority > shift(priority, type="lag", fill = TRUE))]

# old approach ------------------------------------------------------------
# times_dt <- as.data.table(times_df)
# setkey(times_dt, start, stop)[, index := .I]
# overlaps_dt <- foverlaps(times_dt, times_dt, type = "any", which = TRUE)[xid != yid][, group := fifelse(xid > yid, yes = paste0(yid, "_", xid), no = paste0(xid, "_", yid))]
# overlaps_merged <- merge(times_dt, overlaps_dt, by.x = "index", by.y = "xid")[, .(delete_index = index[priority == max(priority)]), by = "group"]
# result_dt <- times_dt[!unique(overlaps_merged$delete_index)][, index := NULL]

Pour plus de détails, veuillez consulter ?foverlaps- Il existe des fonctionnalités plus utiles implémentées pour contrôler ce qui est considéré comme un chevauchement tel que maxgap, minoverlapou type(tout, dans, début, fin et égal).

Mise à jour - nouvelle référence

Unit: microseconds
          expr       min         lq      mean    median        uq        max neval
          Paul 25572.550 26105.2710 30183.930 26514.342 29614.272 153810.600   100
           MKa  5100.447  5276.8350  6508.333  5401.275  5832.270  23137.879   100
      pgcudahy  3330.243  3474.4345  4284.640  3556.802  3748.203  21241.260   100
 ismirsehregal   711.084   913.3475  1144.829  1013.096  1433.427   2316.159   100

Code de référence:

#### library ----

library(dplyr)
library(lubridate)
library(igraph)
library(data.table)
library(microbenchmark)

#### data ----

times_df <- data.frame(
  start = as_datetime(
    c(
      "2019-10-05 14:05:25",
      "2019-10-05 17:30:20",
      "2019-10-05 17:37:00",
      "2019-10-06 04:43:55",
      "2019-10-06 04:53:45",
      "2019-10-06 04:53:46",
      "2019-10-06 04:53:47"
    )
  ),
  stop = as_datetime(
    c(
      "2019-10-05 14:19:20",
      "2019-10-05 17:45:15",
      "2019-10-05 17:50:45",
      "2019-10-06 04:59:00",
      "2019-10-06 05:07:10",
      "2019-10-06 05:07:11",
      "2019-10-06 05:07:12"
    )
  ),
  priority = c(5, 3, 4, 3, 4, 5, 6)
)

times_tib <- as_tibble(times_df)
times_dt <- as.data.table(times_df)

#### group_interval function ----

# buffer to take a form similar to: days(1), weeks(2), etc.
group_interval <- function(start, end, buffer = 0) {

  dat <- tibble(rid = 1:length(start),
                start = start,
                end = end,
                intervals = case_when(!is.na(start) & !is.na(end) ~ interval(start, end),
                                      is.na(start) ~ interval(end, end),
                                      is.na(end) ~ interval(start, start),
                                      TRUE ~ interval(NA, NA)))

  # apply buffer period to intervals
  int_start(dat$intervals) <- int_start(dat$intervals) - buffer + seconds(0.01)
  int_end(dat$intervals) <- int_end(dat$intervals) + buffer - seconds(0.01)

  df_overlap <- bind_cols(
    expand.grid(dat$rid, dat$rid), # make a 2 col table with every combination of id numbers
    expand.grid(dat$intervals, dat$intervals)) %>% # make a combination of every interval
    mutate(overlap = int_overlaps(.data$Var11, .data$Var21)) %>% # determine if intervals overlap
    rename("row" = "Var1", "col" = "Var2")

  # Find groups via graph theory See igraph package
  dat_graph <- graph_from_data_frame(filter(df_overlap, overlap) %>% select(row, col))
  groups <- components(dat_graph)$membership[df_overlap$row]

  # create a 2 column df with row (index) and group number, arrange on row number and return distinct values
  df_groups <- tibble(row = as.integer(names(groups)), group = groups) %>%
    unique()

  # returns
  left_join(select(dat, rid), df_groups, by = c("rid" = "row"))$group

}

#### benchmark ----

library(igraph)
library(data.table)
library(dplyr)
library(lubridate)
library(microbenchmark)

df_Paul <- df_MKa <- df_pgcudahy <- df_ismirsehregal <- times_df <- data.frame(
  start = as_datetime(
    c(
      "2019-10-05 14:05:25",
      "2019-10-05 17:30:20",
      "2019-10-05 17:37:00",
      "2019-10-06 04:43:55",
      "2019-10-06 04:53:45",
      "2019-10-06 04:53:46",
      "2019-10-07 06:00:00",
      "2019-10-07 06:10:00",
      "2019-10-07 06:20:00",
      "2019-10-08 06:00:00",
      "2019-10-08 06:10:00",
      "2019-10-08 06:20:00",
      "2019-10-09 03:00:00",
      "2019-10-09 03:10:00",
      "2019-10-10 03:00:00",
      "2019-10-10 03:10:00",
      "2019-10-11 05:00:00",
      "2019-10-11 05:00:00")
  ),
  stop = as_datetime(
    c(
      "2019-10-05 14:19:20",
      "2019-10-05 17:45:15",
      "2019-10-05 17:50:45",
      "2019-10-06 04:59:00",
      "2019-10-06 05:07:10",
      "2019-10-06 05:07:11",
      "2019-10-07 06:18:00",
      "2019-10-07 06:28:00",
      "2019-10-07 06:38:00",
      "2019-10-08 06:18:00",
      "2019-10-08 06:28:00",
      "2019-10-08 06:38:00",
      "2019-10-09 03:30:00",
      "2019-10-09 03:20:00",
      "2019-10-10 03:30:00",
      "2019-10-10 03:20:00",
      "2019-10-11 05:40:00",
      "2019-10-11 05:40:00")
  ),
  priority = c(5, 3, 4, 3, 4, 5, 4, 3, 4, 3, 4, 3, 1, 2, 2, 1, 3, 4)
)


benchmarks <- microbenchmark(Paul = {
  group_interval <- function(start, end, buffer = 0) {

    dat <- tibble(rid = 1:length(start),
                  start = start,
                  end = end,
                  intervals = case_when(!is.na(start) & !is.na(end) ~ interval(start, end),
                                        is.na(start) ~ interval(end, end),
                                        is.na(end) ~ interval(start, start),
                                        TRUE ~ interval(NA, NA)))

    int_start(dat$intervals) <- int_start(dat$intervals) - buffer + seconds(0.01)
    int_end(dat$intervals) <- int_end(dat$intervals) + buffer - seconds(0.01)

    df_overlap <- bind_cols(
      expand.grid(dat$rid, dat$rid), # make a 2 col table with every combination of id numbers
      expand.grid(dat$intervals, dat$intervals)) %>% # make a combination of every interval
      mutate(overlap = int_overlaps(.data$Var11, .data$Var21)) %>% # determine if intervals overlap
      rename("row" = "Var1", "col" = "Var2")

    dat_graph <- graph_from_data_frame(filter(df_overlap, overlap) %>% select(row, col))
    groups <- components(dat_graph)$membership[df_overlap$row]

    df_groups <- tibble(row = as.integer(names(groups)), group = groups) %>%
      unique()

    left_join(select(dat, rid), df_groups, by = c("rid" = "row"))$group
  }

  times_tib <- as_tibble(df_Paul)

  mutate(times_tib, group = group_interval(start, stop)) %>%
    group_by(group) %>%
    top_n(1, desc(priority)) %>%
    ungroup() %>%
    select(-group)
},
MKa = {
  df_MKa$id <- 1:nrow(df_MKa)

  # Create consolidated df which we will use to check if stop date is in between start and stop
  my_df <- bind_rows(replicate(n = nrow(df_MKa), expr = df_MKa, simplify = FALSE))
  my_df$stop_chk <- rep(df_MKa$stop, each = nrow(df_MKa))

  # Flag if stop date sits in between start and stop
  my_df$chk <- my_df$stop_chk >= my_df$start & my_df$stop_chk <= my_df$stop
  my_df$chk_id <- df_MKa[match(my_df$stop_chk, df_MKa$stop), "id"]

  # Using igrpah to cluster ids to create unique groups
  # this will identify any overlapping groups
  library(igraph)
  g <- graph.data.frame(my_df[my_df$chk == TRUE, c("id", "chk_id")])
  df_g <- data.frame(clusters(g)$membership)
  df_g$chk_id <- row.names(df_g)

  # copy the unique groups to the df
  my_df$new_id <- df_g[match(my_df$chk_id, df_g$chk_id), "clusters.g..membership"]
  my_df %>% 
    filter(chk == TRUE) %>%
    arrange(priority) %>%
    filter(!duplicated(new_id)) %>%
    select(start, stop, priority) %>%
    arrange(start)
}, pgcudahy = {
  df_pgcudahy %>%
    arrange(start) %>%
    mutate(remove1 = ifelse((stop >= lead(start, default=FALSE)) & 
                              (priority > lead(priority, default=(max(priority) + 1))), TRUE, FALSE)) %>%
    mutate(remove2 = ifelse((start <= lag(stop, default=FALSE)) & 
                              (priority > lag(priority, default=(max(priority) + 1))), TRUE, FALSE)) %>%
    filter(remove1 == FALSE & remove2 == FALSE) %>%
    select(1:3)
}, ismirsehregal = {
  setDT(df_ismirsehregal, key="start")[!(stop >= shift(start, type="lead", fill = TRUE) & priority > shift(priority, type="lead", fill = TRUE)) &
                                       !(start <= shift(stop, type="lag", fill = FALSE) & priority > shift(priority, type="lag", fill = TRUE))]
})

benchmarks

J'ai une fonction d'aide qui regroupe les données qui se chevauchent / données de temps en utilisant le paquet igraph (il peut inclure un tampon de chevauchement, c'est-à-dire que le terminus est à moins d'une minute ...)

Je l'ai utilisé pour regrouper vos données en fonction des intervalles de lubrification, puis faire des manipulations de données pour obtenir uniquement l'entrée de priorité la plus élevée en cas de chevauchement.

Je ne sais pas dans quelle mesure il évoluera.

#### library ----

library(dplyr)
library(lubridate)
library(igraph)

#### data ----

times_df <- tibble(start = as_datetime(c("2019-10-05 14:05:25", 
                                         "2019-10-05 17:30:20", 
                                         "2019-10-05 17:37:00", 
                                         "2019-10-06 04:43:55", 
                                         "2019-10-06 04:53:45")), 
                   stop = as_datetime(c("2019-10-05 14:19:20",
                                        "2019-10-05 17:45:15", 
                                        "2019-10-05 17:50:45", 
                                        "2019-10-06 04:59:00",
                                        "2019-10-06 05:07:10")), priority = c(5,3,4,3,4))

#### group_interval function ----

# buffer to take a form similar to: days(1), weeks(2), etc.
group_interval <- function(start, end, buffer = 0) {

  dat <- tibble(rid = 1:length(start),
                start = start,
                end = end,
                intervals = case_when(!is.na(start) & !is.na(end) ~ interval(start, end),
                                      is.na(start) ~ interval(end, end),
                                      is.na(end) ~ interval(start, start),
                                      TRUE ~ interval(NA, NA)))

  # apply buffer period to intervals
  int_start(dat$intervals) <- int_start(dat$intervals) - buffer + seconds(0.01)
  int_end(dat$intervals) <- int_end(dat$intervals) + buffer - seconds(0.01)

  df_overlap <- bind_cols(
    expand.grid(dat$rid, dat$rid), # make a 2 col table with every combination of id numbers
    expand.grid(dat$intervals, dat$intervals)) %>% # make a combination of every interval
    mutate(overlap = int_overlaps(.data$Var11, .data$Var21)) %>% # determine if intervals overlap
    rename("row" = "Var1", "col" = "Var2")

  # Find groups via graph theory See igraph package
  dat_graph <- graph_from_data_frame(filter(df_overlap, overlap) %>% select(row, col))
  groups <- components(dat_graph)$membership[df_overlap$row]

  # create a 2 column df with row (index) and group number, arrange on row number and return distinct values
  df_groups <- tibble(row = as.integer(names(groups)), group = groups) %>%
    unique()

  # returns
  left_join(select(dat, rid), df_groups, by = c("rid" = "row"))$group

}

#### data munging ----

mutate(times_df, group = group_interval(start, stop)) %>%
  group_by(group) %>%
  top_n(1, desc(priority)) %>% # not sure why desc is needed, but top_n was giving the lower 
  ungroup() %>%
  select(-group)

Qui donne:

    # A tibble: 3 x 3
      start               stop                priority
      <dttm>              <dttm>                 <dbl>
    1 2019-10-05 14:05:25 2019-10-05 14:19:20        5
    2 2019-10-05 17:30:20 2019-10-05 17:45:15        3
    3 2019-10-06 04:43:55 2019-10-06 04:59:00        3

Je suis descendu dans un terrier de lapin en regardant des arbres d'intervalle (et des implémentations R comme IRanges / plyranges) mais je pense que ce problème n'a pas besoin d'une telle structure de données car les heures de début peuvent être facilement triées. J'ai également développé l'ensemble de test comme @ismirsehregal pour couvrir davantage de relations d'intervalle potentielles , comme un intervalle qui commence avant et se termine après son voisin, ou lorsque trois intervalles se chevauchent mais que le premier et le dernier ne se chevauchent pas, ou deux intervalles qui commencent et arrêtez exactement aux mêmes heures.

library(lubridate)
times_df <- data.frame(
  start = as_datetime(
    c(
      "2019-10-05 14:05:25",
      "2019-10-05 17:30:20",
      "2019-10-05 17:37:00",
      "2019-10-06 04:43:55",
      "2019-10-06 04:53:45",
      "2019-10-06 04:53:46",
      "2019-10-07 06:00:00",
      "2019-10-07 06:10:00",
      "2019-10-07 06:20:00",
      "2019-10-08 06:00:00",
      "2019-10-08 06:10:00",
      "2019-10-08 06:20:00",
      "2019-10-09 03:00:00",
      "2019-10-09 03:10:00",
      "2019-10-10 03:00:00",
      "2019-10-10 03:10:00",
      "2019-10-11 05:00:00",
      "2019-10-11 05:00:00")
  ),
  stop = as_datetime(
    c(
      "2019-10-05 14:19:20",
      "2019-10-05 17:45:15",
      "2019-10-05 17:50:45",
      "2019-10-06 04:59:00",
      "2019-10-06 05:07:10",
      "2019-10-06 05:07:11",
      "2019-10-07 06:18:00",
      "2019-10-07 06:28:00",
      "2019-10-07 06:38:00",
      "2019-10-08 06:18:00",
      "2019-10-08 06:28:00",
      "2019-10-08 06:38:00",
      "2019-10-09 03:30:00",
      "2019-10-09 03:20:00",
      "2019-10-10 03:30:00",
      "2019-10-10 03:20:00",
      "2019-10-11 05:40:00",
      "2019-10-11 05:40:00")
  ),
  priority = c(5, 3, 4, 3, 4, 5, 4, 3, 4, 3, 4, 3, 1, 2, 2, 1, 3, 4)
)

Je fais ensuite deux passes dans chaque intervalle pour voir s'il chevauche son prédécesseur ou son successeur

stop >= lead(start, default=FALSE) et start <= lag(stop, default=FALSE))

Lors de chaque passage, il y a une deuxième vérification pour voir si la priorité de l'intervalle a une valeur numérique supérieure à celle du prédécesseur ou du successeur priority > lead(priority, default=(max(priority) + 1)). Lors de chaque passage, si les deux conditions sont vraies, un indicateur "remove" est défini sur true dans une nouvelle colonne en utilisant mutate. Toutes les lignes avec un indicateur de suppression sont ensuite filtrées.

library(tidyverse)
times_df %>%
    arrange(start) %>%
    mutate(remove1 = ifelse((stop >= lead(start, default=FALSE)) & 
                            (priority > lead(priority, default=(max(priority) + 1))), 
                            TRUE, FALSE)) %>%
    mutate(remove2 = ifelse((start <= lag(stop, default=FALSE)) & 
                            (priority > lag(priority, default=(max(priority) + 1))), 
                            TRUE, FALSE)) %>%
    filter(remove1 == FALSE & remove2 == FALSE) %>%
    select(1:3)

Cela évite de vérifier toutes les combinaisons potentielles d'intervalles comme la réponse de @ Paul (comparaisons 2n contre n!) Ainsi que mon ignorance de la théorie des graphes :)

De même, la réponse de @ ismirsehregal a une magie data.table qui dépasse ma compréhension.

La solution de @ MKa ne semble pas fonctionner avec> 2 périodes qui se chevauchent

Tester les solutions donne

#>          expr       min        lq      mean    median        uq       max
#> 1 dplyr_igraph 36.568842 41.510950 46.692147 43.362724 47.065277 241.92073
#> 2  data.table  9.126385  9.935049 11.395977 10.521032 11.446257  34.26953
#> 3       dplyr  5.031397  5.500363  6.224059  5.902589  6.373197  15.09273
#>   neval
#> 1   100
#> 2   100
#> 3   100

De ce code

library(igraph)
library(data.table)
library(microbenchmark)
benchmarks <- microbenchmark(dplyr_igraph = {
  group_interval <- function(start, end, buffer = 0) {

  dat <- tibble(rid = 1:length(start),
                start = start,
                end = end,
                intervals = case_when(!is.na(start) & !is.na(end) ~ interval(start, end),
                                      is.na(start) ~ interval(end, end),
                                      is.na(end) ~ interval(start, start),
                                      TRUE ~ interval(NA, NA)))

  int_start(dat$intervals) <- int_start(dat$intervals) - buffer + seconds(0.01)
  int_end(dat$intervals) <- int_end(dat$intervals) + buffer - seconds(0.01)

  df_overlap <- bind_cols(
    expand.grid(dat$rid, dat$rid), # make a 2 col table with every combination of id numbers
    expand.grid(dat$intervals, dat$intervals)) %>% # make a combination of every interval
    mutate(overlap = int_overlaps(.data$Var11, .data$Var21)) %>% # determine if intervals overlap
    rename("row" = "Var1", "col" = "Var2")

  dat_graph <- graph_from_data_frame(filter(df_overlap, overlap) %>% select(row, col))
  groups <- components(dat_graph)$membership[df_overlap$row]

  df_groups <- tibble(row = as.integer(names(groups)), group = groups) %>%
    unique()

  left_join(select(dat, rid), df_groups, by = c("rid" = "row"))$group
  }

  times_tib <- as_tibble(times_df)

  mutate(times_tib, group = group_interval(start, stop)) %>%
    group_by(group) %>%
    top_n(1, desc(priority)) %>%
    ungroup() %>%
    select(-group)
}, data.table = {
  times_dt <- as.data.table(times_df)
  setkey(times_dt, start, stop)[, index := .I]
  overlaps_dt <- foverlaps(times_dt, times_dt, type = "any", which = TRUE)[xid != yid][, group := fifelse(xid > yid, yes = paste0(yid, "_", xid), no = paste0(xid, "_", yid))]
  overlaps_merged <- merge(times_dt, overlaps_dt, by.x = "index", by.y = "xid")[, .(delete_index = index[priority == max(priority)]), by = "group"]
  result_dt <- times_dt[!unique(overlaps_merged$delete_index)][, index := NULL]
}, dplyr = {
times_df %>%
    arrange(start) %>%
    mutate(remove1 = ifelse((stop >= lead(start, default=FALSE)) & 
                            (priority > lead(priority, default=(max(priority) + 1))), TRUE, FALSE)) %>%
    mutate(remove2 = ifelse((start <= lag(stop, default=FALSE)) & 
                            (priority > lag(priority, default=(max(priority) + 1))), TRUE, FALSE)) %>%
    filter(remove1 == FALSE & remove2 == FALSE) %>%
    select(1:3)
})
summary(benchmarks)

En utilisant également igraphpour identifier les groupes qui se chevauchent, vous pouvez essayer:

library(tidyverse)
library(lubridate)
times_df <- data.frame(
  start = as_datetime(
    c(
      "2019-10-05 14:05:25",
      "2019-10-05 17:30:20",
      "2019-10-05 17:37:00",
      "2019-10-06 04:43:55",
      "2019-10-06 04:53:45",
      "2019-10-06 04:53:46",
      "2019-10-07 06:00:00",
      "2019-10-07 06:10:00",
      "2019-10-07 06:20:00",
      "2019-10-08 06:00:00",
      "2019-10-08 06:10:00",
      "2019-10-08 06:20:00",
      "2019-10-09 03:00:00",
      "2019-10-09 03:10:00",
      "2019-10-10 03:00:00",
      "2019-10-10 03:10:00",
      "2019-10-11 05:00:00",
      "2019-10-11 05:00:00")
  ),
  stop = as_datetime(
    c(
      "2019-10-05 14:19:20",
      "2019-10-05 17:45:15",
      "2019-10-05 17:50:45",
      "2019-10-06 04:59:00",
      "2019-10-06 05:07:10",
      "2019-10-06 05:07:11",
      "2019-10-07 06:18:00",
      "2019-10-07 06:28:00",
      "2019-10-07 06:38:00",
      "2019-10-08 06:18:00",
      "2019-10-08 06:28:00",
      "2019-10-08 06:38:00",
      "2019-10-09 03:30:00",
      "2019-10-09 03:20:00",
      "2019-10-10 03:30:00",
      "2019-10-10 03:20:00",
      "2019-10-11 05:40:00",
      "2019-10-11 05:40:00")
  ),
  priority = c(5, 3, 4, 3, 4, 5, 4, 3, 4, 3, 4, 3, 1, 2, 2, 1, 3, 4)
)
times_df$id <- 1:nrow(times_df)


# Create consolidated df which we will use to check if stop date is in between start and stop
my_df <- bind_rows(replicate(n = nrow(times_df), expr = times_df, simplify = FALSE))
my_df$stop_chk <- rep(times_df$stop, each = nrow(times_df))

# Flag if stop date sits in between start and stop
my_df$chk <- my_df$stop_chk >= my_df$start & my_df$stop_chk <= my_df$stop
my_df$chk_id <- times_df[match(my_df$stop_chk, times_df$stop), "id"]

# Using igrpah to cluster ids to create unique groups
# this will identify any overlapping groups
library(igraph)
g <- graph.data.frame(my_df[my_df$chk == TRUE, c("id", "chk_id")])
df_g <- data.frame(clusters(g)$membership)
df_g$chk_id <- row.names(df_g)

# copy the unique groups to the df
my_df$new_id <- df_g[match(my_df$chk_id, df_g$chk_id), "clusters.g..membership"]
my_df %>% 
  filter(chk == TRUE) %>%
  arrange(priority) %>%
  filter(!duplicated(new_id)) %>%
  select(start, stop, priority) %>%
  arrange(start)