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相对容易地做到这一点。

这个想法如下：

延迟结束数据（将其向下移动一个）
计算开始日期和滞后结束日期之间的差异
添加＆＃39; BreakPoints＆＃39; - 当差异超过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)))

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

2 个答案: