r语言 - 将观测结果与重叠日期相结合



我的数据框架中的每个观测值都包含不同的"before date"one_answers"after date"实例。问题是每个ID的一些日期重叠。例如,在下面的表中,ID的1和4包含重叠的日期值。

ID  before date after date
1   10/1/1996   12/1/1996
1   1/1/1998    9/30/2003
1   1/1/2000    12/31/2004
2   1/1/2001    3/31/2006
3   1/1/2001    9/30/2006
4   1/1/2001    9/30/2005
4   10/1/2004   12/30/2004
4   10/3/2004   11/28/2004

我想得到这样的东西:

ID  before date after date
1   10/1/1996   12/1/1996
1   1/1/1998    12/31/2004
2   1/1/2001    3/31/2006
3   1/1/2001    9/30/2006
4   1/1/2001    9/30/2005

基本上,我想用重叠的值的日期范围替换任何重叠的日期值,保留不重叠的值,并删除任何不必要的行。不知道该怎么做

首先,您应该将字符串日期转换为Date分类的值,这将使比较成为可能。以下是我如何定义和强制您的数据:

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之后。所得到的逻辑向量被和(&)在一起。然后,该逻辑向量的负值表示重叠的相邻记录对,因此我们可以将结果cumsum()(并在0之前加上0,因为第一个记录必须以0开头)以获得我们的分组向量。

最后,对于解决方案的最后一部分,我使用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排序之后,这不再相关),因此我们可以从组中的第一条记录中获得正确的IDbefore.date值。这就是为什么我从g[1,]开始。然后我们只需要通过max(g$after.date)从组中获得最大的after.date,并用它覆盖第一个记录的after.date,我已经用transform()完成了。

关于性能:排序的假设有助于性能,因为它允许我们通过滞后矢量化比较简单地将每条记录与紧跟其后的记录进行比较,而不是将组中的每条记录与其他每条记录进行比较。

现在,对于ave()cummax()业务。在写完我的答案的初始版本后,我意识到我的解决方案中有一个缺陷,而这个缺陷恰好没有被您的示例数据暴露出来。假设一组中有三张唱片。如果第一条记录的范围与下面两条记录的重叠,然后中间的记录不与第三条记录重叠,那么我的(原始)代码将无法识别第三条记录是前两条记录的相同重叠组的一部分。

解决方案是在与下一条记录比较时不简单地使用当前记录的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

最新更新