在 R 中合并连续的日期范围答案

【问题标题】：Merging contiguous date ranges in R在 R 中合并连续的日期范围
【发布时间】：2018-12-17 16:56:42
【问题描述】：

我想将观察结果整合到连续的（所涵盖的天数中没有间隔）日期范围内。每个 patid 在结果数据帧中可能有多个范围。我知道它可以用循环来完成。但是，有没有一种有效的方法来处理这个任务？请注意，这里的时间间隔没有重叠，并且 start_date 正在增加。

数据在这里（我使用 R:dput，您可以在 R 中复制并分配给您的对象）：

structure(list(patid = c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
2L, 3L, 3L, 3L), start_date = structure(c(1L, 2L, 3L, 4L, 5L, 
1L, 2L, 3L, 8L, 9L, 6L, 7L, 10L), .Label = c("1/1/2010", "2/1/2010", 
"3/1/2010", "4/1/2010", "5/1/2010", "5/6/2011", "7/1/2012", "8/1/2010", 
"9/1/2010", "9/1/2012"), class = "factor"), end_date = structure(c(1L, 
3L, 4L, 5L, 6L, 1L, 3L, 4L, 8L, 10L, 7L, 9L, 2L), .Label = c("1/31/2010", 
"12/1/2012", "2/28/2010", "3/31/2010", "4/30/2010", "5/31/2010", 
"6/15/2011", "8/31/2010", "8/31/2012", "9/30/2010"), class = "factor")), class = "data.frame", row.names = c(NA, 
-13L))

【问题讨论】：

在reproducible format 中分享示例更容易，因此我们可以复制/粘贴到 R 中进行测试。使用数据图片并不是很有趣。
谢谢，我学会了使用 dput！

标签： r

【解决方案1】：

data.table 方法（使用magrittr 以提高可读性）（强大的版本）：

library(data.table)
library(magrittr)

calc_cummax <- function(x) (setattr(cummax(unclass(x)), "class", c("Date", "IDate")))

df_merged <- setDT(df) %>%
  .[, `:=` (cont_start = as.Date(as.character(start_date), "%m/%d/%Y"),
            cont_end = as.Date(as.character(end_date), "%m/%d/%Y"))] %>%
  .[order(patid, start_date),] %>%
  .[, max_until_now := shift(calc_cummax(cont_end)), by = patid] %>%
  .[, lead_max := shift(max_until_now, type = "lead"), by = patid] %>%
  .[is.na(max_until_now), max_until_now := lead_max, by = patid] %>%
  .[(max_until_now + 1L) >= cont_start, gap_between_contracts := 0, by = patid] %>% 
  .[(max_until_now + 1L) < cont_start, gap_between_contracts := 1, by = patid] %>%
  .[is.na(gap_between_contracts), gap_between_contracts := 0] %>% 
  .[, ("fakeidx") := cumsum(gap_between_contracts), by = patid] %>%
  .[, .(cont_start = min(cont_start), cont_end = max(cont_end)), by = .(patid, fakeidx)] %>% 
  .[, ("fakeidx") := NULL]

在你的情况下输出：

   patid cont_start   cont_end
1:     1 2010-01-01 2010-05-31
2:     2 2010-01-01 2010-03-31
3:     2 2010-08-01 2010-09-30
4:     3 2011-05-06 2011-06-15
5:     3 2012-07-01 2012-12-01

tidyverse 方法（非稳健的简单版本）：

library(tidyverse)

df %>%
  mutate(
    cont_start = as.Date(as.character(start_date), "%m/%d/%Y"),
    cont_end = as.Date(as.character(end_date), "%m/%d/%Y")
  ) %>%
  arrange(patid, cont_start) %>%
  group_by(patid) %>%
  mutate(
    idx = cumsum(coalesce(as.numeric(cont_start != (lag(cont_end) + 1)), 0))
  ) %>%
  group_by(patid, idx) %>%
  summarise(
    cont_start = min(cont_start),
    cont_end = max(cont_end)
  ) %>% select(-idx)

输出：

# A tibble: 5 x 3
# Groups:   patid [3]
  patid cont_start cont_end  
  <int> <date>     <date>    
1     1 2010-01-01 2010-05-31
2     2 2010-01-01 2010-03-31
3     2 2010-08-01 2010-09-30
4     3 2011-05-06 2011-06-15
5     3 2012-07-01 2012-12-01

在您的情况下，输出是相同的，但如果在任何时候发生这种情况，您的序列中的开始日期会比更晚的开始日期更早，那么您需要选择第一种（稳健的）方法（当然，如果您不认为这是一个错误）。

在这种情况下，鲁棒性与data.table 或tidyverse 没有任何关系（您也可以通过重写tidyverse 版本来使用calc_cummax 函数，但您需要加载@987654332 @)。

【讨论】：