按开始时间和结束时间的接近程度对日期间隔进行分组

Question

假设我有一系列表示日期间隔的观察结果，例如

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 创建一个加权边缘列表，但这似乎过于复杂。我认为，效率很重要：我将运行处理大约 400 万组数据，每组约 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)
}

Answer 1

您可以使用 dplyr 相对轻松地做到这一点。

思路如下：

滞后结束数据（向下移动一位）
计算开始日期和滞后结束日期之间的差异
添加 'BreakPoints' - 当差异超过 5 天时为 TRUE 的变量，否则为 FALSE
正在计算这个断点的累计和。这将在每次找到新断点时加 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

Answer 2

这不像 Lorenzo Rossi 的解决方案那么优雅，但使用 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)))

按开始时间和结束时间的接近程度对日期间隔进行分组

Group date intervals by the proximity of their start- and end-times

r

zoo