tests/testthat/test-error-handling.R

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

# test-error-handling.R
# Tests that input validation produces clear, actionable error messages.
# Each test targets the release code directly (no mocks).

# ---- fit_mfrm input validation ----

test_that("fit_mfrm rejects non-data.frame input", {
  expect_error(
    fit_mfrm(list(a = 1), "P", "R", "S"),
    "data\\.frame.*Convert"
  )
  expect_error(
    fit_mfrm("not a frame", "P", "R", "S"),
    "data\\.frame"
  )
})

test_that("fit_mfrm rejects empty data.frame", {
  expect_error(
    fit_mfrm(data.frame(), "P", "R", "S"),
    "zero rows"
  )
})

test_that("fit_mfrm rejects non-character person argument", {
  toy <- data.frame(P = 1:3, R = 1:3, S = 1:3)
  expect_error(
    fit_mfrm(toy, 1, "R", "S"),
    "person.*character string"
  )
  expect_error(
    fit_mfrm(toy, c("P", "Q"), "R", "S"),
    "person.*single"
  )
  expect_error(
    fit_mfrm(toy, "", "R", "S"),
    "person.*non-empty"
  )
})

test_that("fit_mfrm rejects invalid facets argument", {
  toy <- data.frame(P = 1:3, R = 1:3, S = 1:3)
  expect_error(
    fit_mfrm(toy, "P", character(0), "S"),
    "facets.*character vector"
  )
  expect_error(
    fit_mfrm(toy, "P", 1, "S"),
    "facets.*character vector"
  )
})

test_that("fit_mfrm rejects invalid score argument", {
  toy <- data.frame(P = 1:3, R = 1:3, S = 1:3)
  expect_error(
    fit_mfrm(toy, "P", "R", 1),
    "score.*character string"
  )
  expect_error(
    fit_mfrm(toy, "P", "R", ""),
    "score.*non-empty"
  )
})

test_that("fit_mfrm rejects invalid weight argument", {
  toy <- data.frame(P = 1:3, R = 1:3, S = 1:3)
  expect_error(
    fit_mfrm(toy, "P", "R", "S", weight = 1),
    "weight.*character string"
  )
})

test_that("fit_mfrm rejects invalid numeric parameters", {
  toy <- data.frame(P = 1:3, R = 1:3, S = 1:3)
  expect_error(fit_mfrm(toy, "P", "R", "S", maxit = -1), "maxit.*positive")
  expect_error(fit_mfrm(toy, "P", "R", "S", reltol = -0.1), "reltol.*positive")
  expect_error(fit_mfrm(toy, "P", "R", "S", quad_points = 0), "quad_points.*positive")
})

test_that("fit_mfrm rejects missing columns in data", {
  toy <- data.frame(A = 1:5, B = 1:5, C = 1:5)
  expect_error(
    fit_mfrm(toy, "Person", "Rater", "Score"),
    "not found in data.*Person"
  )
})

test_that("fit_mfrm rejects duplicate column references", {
  toy <- data.frame(A = 1:5, B = 1:5, C = 1:5)
  expect_error(
    fit_mfrm(toy, "A", "A", "C"),
    "distinct.*duplicates"
  )
})

# ---- diagnose_mfrm input validation ----

test_that("diagnose_mfrm rejects non-mfrm_fit input", {
  expect_error(
    diagnose_mfrm(list()),
    "mfrm_fit"
  )
  expect_error(
    diagnose_mfrm("not a fit"),
    "mfrm_fit"
  )
})

# ---- estimate_bias input validation ----

test_that("estimate_bias rejects invalid fit object", {
  expect_error(
    estimate_bias(list(), list(obs = data.frame()), facet_a = "R", facet_b = "C"),
    "mfrm_fit"
  )
})

test_that("estimate_bias rejects invalid diagnostics object", {
  fake_fit <- structure(list(), class = c("mfrm_fit", "list"))
  expect_error(
    estimate_bias(fake_fit, list(), facet_a = "R", facet_b = "C"),
    "diagnose_mfrm"
  )
})

test_that("estimate_bias requires interaction facets specification", {
  fake_fit <- structure(list(), class = c("mfrm_fit", "list"))
  fake_diag <- list(obs = data.frame(x = 1))
  expect_error(
    estimate_bias(fake_fit, fake_diag),
    "interaction_facets.*facet_a.*facet_b"
  )
})

# ---- prepare_mfrm_data edge cases ----

test_that("prepare_mfrm_data rejects all-NA data after filtering", {
  toy <- data.frame(Person = c("P1", "P2"), Rater = c("R1", "R2"), Score = c(NA, NA))
  expect_error(
    fit_mfrm(toy, "Person", "Rater", "Score"),
    "No valid observations"
  )
})

test_that("prepare_mfrm_data rejects single-category scores", {
  toy <- data.frame(
    Person = c("P1", "P2", "P3", "P4"),
    Rater = c("R1", "R2", "R1", "R2"),
    Score = c(1, 1, 1, 1)
  )
  expect_error(
    fit_mfrm(toy, "Person", "Rater", "Score"),
    "Only one score category"
  )
})

test_that("prepare_mfrm_data rejects zero-weight-only data", {
  toy <- data.frame(
    Person = c("P1", "P2"),
    Rater = c("R1", "R2"),
    Score = c(0, 1),
    W = c(0, 0)
  )
  expect_error(
    fit_mfrm(toy, "Person", "Rater", "Score", weight = "W"),
    "No valid observations"
  )
})

# ---- FACETS mode API validation ----

test_that("run_mfrm_facets rejects non-data.frame", {
  expect_error(
    run_mfrm_facets(list(a = 1)),
    "data\\.frame"
  )
})

test_that("run_mfrm_facets rejects empty data", {
  expect_error(
    run_mfrm_facets(data.frame()),
    "empty"
  )
})

test_that("infer_facets_mode_mapping rejects too few columns", {
  expect_error(
    run_mfrm_facets(data.frame(A = 1, B = 2)),
    "at least 3 columns"
  )
})

test_that("infer_facets_mode_mapping rejects missing person column", {
  toy <- data.frame(A = 1:3, B = 1:3, C = 1:3)
  expect_error(
    run_mfrm_facets(toy, person = "NonExistent"),
    "Person column not found"
  )
})

test_that("infer_facets_mode_mapping rejects missing score column", {
  toy <- data.frame(A = 1:3, B = 1:3, C = 1:3)
  expect_error(
    run_mfrm_facets(toy, score = "NonExistent"),
    "Score column not found"
  )
})

test_that("infer_facets_mode_mapping rejects missing facet columns", {
  toy <- data.frame(Person = 1:3, Score = 1:3, R = 1:3)
  expect_error(
    run_mfrm_facets(toy, person = "Person", facets = c("Missing1", "Missing2"), score = "Score"),
    "Facet column.*not found"
  )
})

test_that("normalize_spec_input rejects non-data.frame anchors", {
  toy <- mfrmr:::sample_mfrm_data(seed = 1)
  expect_error(
    run_mfrm_facets(toy, person = "Person",
                    facets = c("Rater", "Task", "Criterion"),
                    score = "Score", anchors = "bad_input", maxit = 5),
    "data\\.frame"
  )
})

# ---- Gauss-Hermite validation ----

test_that("gauss_hermite_normal rejects n < 1", {
  expect_error(
    mfrmr:::gauss_hermite_normal(0),
    "quadrature.*n >= 1"
  )
})

# ---- PCM step_facet validation ----

test_that("resolve_pcm_step_facet rejects invalid step facet", {
  expect_error(
    mfrmr:::resolve_pcm_step_facet("PCM", "Invalid", c("Rater", "Task")),
    "step_facet.*Invalid.*not among.*Rater.*Task"
  )
})