tests/testthat/test-misfit-casebook.R

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

test_that("build_misfit_casebook returns a structured review bundle", {
  toy <- load_mfrmr_data("example_core")
  keep_people <- unique(toy$Person)[1:12]
  toy <- toy[toy$Person %in% keep_people, , drop = FALSE]

  fit <- fit_mfrm(
    toy,
    "Person",
    c("Rater", "Criterion"),
    "Score",
    method = "MML",
    model = "RSM",
    quad_points = 9,
    maxit = 20
  )
  diag <- diagnose_mfrm(fit, diagnostic_mode = "both", residual_pca = "none")

  casebook <- build_misfit_casebook(fit, diagnostics = diag, top_n = 8)

  expect_s3_class(casebook, "mfrm_misfit_casebook")
  expect_s3_class(casebook, "mfrm_bundle")
  expect_true(all(c(
    "overview", "status", "top_cases", "source_summary",
    "case_rollup", "group_view_index", "group_views",
    "plot_map", "reporting_map", "support_status", "source_support", "notes", "settings"
  ) %in% names(casebook)))
  expect_true(all(c(
    "CaseID", "CaseType", "SourceFamily", "SourceTable", "SourceRowKey",
    "AdministrationID", "WaveID", "PrimaryUnit", "PrimaryUnitType", "Magnitude", "ReviewPriority",
    "WithinSourceRank", "SupportBasis", "InterpretationTier",
    "PrimaryPlotRoute", "SupportStatus"
  ) %in% names(casebook$top_cases)))
  expect_true(all(c(
    "AdministrationID", "WaveID", "RollupType", "RollupKey", "Cases",
    "MaxPriority", "TopCaseID"
  ) %in% names(casebook$case_rollup)))
  expect_true(all(c("View", "Rows", "Description") %in% names(casebook$group_view_index)))
  expect_true(is.list(casebook$group_views))
  expect_true(all(c(
    "by_person", "by_facet_level", "by_facet_pair",
    "by_source_family", "by_facet", "by_administration", "by_wave", "facet_views"
  ) %in% names(casebook$group_views)))
  expect_true(any(casebook$support_status$Scope == "RSM / PCM"))
  expect_true(all(c("SourceFamily", "Available", "SupportBasis", "Status", "Note") %in%
                    names(casebook$source_support)))
})

test_that("summary methods for build_misfit_casebook expose a front-door summary", {
  toy <- load_mfrmr_data("example_core")
  keep_people <- unique(toy$Person)[1:12]
  toy <- toy[toy$Person %in% keep_people, , drop = FALSE]

  fit <- fit_mfrm(
    toy,
    "Person",
    c("Rater", "Criterion"),
    "Score",
    method = "MML",
    model = "RSM",
    quad_points = 9,
    maxit = 20
  )
  diag <- diagnose_mfrm(fit, diagnostic_mode = "both", residual_pca = "none")
  unexpected <- unexpected_response_table(fit, diagnostics = diag, abs_z_min = 1.5, prob_max = 0.4, top_n = 8)
  displacement <- displacement_table(fit, diagnostics = diag, anchored_only = FALSE, top_n = 8)

  casebook <- build_misfit_casebook(
    fit,
    diagnostics = diag,
    unexpected = unexpected,
    displacement = displacement,
    top_n = 6
  )
  sx <- summary(casebook, top_n = 4)

  expect_s3_class(sx, "summary.mfrm_misfit_casebook")
  expect_true(all(c(
    "overview", "status", "key_warnings", "next_actions",
    "top_cases", "case_rollup", "group_view_index", "group_views",
    "source_summary", "source_support", "plot_routes", "plot_map", "reporting_map", "support_status"
  ) %in% names(sx)))
  expect_lte(nrow(sx$top_cases), 4)
  expect_output(print(sx), "Plot Follow-up")
})

test_that("build_misfit_casebook records administration and wave provenance", {
  toy <- load_mfrmr_data("example_core")
  keep_people <- unique(toy$Person)[1:12]
  toy <- toy[toy$Person %in% keep_people, , drop = FALSE]

  fit <- fit_mfrm(
    toy,
    "Person",
    c("Rater", "Criterion"),
    "Score",
    method = "MML",
    model = "RSM",
    quad_points = 9,
    maxit = 20
  )
  diag <- diagnose_mfrm(fit, diagnostic_mode = "both", residual_pca = "none")

  casebook <- build_misfit_casebook(
    fit,
    diagnostics = diag,
    administration_id = "FormA",
    wave_id = "Wave1",
    top_n = 6
  )

  expect_equal(casebook$overview$AdministrationID[[1]], "FormA")
  expect_equal(casebook$overview$WaveID[[1]], "Wave1")
  expect_equal(casebook$settings$administration_id, "FormA")
  expect_equal(casebook$settings$wave_id, "Wave1")
  if (nrow(casebook$top_cases) > 0) {
    expect_true(all(casebook$top_cases$AdministrationID == "FormA"))
    expect_true(all(casebook$top_cases$WaveID == "Wave1"))
  }
  if (nrow(casebook$case_rollup) > 0) {
    expect_true(all(casebook$case_rollup$AdministrationID == "FormA"))
    expect_true(all(casebook$case_rollup$WaveID == "Wave1"))
  }
  if (nrow(casebook$group_views$by_administration) > 0) {
    expect_true(all(casebook$group_views$by_administration$AdministrationID == "FormA"))
  }
  if (nrow(casebook$group_views$by_wave) > 0) {
    expect_true(all(casebook$group_views$by_wave$WaveID == "Wave1"))
  }
})

test_that("build_misfit_casebook can return a no-flagged-cases status", {
  toy <- load_mfrmr_data("example_core")
  keep_people <- unique(toy$Person)[1:12]
  toy <- toy[toy$Person %in% keep_people, , drop = FALSE]

  fit <- fit_mfrm(
    toy,
    "Person",
    c("Rater", "Criterion"),
    "Score",
    method = "MML",
    model = "RSM",
    quad_points = 9,
    maxit = 20
  )
  diag <- diagnose_mfrm(fit, diagnostic_mode = "both", residual_pca = "none")
  unexpected <- unexpected_response_table(fit, diagnostics = diag, abs_z_min = 99, prob_max = 1e-12, top_n = 5)
  displacement <- displacement_table(fit, diagnostics = diag, abs_displacement_warn = 99, abs_t_warn = 99, top_n = 5)

  casebook <- build_misfit_casebook(
    fit,
    diagnostics = diag,
    unexpected = unexpected,
    displacement = displacement,
    top_n = 5
  )

  expect_equal(casebook$overview$ReviewStatus[[1]], "no_flagged_cases")
  expect_equal(nrow(casebook$top_cases), 0)
})

test_that("build_misfit_casebook marks bounded GPCM as supported with caveat", {
  toy <- load_mfrmr_data("example_core")
  keep_people <- unique(toy$Person)[1:10]
  toy <- toy[toy$Person %in% keep_people, , drop = FALSE]

  fit <- suppressWarnings(fit_mfrm(
    toy,
    "Person",
    c("Rater", "Criterion"),
    "Score",
    method = "MML",
    model = "GPCM",
    slope_facet = "Criterion",
    step_facet = "Criterion",
    quad_points = 5,
    maxit = 20
  ))

  casebook <- build_misfit_casebook(fit, top_n = 6)
  gpcm_row <- casebook$support_status[casebook$support_status$Scope == "bounded GPCM", , drop = FALSE]
  gpcm_sources <- casebook$source_support

  expect_equal(gpcm_row$Status[[1]], "supported_with_caveat")
  expect_true(any(casebook$top_cases$SupportStatus == "supported_with_caveat") || nrow(casebook$top_cases) == 0)
  expect_true(all(gpcm_sources$Status %in% c("supported_with_caveat", "deferred")))
})