Группируйте интервалы дат по близости их начального и конечного времени

Предположим, у меня есть ряд наблюдений, представляющих интервалы дат, например

library(dplyr)
library(magrittr)

df <-
    data_frame(start = as.Date(c('2000-01-01', '2000-01-03', '2000-01-08',
                                 '2000-01-20', '2000-01-22')),
               end =   as.Date(c('2000-01-02', '2000-01-05', '2000-01-10',
                                 '2000-01-21', '2000-02-10')))

Я хотел бы сгруппировать эти наблюдения так, чтобы время начала наблюдения n происходит в течение определенного интервала после даты окончания наблюдения n-1, Например, если мы установим этот интервал равным 5 дням, мы увидим что-то вроде:

#           start        end group
#          (date)     (date) (dbl)
#    1 2000-01-01 2000-01-02     1
#    2 2000-01-03 2000-01-05     1
#    3 2000-01-08 2000-01-10     1
#    4 2000-01-20 2000-01-21     2
#    5 2000-01-22 2000-02-10     2

(Ради простоты я предполагаю, что даты не перекрываются, хотя в данных это не всегда так). Я думал об использовании igraph создать взвешенный крайний список, но это казалось слишком сложным. Эффективность, на мой взгляд, важна: я буду работать с примерно 4 миллионами групп данных по 5-10 строк в каждой.

Хотя мое решение работает, оно кажется мне подверженным ошибкам, медленным и неуклюжим. Я думаю, что использование пакета или некоторой векторизации действительно улучшит ситуацию.

group_dates <- function(df, interval){
  # assign first date to first group
  df %<>% arrange(start, end)
  df[1, 'group'] <- 1

  # for each start date, determine if it is within `interval` days of the
  # closest end date
  lapply(df$start[-1], function(cur_start){
    earlier_data <- df[df$end <= cur_start, ]
    diffs <- cur_start - earlier_data$end
    min_interval <- diffs[which.min(diffs)]
    closest_group <- earlier_data$group[which.min(diffs)]

    if(min_interval <= interval){
      df[df$start == cur_start, 'group'] <<- closest_group
    } else {
      df[df$start == cur_start, 'group'] <<- closest_group + 1
    }
  })

  return(df)
}
Источник

2 ответа

Решение

Вы можете сделать это относительно легко с помощью dplyr.

Идея заключается в следующем:

  1. Лаг конечных данных (сдвиг его вниз на единицу)
  2. Рассчитайте разницу между датой начала и датой окончания с задержкой
  3. Добавление "BreakPoints" - переменная со значением TRUE, если разница превышает 5 дней, и FALSE в противном случае
  4. Расчет накопленной суммы этой точки останова. Это будет добавлять 1 каждый раз, когда он находит новую точку останова, поэтому новый интервал должен быть запущен

Нечто подобное должно работать для вас:

df %>% 
  mutate(lagged_end = lag(end),
         diff = start - lagged_end,
         new_interval = diff > 5,
         new_interval = ifelse(is.na(new_interval), FALSE, new_interval),
         interval_number = cumsum(new_interval))

Это также должно быть довольно быстро, так как все в dplyr

Источник

Это не так элегантно, как решение Лоренцо Росси, но предлагает немного другой подход с использованием cut.Date и 2 строки кода:

breakpoints <- c(FALSE, sapply(2:nrow(df), function(x) df[x,"start"] - df[x-1,"end"]) > 5)
clusterLabels <- as.numeric(cut.Date(df$start, c(min(df$start), df[breakpoints, "start"], max(df$start)+1)))
Источник
Другие вопросы по тегам