Firstly, you should convert your string dates into Date
-classed values, which will make comparison possible. Here's how I've defined and coerced your data:
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
Now, my solution involves computing an "overlapping grouping" vector which I've called og
. It makes the assumption that the input df
is ordered by ID
and then before.date
, which it is in your example data. If not, this could be achieved by df[order(df$ID,df$before.date),]
. Here's how I compute 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
Unfortunately, the base R cummax()
function doesn't work on Date
-classed objects, so I had to write a cummax.Date()
shim. I'll explain the need for the ave()
and cummax()
business at the end of the post.
As you can see, the above computation lags the RHS of each of the two vectorized comparisons by excluding the first element via [-1]
. This allows us to compare a record's ID
for equality with the following record's ID
, and also compare if its after.date
is after the before.date
of the following record. The resulting logical vectors are ANDed (&
) together. The negation of that logical vector then represents adjacent pairs of records that do not overlap, and thus we can cumsum()
the result (and prepend zero, as the first record must start with zero) to get our grouping vector.
Finally, for the final piece of the solution, I've used by()
to work with each overlapping group independently:
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
Since all records in a group must have the same ID
, and we've made the assumption that records are ordered by before.date
(after being ordered by ID
, which is no longer relevant), we can get the correct ID
and before.date
values from the first record in the group. That's why I started with g[1,]
. Then we just need to get the greatest after.date
from the group via max(g$after.date)
, and overwrite the first record's after.date
with that, which I've done with transform()
.
A word about performance: The assumption about ordering aids performance, because it allows us to simply compare each record against the immediately following record via lagged vectorized comparisons, rather than comparing every record in a group with every other record.
Now, for the ave()
and cummax()
business. I realized after writing the initial version of my answer that there was a flaw in my solution, which happens to not be exposed by your example data. Say there are three records in a group. If the first record has a range that overlaps with both of the following two records, and then the middle record does not overlap with the third record, then my (original) code would fail to identify that the third record is part of the same overlapping group of the previous two records.
The solution is to not simply use the after.date
of the current record when comparing against the following record, but instead use the cumulative maximum after.date
within the group. If any earlier record sprawled completely beyond its immediately following record, then it obviously overlapped with that record, and its after.date
is what's important in considering overlapping groups for subsequent records.
Here's a demonstration of input data that requires this fix, using your df
as a base:
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
Now record 6 overlaps with both records 7 and 8, but record 7 does not overlap with record 8. The solution still works:
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
Here's a proof that the og
calculation would be wrong without the ave()
/cummax()
fix:
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
Minor adjustment to the solution, to overwrite after.date
in advance of the og
computation, and avoid the max()
call (makes more sense if you're planning on overwriting the original df
with the new aggregation):
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