Splitting days into episode identifiers and start days - r

Question

I have a dataset of event days (in a date format), and each event belongs to an (unknown) episode. I want to categorize the events into episodes in such a way that all events within 180 days of the first day of the episode are considered part of the same episode, and the first day of the episode is assigned to all events part of that episode. For example, given a vector of event dates
event_dates <- c(34, 102, 190, 202, 245, 460, 500, 517)
I'm hoping to get a vector of episode IDs
c(1, 1, 1, 1, 2, 3, 3, 3)
and a vector of episode start days
c(34, 34, 34, 34, 245, 460, 460, 460)
This 5th entry begins a new episode because it is more than 180 days after the first date of the first episode; the 6th entry begins a new episode because it is more than 180 days after the first date of the second episode, etc.
I have do perform this operation on millions of separate patients, so ideally I would prefer a vectorized solution that could work with by in a data.table or in grouped tibble even if it is a bit opaque over a readable but slow solution, which I currently have. Thanks!

Answer 1

Using event_dates from the Note at the end (copied from the question) here are two approaches.
1) Reduce Use Reduce to loop through the events:
f <- function(base, x) if (x > base + 180) x else base
st <- Reduce(f, init = -Inf, event_dates, acc = TRUE)[-1]; st
## [1] 34 34 34 34 245 460 460 460
as.numeric(factor(st))
## [1] 1 1 1 1 2 3 3 3
2) for loop Loop through the values maintaining a variable base that is the latest baes value.
base <- -Inf
st <- event_dates
for(i in seq_along(event_dates)) {
if (st[i] > base + 180) base <- st[i]
st[i] <- base
}
st
## [1] 34 34 34 34 245 460 460 460
as.numeric(factor(out))
## [1] 1 1 1 1 2 3 3 3
3) C++
Create a file called event_dates.cpp in the current directory containing:
// To build & load: library(Rcpp); source("event_dates.cpp")
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
NumericVector grouper(NumericVector x) {
NumericVector y(clone(x));
int n = y.size();
double base = y[0] - 200;
for(int i = 0; i < n; i++) {
if (y[i] > base + 180.0) base = y[i];
y[i] = base;
}
return y;
}
and then run this.
library(Rcpp)
sourceCpp("event_dates.cpp")
st <- grouper(event_dates); st
## [1] 34 34 34 34 245 460 460 460
as.numeric(factor(st))
## [1] 1 1 1 1 2 3 3 3
Note
event_dates <- c(34, 102, 190, 202, 245, 460, 500, 517)

Answer 2

Using a while loop
event_grp <- event_dates
tmp <- event_dates
index <- rep(1, length(event_dates))
i <- 1
while(TRUE) {
to_compare <- event_dates[i]
i1 <- which((tmp - to_compare) > 180)[1] -1
if(is.na(i1)) i1 <- length(event_dates)
event_grp[i:i1] <- to_compare
if(i > 1) index[i:i1] <- index[i-1] + 1
tmp[i:i1] <- NA
if(i1 == length(event_dates)) break
i <- i1+1
}
-output
> event_grp
[1] 34 34 34 34 245 460 460 460
> index
[1] 1 1 1 1 2 3 3 3