tests/testthat/test-estimNLR.R

In difNLR: DIF and DDF Detection by Non-Linear Regression Models

test_that("estimNLR - examples at help page", {
  # skip_on_cran()
  # skip_on_os("linux")

  # loading data
  data(GMAT)
  y <- GMAT[, 1] # item 1
  match <- scale(rowSums(GMAT[, 1:20])) # standardized total score
  group <- GMAT[, "group"] # group membership variable

  # formula for 3PL model with the same guessing for both groups,
  # IRT parameterization
  M <- formulaNLR(model = "3PLcg", type = "both", parameterization = "irt")

  # starting values for 3PL model with the same guessing for item 1
  start <- startNLR(GMAT[, 1:20], group, model = "3PLcg", parameterization = "irt")
  start <- start[[1]][M$M1$parameters]

  # nonlinear least squares
  expect_snapshot((fit_nls <- estimNLR(
    y = y, match = match, group = group,
    formula = M$M1$formula, method = "nls",
    lower = M$M1$lower, upper = M$M1$upper, start = start
  )))
  # saveRDS(fit_nls, file = "tests/testthat/fixtures/estimNLR_fit_nls.rds")
  fit_nls_expected <- readRDS(test_path("fixtures", "estimNLR_fit_nls.rds"))
  expect_equal(fit_nls, fit_nls_expected)
  expect_snapshot(coef(fit_nls))
  expect_snapshot(logLik(fit_nls))
  expect_snapshot(vcov(fit_nls))
  expect_snapshot(vcov(fit_nls, sandwich = TRUE))
  expect_snapshot(fitted(fit_nls))
  expect_snapshot(residuals(fit_nls))

  # maximum likelihood method
  expect_snapshot((fit_mle <- estimNLR(
    y = y, match = match, group = group,
    formula = M$M1$formula, method = "mle",
    lower = M$M1$lower, upper = M$M1$upper, start = start
  )))
  # saveRDS(fit_mle, file = "tests/testthat/fixtures/estimNLR_fit_mle.rds")
  fit_mle_expected <- readRDS(test_path("fixtures", "estimNLR_fit_mle.rds"))
  expect_equal(fit_mle, fit_mle_expected)
  expect_snapshot(coef(fit_mle))
  expect_snapshot(logLik(fit_mle))
  expect_snapshot(vcov(fit_mle))
  expect_snapshot(fitted(fit_mle))
  expect_snapshot(residuals(fit_mle))

  # formula for 3PL model with the same guessing for both groups
  # intercept-slope parameterization
  M <- formulaNLR(model = "3PLcg", type = "both", parameterization = "is")

  # starting values for 3PL model with the same guessing for item 1,
  start <- startNLR(GMAT[, 1:20], group, model = "3PLcg", parameterization = "is")
  start <- start[[1]][M$M1$parameters]

  # EM algorithm
  expect_snapshot((fit_em <- estimNLR(
    y = y, match = match, group = group,
    formula = M$M1$formula, method = "em",
    lower = M$M1$lower, upper = M$M1$upper, start = start
  )))
  # saveRDS(fit_em, file = "tests/testthat/fixtures/estimNLR_fit_em.rds")
  fit_em_expected <- readRDS(test_path("fixtures", "estimNLR_fit_em.rds"))
  expect_equal(fit_em, fit_em_expected)
  expect_snapshot(coef(fit_em))
  expect_snapshot(logLik(fit_em))
  expect_snapshot(vcov(fit_em))
  expect_snapshot(fitted(fit_em))
  expect_snapshot(residuals(fit_em))

  # PLF algorithm
  expect_snapshot((fit_plf <- estimNLR(
    y = y, match = match, group = group,
    formula = M$M1$formula, method = "plf",
    lower = M$M1$lower, upper = M$M1$upper, start = start
  )))
  # saveRDS(fit_plf, file = "tests/testthat/fixtures/estimNLR_fit_plf.rds")
  fit_plf_expected <- readRDS(test_path("fixtures", "estimNLR_fit_plf.rds"))
  expect_equal(fit_plf, fit_plf_expected)
  expect_snapshot(coef(fit_plf))
  expect_snapshot(logLik(fit_plf))
  expect_snapshot(vcov(fit_plf))
  expect_snapshot(fitted(fit_plf))
  expect_snapshot(residuals(fit_plf))

  # iteratively reweighted least squares for 2PL model
  M <- formulaNLR(model = "2PL", parameterization = "logistic")
  expect_snapshot((fit_irls <- estimNLR(
    y = y, match = match, group = group,
    formula = M$M1$formula, method = "irls"
  )))
  # saveRDS(fit_irls, file = "tests/testthat/fixtures/estimNLR_fit_irls.rds")
  fit_irls_expected <- readRDS(test_path("fixtures", "estimNLR_fit_irls.rds"))
  expect_equal(fit_irls, fit_irls_expected)
  expect_snapshot(coef(fit_irls))
  expect_snapshot(logLik(fit_irls))
  expect_snapshot(vcov(fit_irls))
  expect_snapshot(fitted(fit_irls))
  expect_snapshot(residuals(fit_irls))
})