Function for adding time-dependent covariates and events to interval data

add-tdc.R

library(tidyverse)

add_tdc <- function(df, int, tdc = vars(), event = vars()) {
  nm <- names(df)
  original_cols <- nm

  int <- select_vars(nm, !!!int)
  tdc <- select_vars(nm, !!!tdc)
  stopifnot(length(int) == 2)

  a <- sym(int[1])
  b <- sym(int[2])

  timeline <- timeline(df, c(int, tdc))

  timeline %>%
    mutate_at(event, funs(lead(!!b) * .)) %>%
    mutate(.include = xor(!!a, !!b)) %>%
    mutate(!!a := .t, !!b := lead(.t)) %>%
    filter(.include) %>%
    select(!!!original_cols)
}

timeline <- function(df, vars, cumulative = TRUE) {
  timeline <- df %>%
    mutate(.row_id = row_number()) %>%
    gather(.var, .t, !!!vars) %>%
    mutate(.val = 1L) %>%
    spread(.var, .val, fill = 0L) %>%
    arrange(.row_id, .t)

  if (cumulative) {
    timeline %>%
      group_by(.row_id) %>%
      mutate_at(vars, cumsum) %>%
      ungroup()
  } else {
    timeline
  }
}

set.seed(1)

n <- 3
df <- data.frame(id = seq_len(n), a = 0)
df$b <- rpois(n, 10)
df$e <- rbernoulli(n)
df$x <- floor(runif(n, df$a, df$b + 1))
df$y <- floor(runif(n, df$a, df$b + 1))
df
#>   id a  b     e x y
#> 1  1 0  8  TRUE 1 3
#> 2  2 0 10  TRUE 1 8
#> 3  3 0  7 FALSE 5 3

df %>%
  add_tdc(vars(a, b), vars(x, y), vars(e))
#> # A tibble: 9 x 6
#>      id     a     b     e     x     y
#>   <int> <dbl> <dbl> <int> <int> <int>
#> 1     1     0     1     0     0     0
#> 2     1     1     3     0     1     0
#> 3     1     3     8     1     1     1
#> 4     2     0     1     0     0     0
#> 5     2     1     8     0     1     0
#> 6     2     8    10     1     1     1
#> 7     3     0     3     0     0     0
#> 8     3     3     5     0     0     1
#> 9     3     5     7     0     1     1

#' Created on 2018-08-27 by the [reprex package](http://reprex.tidyverse.org) (v0.2.0.9000).

Need to still add some logic to deal with TDCs having values not included in the given interval.