tests/testthat/test-cuminc-broom_methods.R

In tidycmprsk: Competing Risks Estimation

test_that("broom methods", {
  cuminc1 <- cuminc(Surv(ttdeath, death_cr) ~ 1, trial)
  cuminc2 <- cuminc(Surv(ttdeath, death_cr) ~ trt, trial)
  cmprsk_cuminc1 <-
    cmprsk::cuminc(
      ftime = trial$ttdeath,
      fstatus = as.numeric(trial$death_cr) - 1L
    )
  cmprsk_cuminc2 <-
    cmprsk::cuminc(
      ftime = trial$ttdeath,
      fstatus = as.numeric(trial$death_cr) - 1L,
      group = trial$trt
    )
  tidy_survfit1_cancer <-
    survival::survfit(Surv(ttdeath, death_cr == "death from cancer") ~ 1, trial) %>%
    broom::tidy()
  survfit1_cancer_times <- summary(survival::survfit(Surv(ttdeath, death_cr == "death from cancer") ~ 1, trial), times = c(0, 5, 10, 15, 20))
  tidy_survfit1_other <-
    survival::survfit(Surv(ttdeath, death_cr == "death from cancer") ~ 1, trial) %>%
    broom::tidy()
  tidy_survfit2_cancer <-
    survival::survfit(Surv(ttdeath, death_cr == "death from cancer") ~ trt, trial) %>%
    broom::tidy()
  tidy_survfit2_other <-
    survival::survfit(Surv(ttdeath, death_cr == "death from cancer") ~ trt, trial) %>%
    broom::tidy()

  tidy_survfit1_cancer_censor <-
    survival::survfit(Surv(ttdeath, death_cr != "censor") ~ 1, trial) %>%
    broom::tidy()
  tidy_survfit2_cancer_censor <-
    survival::survfit(Surv(ttdeath, death_cr != "censor") ~ trt, trial) %>%
    broom::tidy()

  expect_equal(
    tidy(cuminc1, times = 15) %>%
      dplyr::pull(estimate),
    cmprsk::timepoints(cmprsk_cuminc1, times = 15)$est %>% c()
  )
  expect_equal(
    tidy(cuminc1, times = 15) %>%
      dplyr::pull(std.error),
    cmprsk::timepoints(cmprsk_cuminc1, times = 15)$var %>% sqrt() %>% c()
  )

  expect_equal(
    tidy(cuminc2, times = 15) %>%
      dplyr::arrange(outcome) %>%
      dplyr::pull(estimate),
    cmprsk::timepoints(cmprsk_cuminc2, times = 15)$est %>% c()
  )

  expect_equal(
    tidy(cuminc1, times = 15) %>%
      dplyr::arrange(outcome) %>%
      dplyr::pull(std.error),
    cmprsk::timepoints(cmprsk_cuminc1, times = 15)$var %>% sqrt() %>% c()
  )

  expect_false(
    identical(
      cuminc1 %>% tidy(times = c(12, 24)),
      cuminc1 %>% tidy(times = c(12, 24), conf.level = 0.90)
    )
  )
  expect_true(
    !any(c("conf.low", "conf.high") %in%
      names(cuminc1 %>% tidy(times = c(12, 24), conf.int = FALSE)))
  )

  expect_error(
    glance(cuminc2),
    NA
  )
  expect_error(
    cuminc2_tidy <- tidy(cuminc2),
    NA
  )
  expect_equal(
    cuminc2_tidy,
    cuminc2$tidy
  )

  expect_error(
    glance(cuminc1),
    NA
  )
  expect_error(
    cuminc1_tidy <- tidy(cuminc1),
    NA
  )
  expect_equal(
    cuminc1_tidy,
    cuminc1$tidy
  )

  # checking n.risk, n.event, and n.censor for a stratified estimate
  # checking tidycmprsk numbers against `survfit() %>% tidy()`
  survfit_check2 <-
    cuminc2_tidy %>%
    filter(outcome == "death from cancer") %>%
    mutate(strata = paste0("trt=", strata)) %>%
    select(outcome, strata, time, n.risk, n.event) %>%
    dplyr::inner_join(
      tidy_survfit2_cancer %>%
        select(strata, time, n.risk, n.event),
      by = c("strata", "time")
    )
  survfit_censor_check2 <-
    cuminc2_tidy %>%
    filter(outcome == "death from cancer") %>%
    mutate(strata = paste0("trt=", strata)) %>%
    select(outcome, strata, time, n.censor) %>%
    dplyr::inner_join(
      tidy_survfit2_cancer_censor %>%
        select(strata, time, n.censor),
      by = c("strata", "time")
    )
  survfit_censor_check1 <-
    cuminc1_tidy %>%
    filter(outcome == "death from cancer") %>%
    select(outcome, time, n.censor) %>%
    dplyr::inner_join(
      tidy_survfit1_cancer_censor %>%
        select(time, n.censor),
      by = c("time")
    )


  expect_equal(
    survfit_censor_check2$n.censor.x,
    survfit_censor_check2$n.censor.y
  )
  expect_equal(
    survfit_censor_check1$n.censor.x,
    survfit_censor_check1$n.censor.y
  )
  expect_equal(
    survfit_check2$n.risk.x,
    survfit_check2$n.risk.y
  )
  expect_equal(
    survfit_check2$n.event.x,
    survfit_check2$n.event.y
  )

  # checking n.risk, n.event, and n.censor for an  unstratified estimate
  # checking tidycmprsk numbers against `survfit() %>% tidy()`
  survfit_check1 <-
    cuminc1_tidy %>%
    filter(outcome == "death from cancer") %>%
    select(time, n.risk, n.event) %>%
    dplyr::inner_join(
      tidy_survfit1_cancer %>%
        select(time, n.risk, n.event),
      by = c("time")
    )

  expect_equal(
    survfit_check1$n.risk.x,
    survfit_check1$n.risk.y
  )
  expect_equal(
    survfit_check1$n.event.x,
    survfit_check1$n.event.y
  )

  # Selected time points

  cuminc1_tidy_time <- tidy(cuminc1, times = c(0, 5, 10, 15, 20))
  survfit_check1_time <-
    cuminc1_tidy_time %>%
    filter(outcome == "death from cancer") %>%
    select(time, n.risk, n.event) %>%
    dplyr::inner_join(
      data.frame(
        time = survfit1_cancer_times$time,
        n.risk = survfit1_cancer_times$n.risk,
        n.event = survfit1_cancer_times$n.event
      ),
      by = c("time")
    )

  expect_equal(
    survfit_check1_time$n.risk.x,
    survfit_check1_time$n.risk.y
  )

  expect_equal(
    survfit_check1_time$n.event.x,
    survfit_check1_time$n.event.y
  )


  # all estimates fall within CI
  expect_true(
    cuminc2_tidy %>%
      dplyr::rowwise() %>%
      mutate(
        check =
          dplyr::between(estimate, conf.low, conf.high) |
            (estimate == 0 & is.na(conf.low) & is.na(conf.high))
      ) %>%
      dplyr::pull(check) %>%
      all()
  )

  # when estimate is zero, the other estimates fall in line with that
  expect_true(
    cuminc2_tidy %>%
      filter(estimate == 0) %>%
      mutate(
        check =
          estimate == 0 & std.error == 0 &
            is.na(conf.low) & is.na(conf.high) &
            n.event == 0 & n.censor == 0
      ) %>%
      dplyr::pull(check) %>%
      all()
  )

  expect_error(
    cuminc_tidy2 <- tidy(cuminc2, conf.int = FALSE, times = c(0, 12)),
    NA
  )
  expect_equal(
    cuminc_tidy2$cum.censor,
    rep_len(0L, 8)
  )
  expect_equal(
    cuminc_tidy2 %>%
      dplyr::arrange(strata, outcome, time) %>%
      dplyr::pull(cum.event),
    trial %>%
      dplyr::filter(death == 1) %>%
      tidyr::nest(data = -c(trt, death_cr)) %>%
      dplyr::rowwise() %>%
      dplyr::mutate(
        time = list(c(0, 12)),
        cum.event =
          c(
            dplyr::filter(data, ttdeath <= time[1]) %>% nrow(),
            dplyr::filter(data, ttdeath <= time[2]) %>% nrow()
          ) %>%
          list()
      ) %>%
      tidyr::unnest(cols = c(time, cum.event)) %>%
      dplyr::arrange(trt, death_cr, time) %>%
      dplyr::pull(cum.event)
  )



  expect_error(
    cuminc_tidy1 <- tidy(cuminc1, conf.int = FALSE, times = c(0, 12)),
    NA
  )
  expect_equal(
    cuminc_tidy1$n.censor,
    rep_len(0L, 4)
  )
  expect_equal(
    cuminc_tidy1$cum.censor,
    rep_len(0L, 4)
  )
  expect_equal(
    cuminc_tidy1$cum.event,
    c(0L, 12L, 0L, 11L)
  )

  # testing tidy with problematic times
  expect_message(
    tidy_cuminc1_time <- cuminc1 %>% tidy(times = c(-1, 0, 150))
  )
  expect_equal(
    tidy_cuminc1_time$time,
    c(0, 150, 0, 150)
  )
  expect_equal(
    tidy_cuminc1_time$estimate,
    c(0, NA, 0, NA)
  )
  expect_equal(
    tidy_cuminc1_time$std.error,
    c(0, NA, 0, NA)
  )
  expect_equal(
    tidy_cuminc1_time$conf.low,
    c(NA_real_, NA_real_, NA_real_, NA_real_)
  )
  expect_equal(
    tidy_cuminc1_time$conf.high,
    c(NA_real_, NA_real_, NA_real_, NA_real_)
  )
  expect_equal(
    tidy_cuminc1_time$n.risk,
    c(200L, 0L, 200L, 0L)
  )
  expect_equal(
    tidy_cuminc1_time$n.event,
    trial %>%
      dplyr::filter(death == 1) %>%
      tidyr::nest(data = -c(death_cr)) %>%
      dplyr::rowwise() %>%
      dplyr::mutate(
        time = list(c(0, 150)),
        n.event =
          c(
            dplyr::filter(data, ttdeath <= time[1]) %>% nrow(),
            dplyr::filter(data, ttdeath > time[1], ttdeath <= time[2]) %>% nrow()
          ) %>%
          list()
      ) %>%
      tidyr::unnest(cols = c(time, n.event)) %>%
      dplyr::arrange(death_cr, time) %>%
      dplyr::pull(n.event)
  )
  expect_equal(
    tidy_cuminc1_time$n.censor,
    c(0L, 88L, 0L, 88L)
  )

  # testing that n.event over intervals is correct when 0 is and is not specified
  tt <- cuminc(Surv(ttdeath, death_cr) ~ 1, trial)

  expect_equal(
    tidy(tt, times = c(0, 24)) %>%
      dplyr::select(time, outcome, estimate, n.event, n.censor) %>%
      dplyr::filter(time %in% 24),
    tidy(tt, times = c(24)) %>%
      dplyr::select(time, outcome, estimate, n.event, n.censor)
  )

  # checking factor class in internal tidy object
  trial2 <- trial
  levels(trial2$grade) <- c("III", "II", "I")
  expect_equal(
    cuminc(Surv(ttdeath, death_cr) ~ grade, data = trial2) %>%
      tidy(times = c(0, 24)) %>%
      purrr::pluck("strata") %>%
      levels(),
    c("III", "II", "I")
  )
})