У меня длинный набор данных со столбцами, представляющими время начала и окончания, и я хочу отбросить строку, если она перекрывается с другой и имеет более высокий приоритет (например, 1 - самый высокий приоритет). Мой пример данных:
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))
Способ, которым я придумал, решает проблему в обратном направлении, находя перекрытия с более высоким значением приоритета, а затем используя anti_join
, чтобы удалить их из исходного кадра данных. Этот код просто имеет неприятный запах, и я уверен, что есть более эффективный и функциональный способ сделать это.
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
Может кто-нибудь помочь мне получить такой же вывод, но с более чистой функцией?