tests/testthat/test-golden.R

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

# Golden-value regression tests.
#
# These lock in the numeric output of deterministic (vfold = 1) fits so
# that later refactoring / optimization cannot silently change results.
# If an intended algorithm change updates these numbers, update the
# expected values here in the same commit and explain why.

tol <- 1e-4

test_that("numeric L2 fit reproduces reference risks, coefs and predictions", {
  d <- make_matrix_data()
  m <- partDSA(d$X, d$yN, control = ctl0(loss.function = "L2"))

  expect_equal(unlist(m$IkPn.risks),
               c(5.973681, 3.42354, 2.36776, 2.07154), tolerance = tol)
  expect_equal(as.numeric(m$test.set.risk.DSA),
               c(5.973681, 3.423536, 2.367757, 2.07154), tolerance = tol)

  pred <- predict(m, d$X)
  expect_equal(dim(pred), c(nrow(d$X), 4L))
  expect_equal(pred[1:5, 4],
               c(1.153989, -2.520614, -1.099134, -1.099134, -1.099134),
               tolerance = tol)
  expect_equal(as.numeric(m$coefficients[[4]]),
               c(-1.099134, -4.016545, -1.42148, 2.253122, 0), tolerance = tol)
})

test_that("factor entropy fit reproduces reference risks and class predictions", {
  d <- make_matrix_data()
  m <- partDSA(d$X, d$yF, control = ctl0(loss.function = "entropy"))

  expect_equal(unlist(m$IkPn.risks),
               c(0.693147, 0.24939, 0.1848, 0.32278), tolerance = tol)
  expect_equal(as.numeric(m$test.set.risk.DSA),
               c(0.5, 0.215, 0.115, 0.105), tolerance = tol)

  pred <- predict(m, d$X)               # list, one factor per partition size
  expect_type(pred, "list")
  expect_s3_class(pred[[4]], "factor")
  expect_equal(levels(pred[[4]]), c("hi", "lo"))
  expect_equal(as.character(pred[[4]][1:8]),
               c("hi", "lo", "hi", "hi", "lo", "hi", "hi", "hi"))
})

test_that("survival IPCW (KM) fit reproduces reference risks and predictions", {
  d <- make_matrix_data()
  m <- partDSA(d$Xn, d$yS, control = ctl0(loss.function = "IPCW", wt.method = "KM"))

  expect_equal(unlist(m$IkPn.risks),
               c(5.167322, 3.00944, 2.82602, 2.71112), tolerance = tol)
  expect_equal(as.numeric(m$test.set.risk.DSA),
               c(5.167322, 3.009443, 2.826022, 2.711121), tolerance = tol)
  expect_equal(predict(m, d$Xn)[1:5, 4],
               c(5.573522, 0.891795, 0.891795, 2.649794, 0.891795),
               tolerance = tol)
})

test_that("survival single-cutpoint Brier reproduces reference risk", {
  d <- make_matrix_data()
  m <- partDSA(d$Xn, d$yS, control = ctl0(loss.function = "Brier"))
  expect_equal(as.numeric(m$test.set.risk.DSA),
               c(0.228262, 0.199145, 0.191353, 0.185758), tolerance = tol)
})