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

【问题标题】：Group date intervals by the proximity of their start- and end-times按开始和结束时间的接近程度对日期间隔进行分组
【发布时间】：2016-09-07 04:32:43
【问题描述】：

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

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)
}

【问题讨论】：

标签： r zoo

【解决方案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 中

【讨论】：

【解决方案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)))

【讨论】：