首先,您应该将字符串日期转换为Date-classed 值,这样可以进行比较。以下是我定义和强制数据的方式:
df <- data.frame(ID=c(1,1,1,2,3,4,4,4), before.date=c('10/1/1996','1/1/1998','1/1/2000','1/1/2001','1/1/2001','1/1/2001','10/1/2004','10/3/2004'), after.date=c('12/1/1996','9/30/2003','12/31/2004','3/31/2006','9/30/2006','9/30/2005','12/30/2004','11/28/2004') );
dcis <- grep('date$',names(df));
df[dcis] <- lapply(df[dcis],as.Date,'%m/%d/%Y');
df;
## ID before.date after.date
## 1 1 1996-10-01 1996-12-01
## 2 1 1998-01-01 2003-09-30
## 3 1 2000-01-01 2004-12-31
## 4 2 2001-01-01 2006-03-31
## 5 3 2001-01-01 2006-09-30
## 6 4 2001-01-01 2005-09-30
## 7 4 2004-10-01 2004-12-30
## 8 4 2004-10-03 2004-11-28
现在,我的解决方案涉及计算一个“重叠分组”向量,我称之为og。它假设输入df 按ID 排序,然后是before.date,它在您的示例数据中。如果没有,这可以通过df[order(df$ID,df$before.date),] 来实现。这是我计算og的方法:
cummax.Date <- function(x) as.Date(cummax(as.integer(x)),'1970-01-01');
og <- with(df,c(0,cumsum(!(ID[-length(ID)]==ID[-1] & ave(after.date,ID,FUN=cummax)[-length(after.date)]>before.date[-1]))));
og;
## [1] 0 1 1 2 3 4 4 4
不幸的是,基本的 R cummax() 函数不适用于 Date 分类的对象,所以我不得不写一个 cummax.Date() shim。我会在文末解释ave() 和cummax() 业务的必要性。
如您所见,上述计算通过[-1] 排除第一个元素,滞后于两个矢量化比较中的每一个的 RHS。这使我们可以比较记录的ID 与以下记录的ID 是否相等,并比较其after.date 是否在以下记录的before.date 之后。得到的逻辑向量被 AND 在一起 (&)。然后该逻辑向量的否定表示相邻的记录对不重叠,因此我们可以cumsum()结果(并在前面加上零,因为第一条记录必须从零开始)得到我们的分组向量。
最后,对于解决方案的最后一部分,我使用by() 独立处理每个重叠组:
do.call(rbind,by(df,og,function(g) transform(g[1,],after.date=max(g$after.date))));
## ID before.date after.date
## 0 1 1996-10-01 1996-12-01
## 1 1 1998-01-01 2004-12-31
## 2 2 2001-01-01 2006-03-31
## 3 3 2001-01-01 2006-09-30
## 4 4 2001-01-01 2005-09-30
由于组中的所有记录必须具有相同的ID,并且我们假设记录按before.date 排序(在按ID 排序后,不再相关),我们可以从组中的第一条记录中获取正确的 ID 和 before.date 值。这就是我从g[1,] 开始的原因。然后我们只需要通过max(g$after.date)从组中获取最大的after.date,并用它覆盖第一条记录的after.date,我已经用transform()完成了。
关于性能的一句话:关于排序的假设有助于性能,因为它允许我们通过滞后矢量化比较简单地将每条记录与紧随其后的记录进行比较,而不是将组中的每条记录与其他记录进行比较。
现在,对于 ave() 和 cummax() 业务。在编写了答案的初始版本后,我意识到我的解决方案存在缺陷,而您的示例数据恰好没有暴露该缺陷。假设一个组中有三个记录。如果第一条记录的范围与以下两条记录中的 both 重叠,然后中间记录 not 与第三条记录重叠,那么我的(原始)代码将无法识别第三条记录是前两条记录的同一重叠组的一部分。
解决的办法是,在与后面的记录进行比较时,不要简单地使用当前记录的after.date,而是使用组内的累积最大值after.date。如果任何较早的记录完全超出其紧随其后的记录,那么它显然与该记录重叠,并且其after.date 是考虑后续记录的重叠组的重要因素。
以下是需要此修复的输入数据演示,使用您的 df 作为基础:
df2 <- df;
df2[7,'after.date'] <- '2004-10-02';
df2;
## ID before.date after.date
## 1 1 1996-10-01 1996-12-01
## 2 1 1998-01-01 2003-09-30
## 3 1 2000-01-01 2004-12-31
## 4 2 2001-01-01 2006-03-31
## 5 3 2001-01-01 2006-09-30
## 6 4 2001-01-01 2005-09-30
## 7 4 2004-10-01 2004-10-02
## 8 4 2004-10-03 2004-11-28
现在记录 6 与记录 7 和 8 重叠,但记录 7 不与记录 8 重叠。解决方案仍然有效:
cummax.Date <- function(x) as.Date(cummax(as.integer(x)),'1970-01-01');
og <- with(df2,c(0,cumsum(!(ID[-length(ID)]==ID[-1] & ave(after.date,ID,FUN=cummax)[-length(after.date)]>before.date[-1]))));
og;
## [1] 0 1 1 2 3 4 4 4
do.call(rbind,by(df2,og,function(g) transform(g[1,],after.date=max(g$after.date))));
## ID before.date after.date
## 0 1 1996-10-01 1996-12-01
## 1 1 1998-01-01 2004-12-31
## 2 2 2001-01-01 2006-03-31
## 3 3 2001-01-01 2006-09-30
## 4 4 2001-01-01 2005-09-30
这是一个证明,如果没有 ave()/cummax() 修复,og 计算将是错误的:
og <- with(df2,c(0,cumsum(!(ID[-length(ID)]==ID[-1] & after.date[-length(after.date)]>before.date[-1]))));
og;
## [1] 0 1 1 2 3 4 4 5
对解决方案的小幅调整,在og 计算之前覆盖after.date,并避免max() 调用(如果您计划用新聚合覆盖原始df,则更有意义):
cummax.Date <- function(x) as.Date(cummax(as.integer(x)),'1970-01-01');
df$after.date <- ave(df$after.date,df$ID,FUN=cummax);
df;
## ID before.date after.date
## 1 1 1996-10-01 1996-12-01
## 2 1 1998-01-01 2003-09-30
## 3 1 2000-01-01 2004-12-31
## 4 2 2001-01-01 2006-03-31
## 5 3 2001-01-01 2006-09-30
## 6 4 2001-01-01 2005-09-30
## 7 4 2004-10-01 2005-09-30
## 8 4 2004-10-03 2005-09-30
og <- with(df,c(0,cumsum(!(ID[-length(ID)]==ID[-1] & after.date[-length(after.date)]>before.date[-1]))));
og;
## [1] 0 1 1 2 3 4 4 4
df <- do.call(rbind,by(df,og,function(g) transform(g[1,],after.date=g$after.date[nrow(g)])));
df;
## ID before.date after.date
## 0 1 1996-10-01 1996-12-01
## 1 1 1998-01-01 2004-12-31
## 2 2 2001-01-01 2006-03-31
## 3 3 2001-01-01 2006-09-30
## 4 4 2001-01-01 2005-09-30