tests/testthat/test-methods.R

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

# Coverage for the S3 methods: predict, print, trim, dumpDSA.

test_that("trim reduces the model to the requested number of partitions", {
  d <- make_matrix_data()
  m <- partDSA(d$X, d$yN, control = ctl0(loss.function = "L2"))
  t2 <- trim(m, 2)
  expect_length(t2$IkPn, 2)
  expect_length(t2$coefficients, 2)
  expect_warning(trim(m, 99), "larger than current")
  expect_error(trim(m, 0), "greater than zero")
})

test_that("print.partDSA runs for each outcome type", {
  d <- make_matrix_data()
  expect_output(print(partDSA(d$X, d$yN, control = ctl0(loss.function = "L2"))),
                "partDSA object")
  expect_output(print(partDSA(d$X, d$yF, control = ctl0(loss.function = "entropy"))),
                "partDSA object")
})

test_that("dumpDSA produces well-formed XML for every outcome type", {
  d <- make_matrix_data()
  fits <- list(
    numeric  = partDSA(d$X,  d$yN, control = ctl0(loss.function = "L2")),
    factor   = partDSA(d$X,  d$yF, control = ctl0(loss.function = "entropy")),
    survival = partDSA(d$Xn, d$yS, control = ctl0(loss.function = "IPCW"))
  )
  for (nm in names(fits)) {
    f <- tempfile(fileext = ".xml")
    dumpDSA(fits[[nm]], file = f)
    xml <- readLines(f, warn = FALSE)
    expect_true(any(grepl("<partdsaobj>", xml)), info = nm)
    expect_true(any(grepl("</partdsaobj>", xml)), info = nm)
    expect_true(any(grepl("<partition ", xml)), info = nm)
  }
})

test_that("predict on new data returns predictions of the right shape", {
  d <- make_matrix_data()
  m <- partDSA(d$X, d$yN, control = ctl0(loss.function = "L2"))
  newx <- d$X[1:10, ]
  p <- predict(m, newx)
  expect_equal(nrow(p), 10)
  expect_equal(ncol(p), length(m$IkPn))
})