tests/testthat/test-tsesimp.R

In trtswitch: Treatment Switching

library(dplyr, warn.conflicts = FALSE)

testthat::test_that("tsesimp: weibull aft", {
  # the eventual survival time
  shilong1 <- shilong %>%
    arrange(bras.f, id, tstop) %>%
    group_by(bras.f, id) %>%
    slice(n()) %>%
    select(-c("ps", "ttc", "tran"))
  
  # the last value of time-dependent covariates before pd
  shilong2 <- shilong %>%
    filter(pd == 0 | tstart <= dpd) %>%
    arrange(bras.f, id, tstop) %>%
    group_by(bras.f, id) %>%
    slice(n()) %>%
    select(bras.f, id, ps, ttc, tran)
  
  # combine baseline and time-dependent covariates
  shilong3 <- shilong1 %>%
    left_join(shilong2, by = c("bras.f", "id"))
  
  # apply the two-stage method
  fit1 <- tsesimp(
    data = shilong3, time = "tstop", event = "event",
    treat = "bras.f", censor_time = "dcut", pd = "pd",
    pd_time = "dpd", swtrt = "co", swtrt_time = "dco",
    base_cov = c("agerand", "sex.f", "tt_Lnum", "rmh_alea.c",
                 "pathway.f"),
    base2_cov = c("agerand", "sex.f", "tt_Lnum", "rmh_alea.c",
                  "pathway.f", "ps", "ttc", "tran"),
    aft_dist = "weibull", alpha = 0.05,
    recensor = TRUE, swtrt_control_only = FALSE, offset = 1,
    boot = FALSE)

  # numeric code of treatment and apply administrative censoring
  data1 <- shilong3 %>% 
    mutate(treated = 1*(bras.f == "MTA"),
           swtrt = 1*co)
  
  tablist <- lapply(0:1, function(h) {
    df1 <- data1 %>% 
      filter(treated == h & pd == 1) %>%
      mutate(time = tstop - dpd + 1)
    
    fit_aft <- liferegr(df1, time = "time", event = "event", 
                        covariates = c("swtrt", "agerand", "sex.f", 
                                       "tt_Lnum", "rmh_alea.c", "pathway.f",
                                       "ps", "ttc", "tran"), 
                        dist = "weibull")
    
    psi = -fit_aft$beta[2]

    data1 %>% 
      filter(treated == h) %>%
      mutate(u_star = ifelse(swtrt == 1, 
                             ifelse(pd == 1, dpd-1 + (tstop-dpd+1)*exp(psi), 
                                    dco-1 + (tstop-dco+1)*exp(psi)), tstop),
             c_star = pmin(dcut, dcut*exp(psi)),
             t_star = pmin(u_star, c_star),
             d_star = event*(u_star <= c_star))
  })
  
  data2 <- do.call(rbind, tablist)
  
  fit <- phregr(data2, time = "t_star", event = "d_star", 
                covariates = c("treated", "agerand", "sex.f", 
                               "tt_Lnum", "rmh_alea.c", "pathway.f"))
  
  hr1 <- exp(as.numeric(c(fit$parest$beta[1], fit$parest$lower[1], 
                          fit$parest$upper[1])))
  testthat::expect_equal(hr1, c(fit1$hr, fit1$hr_CI))
})