Эффективный способ отбрасывать строки с перекрытием времени - PullRequest
4 голосов
/ 05 октября 2019

У меня длинный набор данных со столбцами, представляющими время начала и окончания, и я хочу отбросить строку, если она перекрывается с другой и имеет более высокий приоритет (например, 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

Может кто-нибудь помочь мне получить такой же вывод, но с более чистой функцией?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...