tests/testthat/test-mml-regression.R

In IRTC: Marginal Maximum Likelihood Estimation for Item Response Models

# Numerical regression: irtc.mml must reproduce IRTC's baselined estimates on
# the bundled example data. Reference fixtures are generated by irtc.mml itself
# (see scripts/gen_reference.R) and act as a self-contained regression oracle.

test_that("irtc.mml reproduces baselined Rasch estimates", {
  data(data.sim.rasch)
  m <- irtc.mml(resp = data.sim.rasch, verbose = FALSE)
  ref <- readRDS(test_path("fixtures", "ref_rasch.rds"))
  expect_equal(as.numeric(m$xsi$xsi), ref$xsi, tolerance = 1e-6)
  expect_equal(as.numeric(m$beta), ref$beta, tolerance = 1e-6)
  expect_equal(as.numeric(m$variance), ref$variance, tolerance = 1e-6)
  expect_equal(as.numeric(m$deviance), ref$deviance, tolerance = 1e-6)
})

test_that("irtc.mml reproduces baselined PCM estimates", {
  data(data.gpcm)
  m <- irtc.mml(resp = data.gpcm, irtmodel = "PCM", verbose = FALSE)
  ref <- readRDS(test_path("fixtures", "ref_pcm.rds"))
  expect_equal(as.numeric(m$xsi$xsi), ref$xsi, tolerance = 1e-6)
  expect_equal(as.numeric(m$deviance), ref$deviance, tolerance = 1e-6)
})

test_that("irtc.mml produces an irtc-classed object with working methods", {
  data(data.sim.rasch)
  m <- irtc.mml(resp = data.sim.rasch, verbose = FALSE)
  expect_s3_class(m, "irtc")
  ll <- logLik(m)
  expect_true(is.finite(as.numeric(ll)))
  expect_true(attr(ll, "df") > 0)
  expect_output(print(m))
  invisible(capture.output(summary(m)))
  expect_true(TRUE)
})

test_that("irtc.mml supports multidimensional models", {
  data(data.sim.rasch)
  # two-dimensional model: split items across two dimensions
  I <- ncol(data.sim.rasch)
  Q <- matrix(0, nrow = I, ncol = 2)
  Q[1:(I %/% 2), 1] <- 1
  Q[(I %/% 2 + 1):I, 2] <- 1
  m <- irtc.mml(resp = data.sim.rasch, Q = Q, verbose = FALSE)
  expect_s3_class(m, "irtc")
  expect_equal(dim(m$variance), c(2L, 2L))
  expect_true(is.finite(as.numeric(m$deviance)))
})