r - 为每个 ID 查找重叠日期并为重叠创建一个新行

Question

我想找到每个 ID 的重叠日期，并用重叠日期创建一个新行，并组合行的字符(char)。我的数据可能有 >2 次重叠并且需要 >2 种字符组合。例如。企业风险管理

数据:

ID    date1         date2       char
15  2003-04-05  2003-05-06      E
15  2003-04-20  2003-06-20      R
16  2001-01-02  2002-03-04      M
17  2003-03-05  2007-02-22      I   
17  2005-04-15  2014-05-19      C
17  2007-05-15  2008-02-05      I
17  2008-02-05  2012-02-14      M
17  2010-06-07  2011-02-14      V
17  2010-09-22  2014-05-19      P
17  2012-02-28  2013-03-04      R

我想要的输出:

ID  date1       date2           char
15  2003-04-05  2003-04-20      E
15  2003-04-20  2003-05-06      ER
15  2003-05-06  2003-06-20      R
16  2001-01-02  2002-03-04      M
17  2003-03-05  2005-04-15      I
17  2005-04-15  2007-02-22      IC
17  2005-04-15  2007-05-15      C   
17  2007-05-15  2008-02-05      CI
17  2008-02-05  2012-02-14      CM
17  2010-06-07  2011-02-14      CV
17  2010-09-22  2014-05-19      CP
17  2012-02-28  2013-03-04      CR
17  2014-05-19  2014-05-19      P
17  2010-06-07  2012-02-14      MV
17  2010-09-22  2011-02-14      VP
17  2012-02-28  2013-03-04      RP

我尝试过的:
我尝试使用以下方法从当前行中减去日期 2:

df$diff <- c(NA,df[2:nrow(tdf), "date1"] - df[1:(nrow(df)-1), "date2"])

然后确定行之间的重叠:

df$overlap[which(df$diff<1)] <-1
df$overlap.up <- c(df$overlap[2:(nrow(df))], "NA")
df$overlap.final[which(df$overlap==1 | df$overlap.up==1)] <- 1

然后我选择了那些有重叠的那些。final==1 并将它们放入另一个数据帧并找到每个 ID 的重叠。

但是，我意识到这过于简单和有缺陷，因为它只选择顺序发生的重叠(使用第一步中的日期差异)。我需要做的是获取每个 ID 的一系列日期并循环遍历每个组合以确定是否有重叠，然后，如果有，则记录开始和结束日期并创建一个新字符“char”，表明是什么在这两个日期期间合并。我想我需要一个循环来做到这一点。

我试图创建一个循环来查找 date1 和 date 2 之间的重叠间隔

df <- df[which(!duplicated(df$ ID)),]

for (i in 1:nrow(df)) {
  tmp <- length(which(df $ID[i] & (df$date1[i] >df$date1 & df$date1[i]< df$date2) | (df$date2[i] < df$date2&  df$date2[i]> df$date1))) >0
  df$int[i]<- tmp

}

但是，这不起作用。

确定重叠间隔后，我需要为每个新的开始日期和结束日期以及代表重叠的新字符创建新行。

我试图识别重叠的另一个版本的循环:

for (i in 1:nrow(df)) {
  if (df$ID[i]==IDs$ID){
  tmp <- length(df, df$ ID[i]==IDs$ & (df$date1[i]> df$date1 & df$date1 [i]< df$date2 | df$date2[i] < df$date2 &  df$date2[i]> df$date1)) >0
  df$int[i]<- tmp
  }
}

Answer 1

首先，我们为每个 data.table 创建一个包含所有可能间隔的 ID 。
所有可能的间隔意味着我们获取 ID 的所有开始和结束日期，并将它们组合在一个排序的向量 tmp 中。唯一值表示时间轴上 ID 的所有给定间隔的所有可能交叉点(或中断点)。对于以后的加入，中断会以每行一个间隔重新排列，包含一个 start 和一个 end 列:

library(data.table)
options(datatable.print.class = TRUE)
breaks <- DT[, {
  tmp <- unique(sort(c(date1, date2)))
  .(start = head(tmp, -1L), end = tail(tmp, -1L))
  }, by = ID]
breaks

       ID      start        end
    <int>     <IDat>     <IDat>
 1:    15 2003-04-05 2003-04-20
 2:    15 2003-04-20 2003-05-06
 3:    15 2003-05-06 2003-06-20
 4:    16 2001-01-02 2002-03-04
 5:    17 2003-03-05 2005-04-15
 6:    17 2005-04-15 2007-02-22
 7:    17 2007-02-22 2007-05-15
 8:    17 2007-05-15 2008-02-05
 9:    17 2008-02-05 2010-06-07
10:    17 2010-06-07 2010-09-22
11:    17 2010-09-22 2011-02-14
12:    17 2011-02-14 2012-02-14
13:    17 2012-02-14 2012-02-28
14:    17 2012-02-28 2013-03-04
15:    17 2013-03-04 2014-05-19

然后，执行非等连接，其中值在连接条件上同时聚合( by = .EACHI 被称为按每个 i 分组，有关更详细的说明，请参见 this answer):

DT[breaks, on = .(ID, date1 <= start, date2 >= end), paste(char, collapse = ""),  
   by = .EACHI, allow.cartesian = TRUE]

       ID      date1      date2     V1
    <int>     <IDat>     <IDat> <char>
 1:    15 2003-04-05 2003-04-20      E
 2:    15 2003-04-20 2003-05-06     ER
 3:    15 2003-05-06 2003-06-20      R
 4:    16 2001-01-02 2002-03-04      M
 5:    17 2003-03-05 2005-04-15      I
 6:    17 2005-04-15 2007-02-22     IC
 7:    17 2007-02-22 2007-05-15      C
 8:    17 2007-05-15 2008-02-05     CI
 9:    17 2008-02-05 2010-06-07     CM
10:    17 2010-06-07 2010-09-22    CMV
11:    17 2010-09-22 2011-02-14   CMVP
12:    17 2011-02-14 2012-02-14    CMP
13:    17 2012-02-14 2012-02-28     CP
14:    17 2012-02-28 2013-03-04    CPR
15:    17 2013-03-04 2014-05-19     CP

结果与 OP 发布的预期结果不同，但绘制数据表明上述结果显示了所有可能的重叠:

library(ggplot2)
ggplot(DT) + aes(y = char, yend = char, x = date1, xend = date2) + 
  geom_segment() + facet_wrap("ID", ncol = 1L) 

数据

library(data.table)
DT <- fread(
  "ID    date1         date2       char
15  2003-04-05  2003-05-06      E
15  2003-04-20  2003-06-20      R
16  2001-01-02  2002-03-04      M
17  2003-03-05  2007-02-22      I   
17  2005-04-15  2014-05-19      C
17  2007-05-15  2008-02-05      I
17  2008-02-05  2012-02-14      M
17  2010-06-07  2011-02-14      V
17  2010-09-22  2014-05-19      P
17  2012-02-28  2013-03-04      R"
)
cols <- c("date1", "date2")
DT[, (cols) := lapply(.SD, as.IDate), .SDcols = cols]