tests/testthat/test-edge-cases.R

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

# test-edge-cases.R
# Tests for boundary conditions and unusual-but-valid data.
# All tests target the release code directly (no mocks).

# ---- Minimal viable data ----

test_that("fit_mfrm succeeds with minimal viable data", {
  d <- data.frame(
    Person = rep(c("P1", "P2", "P3", "P4"), each = 2),
    Rater = rep(c("R1", "R2"), 4),
    Score = c(0, 1, 1, 0, 0, 1, 1, 0)
  )
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", "Rater", "Score", method = "JML", maxit = 30)
  )
  expect_s3_class(fit, "mfrm_fit")
  expect_true(is.data.frame(fit$summary))
  expect_true("Estimate" %in% names(fit$facets$others))
})

# ---- NA values dropped gracefully ----

test_that("fit_mfrm drops NA rows and still fits", {
  d <- data.frame(
    Person = c("P1", "P2", "P3", "P4", NA, "P5", "P6"),
    Rater = c("R1", "R2", "R1", "R2", "R1", "R2", "R1"),
    Score = c(0, 1, NA, 2, 1, 0, 1)
  )
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", "Rater", "Score", method = "JML", maxit = 30)
  )
  expect_s3_class(fit, "mfrm_fit")
})

# ---- Weight column handling ----

test_that("fit_mfrm handles observation weights correctly", {
  set.seed(42)
  d <- data.frame(
    Person = rep(paste0("P", 1:6), each = 3),
    Rater = rep(paste0("R", 1:3), 6),
    Score = sample(0:2, 18, replace = TRUE),
    W = rep(c(1, 2, 0.5), 6)
  )
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", "Rater", "Score", weight = "W", method = "JML", maxit = 30)
  )
  expect_s3_class(fit, "mfrm_fit")
})

# ---- Non-convergence detection ----

test_that("fit_mfrm warns about non-convergence with tiny maxit", {
  d <- mfrmr:::sample_mfrm_data(seed = 123)
  expect_warning(
    fit_mfrm(d, "Person", c("Rater", "Task", "Criterion"), "Score",
             method = "JML", maxit = 1),
    "did not fully converge"
  )
})

# ---- PCM model path ----

test_that("fit_mfrm PCM mode works with step_facet", {
  d <- mfrmr:::sample_mfrm_data(seed = 42)
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", c("Rater", "Task", "Criterion"), "Score",
             model = "PCM", method = "JML", step_facet = "Task", maxit = 20)
  )
  expect_s3_class(fit, "mfrm_fit")
  expect_equal(fit$summary$Model[[1]], "PCM")
})

# ---- MML path with person estimates ----

test_that("fit_mfrm MML produces person EAP estimates with SD", {
  d <- mfrmr:::sample_mfrm_data(seed = 42)
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", c("Rater", "Task", "Criterion"), "Score",
             method = "MML", maxit = 30, quad_points = 7)
  )
  expect_s3_class(fit, "mfrm_fit")
  expect_true("SD" %in% names(fit$facets$person))
  expect_true(all(fit$facets$person$SD > 0))
})

# ---- Diagnostics on fitted model ----

test_that("diagnose_mfrm produces all expected components", {
  d <- mfrmr:::sample_mfrm_data(seed = 123)
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", c("Rater", "Task", "Criterion"), "Score",
             method = "JML", maxit = 20)
  )
  diag <- diagnose_mfrm(fit)
  expect_s3_class(diag, "mfrm_diagnostics")
  expect_true(all(c("obs", "measures", "overall_fit", "reliability",
                     "unexpected", "fair_average", "displacement",
                     "interrater", "facets_chisq") %in% names(diag)))
})

test_that("diagnose_mfrm with PCA produces eigenvalue output", {
  d <- mfrmr:::sample_mfrm_data(seed = 123)
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", c("Rater", "Task", "Criterion"), "Score",
             method = "JML", maxit = 20)
  )
  diag <- diagnose_mfrm(fit, residual_pca = "both", pca_max_factors = 3)
  expect_true(!is.null(diag$residual_pca_overall))
  expect_true(!is.null(diag$residual_pca_by_facet))
})

# ---- describe_mfrm_data ----

test_that("describe_mfrm_data works with minimal data", {
  d <- data.frame(
    Person = c("P1", "P2", "P3"),
    Rater = c("R1", "R2", "R1"),
    Score = c(0, 1, 2)
  )
  ds <- describe_mfrm_data(d, "Person", "Rater", "Score")
  expect_s3_class(ds, "mfrm_data_description")
  expect_equal(ds$overview$Observations, 3)
})

test_that("describe_mfrm_data summary and print work", {
  d <- mfrmr:::sample_mfrm_data(seed = 1)
  ds <- describe_mfrm_data(d, "Person", c("Rater", "Task", "Criterion"), "Score")
  s <- summary(ds)
  expect_s3_class(s, "summary.mfrm_data_description")
  out <- capture.output(print(s))
  expect_true(length(out) > 0)
})

test_that("describe_mfrm_data plot types work", {
  d <- mfrmr:::sample_mfrm_data(seed = 1)
  ds <- describe_mfrm_data(d, "Person", c("Rater", "Task", "Criterion"), "Score")
  p1 <- plot(ds, type = "score_distribution", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(ds, type = "facet_levels", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(ds, type = "missing", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- audit_mfrm_anchors ----

test_that("audit_mfrm_anchors works without anchors", {
  d <- mfrmr:::sample_mfrm_data(seed = 1)
  result <- audit_mfrm_anchors(
    d, "Person", c("Rater", "Task", "Criterion"), "Score"
  )
  expect_s3_class(result, "mfrm_anchor_audit")
})

test_that("audit_mfrm_anchors detects issues with bad anchors", {
  d <- mfrmr:::sample_mfrm_data(seed = 1)
  bad_anchors <- data.frame(
    Facet = c("Rater", "NonExistent"),
    Level = c("R1", "X"),
    Anchor = c(0.5, -0.5)
  )
  result <- audit_mfrm_anchors(
    d, "Person", c("Rater", "Task", "Criterion"), "Score",
    anchors = bad_anchors
  )
  expect_true(sum(result$issue_counts$N, na.rm = TRUE) > 0)
})

# ---- mfrmRFacets alias ----

test_that("mfrmRFacets alias produces identical output to run_mfrm_facets", {
  d <- mfrmr:::sample_mfrm_data(seed = 77)
  out1 <- suppressWarnings(
    run_mfrm_facets(d, person = "Person",
                    facets = c("Rater", "Task", "Criterion"),
                    score = "Score", maxit = 10)
  )
  out2 <- suppressWarnings(
    mfrmRFacets(d, person = "Person",
                facets = c("Rater", "Task", "Criterion"),
                score = "Score", maxit = 10)
  )
  expect_equal(out1$fit$summary$LogLik, out2$fit$summary$LogLik)
  expect_s3_class(out2, "mfrm_facets_run")
})

# ---- Threshold profiles ----

test_that("mfrm_threshold_profiles returns all three profiles", {
  tp <- mfrm_threshold_profiles()
  expect_s3_class(tp, "mfrm_threshold_profiles")
  profiles <- tp$profiles
  expect_true(is.list(profiles))
  expect_true(all(c("strict", "standard", "lenient") %in% names(profiles)))
  for (p in profiles) {
    expect_true("n_obs_min" %in% names(p))
  }
})

# ---- build_visual_summaries with different profiles ----

test_that("build_visual_summaries works with all threshold profiles", {
  skip_on_cran()
  d <- mfrmr:::sample_mfrm_data(seed = 123)
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", c("Rater", "Task", "Criterion"), "Score",
             method = "JML", maxit = 20)
  )
  diag <- diagnose_mfrm(fit)

  for (profile in c("strict", "standard", "lenient")) {
    vs <- build_visual_summaries(fit, diagnostics = diag,
                                 threshold_profile = profile)
    expect_true(is.list(vs))
    expect_true("warning_map" %in% names(vs) || "summary_map" %in% names(vs))
  }
})