tests/testthat/test-bias-collection.R

In mfrmr: Estimation and Diagnostics for Many-Facet Measurement Models

bias_collection_fixture <- local({
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  dat <- mfrmr:::sample_mfrm_data(seed = 654)
  fit <- suppressWarnings(mfrmr::fit_mfrm(
    data = dat,
    person = "Person",
    facets = c("Rater", "Task", "Criterion"),
    score = "Score",
    method = "JML",
    maxit = 20
  ))
  diagnostics <- suppressWarnings(mfrmr::diagnose_mfrm(fit, residual_pca = "none"))
  bias_all <- suppressWarnings(mfrmr::estimate_all_bias(
    fit,
    diagnostics = diagnostics,
    max_iter = 2
  ))

  list(
    fit = fit,
    diagnostics = diagnostics,
    bias_all = bias_all
  )
})

test_that("estimate_all_bias batches all modeled facet pairs", {
  bias_all <- bias_collection_fixture$bias_all

  expect_s3_class(bias_all, "mfrm_bias_collection")
  expect_true(is.data.frame(bias_all$summary))
  expect_true(is.list(bias_all$by_pair))
  expect_true(all(c("Interaction", "Rows", "Significant", "Kept") %in% names(bias_all$summary)))
  expect_identical(
    sort(bias_all$summary$Interaction),
    sort(c("Rater x Task", "Rater x Criterion", "Task x Criterion"))
  )
  expect_true(length(bias_all$by_pair) >= 1)
})

test_that("estimate_all_bias accepts explicit pair specifications", {
  fit <- bias_collection_fixture$fit
  diagnostics <- bias_collection_fixture$diagnostics

  bias_subset <- suppressWarnings(mfrmr::estimate_all_bias(
    fit,
    diagnostics = diagnostics,
    pairs = list(c("Rater", "Criterion")),
    max_iter = 2
  ))

  expect_s3_class(bias_subset, "mfrm_bias_collection")
  expect_identical(bias_subset$summary$Interaction, "Rater x Criterion")
  expect_true("Rater x Criterion" %in% names(bias_subset$by_pair) || !bias_subset$summary$Kept[1])
})