tests/testthat/test-survival-datalist.R

In partDSA: Partitioning Using Deletion, Substitution, and Addition Moves

# Regression test for the survival "datalist" path.
#
# Modern versions of the survival package return n (not 2n) from
# length(<Surv>).  The internal datafun() used to assert
#   n == length(y) %/% 2
# which silently failed for every survival fit, turning $datalist into
# NULL and printing a raw <simpleError> to the console.  See algAlone2.R.

make_surv_data <- function(n = 120, p = 4, seed = 1) {
  set.seed(seed)
  x <- data.frame(matrix(sample(1:100, n * p, replace = TRUE), n, p))
  names(x) <- paste0("X", seq_len(p))
  scale <- ifelse(x[[1]] > 50 | x[[2]] > 75, 5, 0.5)
  time <- -scale * log(1 - runif(n))              # exp / GPD(shape=0)
  cens <- rbinom(n, 1, 0.7)
  y <- survival::Surv(pmin(time, quantile(time, 0.95)), cens)
  list(x = x, y = y)
}

test_that("survival IPCW fit builds a non-NULL per-partition datalist", {
  d <- make_surv_data()
  ctrl <- DSA.control(vfold = 1, minsplit = 30, minbuck = 10,
                      cut.off.growth = 3, loss.function = "IPCW",
                      wt.method = "KM", missing = "no")

  expect_no_warning(
    fit <- partDSA(d$x, d$y, control = ctrl)
  )

  # datalist must exist, one entry per partition size, and hold Surv outcomes
  expect_false(is.null(fit$datalist))
  expect_length(fit$datalist, length(fit$IkPn))
  last <- fit$datalist[[length(fit$datalist)]]
  expect_true(survival::is.Surv(last[[1]]))

  # the total number of observations across partitions equals n
  total <- sum(vapply(last, NROW, integer(1)))
  expect_equal(total, nrow(d$x))
})

test_that("survival fit does not print a raw error object to the console", {
  d <- make_surv_data(seed = 7)
  ctrl <- DSA.control(vfold = 1, minsplit = 30, minbuck = 10,
                      cut.off.growth = 3, loss.function = "IPCW",
                      wt.method = "KM", missing = "no")
  out <- capture.output(fit <- partDSA(d$x, d$y, control = ctrl))
  expect_false(any(grepl("simpleError|is not TRUE", out)))
})