tests/testthat/test-api-final-coverage.R

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

## tests/testthat/test-api-final-coverage.R
## Targeted coverage tests for api.R uncovered lines.

# ── shared fixtures ──────────────────────────────────────────────────────────
local({
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)
})

# ---------------------------------------------------------------------------
# Fixture: fast JML fit with sample data
# ---------------------------------------------------------------------------
test_that("fixture: build shared fit/dx objects", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  d <- mfrmr:::sample_mfrm_data(seed = 42)

  fit <<- suppressWarnings(mfrmr::fit_mfrm(
    data = d,
    person = "Person",
    facets = c("Rater", "Task", "Criterion"),
    score = "Score",
    method = "JML",
    model = "RSM",
    maxit = 15
  ))
  expect_s3_class(fit, "mfrm_fit")

  dx <<- mfrmr::diagnose_mfrm(fit, residual_pca = "both", pca_max_factors = 3)
  expect_s3_class(dx, "mfrm_diagnostics")

  bias_res <<- mfrmr::estimate_bias(
    fit, dx,
    facet_a = "Rater", facet_b = "Criterion",
    max_iter = 2
  )
  expect_true(is.list(bias_res))
})

# ---------------------------------------------------------------------------
# 1. Error guards: fit_mfrm input validation (stop branches)
# ---------------------------------------------------------------------------
test_that("error guards on *_table() functions reject non-mfrm_fit input", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  bad <- list(summary = data.frame())

  # interrater_agreement_table (line 1521)
 expect_error(mfrmr::interrater_agreement_table(bad), "mfrm_fit")
  # facets_chisq_table (line 1664)
  expect_error(mfrmr::facets_chisq_table(bad), "mfrm_fit")
  # unexpected_response_table (line 1783)
  expect_error(mfrmr::unexpected_response_table(bad), "mfrm_fit")
  # fair_average_table (line 1889)
  expect_error(mfrmr::fair_average_table(bad), "mfrm_fit")
  # displacement_table (line 1981)
  expect_error(mfrmr::displacement_table(bad), "mfrm_fit")
  # measurable_summary_table (line 2081)
  expect_error(mfrmr::measurable_summary_table(bad), "mfrm_fit")
  # rating_scale_table (line 2197)
  expect_error(mfrmr::rating_scale_table(bad), "mfrm_fit")
  # unexpected_after_bias_table (line 2507)
  expect_error(mfrmr::unexpected_after_bias_table(bad, bias_res), "mfrm_fit")
})

# ---------------------------------------------------------------------------
# 2. Internal diagnostics auto-invocation (lines where diagnostics = NULL triggers diagnose_mfrm)
# ---------------------------------------------------------------------------
test_that("table functions auto-invoke diagnostics when NULL", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # These call diagnose_mfrm(fit) internally when diagnostics = NULL:
  # interrater_agreement_table line 1524
  ir <- mfrmr::interrater_agreement_table(fit, diagnostics = NULL, rater_facet = "Rater")
  expect_s3_class(ir, "mfrm_interrater")

  # facets_chisq_table line 1667
  chi <- mfrmr::facets_chisq_table(fit, diagnostics = NULL)
  expect_s3_class(chi, "mfrm_facets_chisq")

  # unexpected_response_table line 1786
  t4 <- mfrmr::unexpected_response_table(fit, diagnostics = NULL, top_n = 5)
  expect_s3_class(t4, "mfrm_unexpected")

  # fair_average_table line 1892
  t12 <- mfrmr::fair_average_table(fit, diagnostics = NULL)
  expect_s3_class(t12, "mfrm_fair_average")

  # displacement_table line 1984
  disp <- mfrmr::displacement_table(fit, diagnostics = NULL)
  expect_s3_class(disp, "mfrm_displacement")

  # measurable_summary_table line 2084
  t5 <- mfrmr::measurable_summary_table(fit, diagnostics = NULL)
  expect_s3_class(t5, "mfrm_measurable")

  # rating_scale_table line 2200
  t8 <- mfrmr::rating_scale_table(fit, diagnostics = NULL)
  expect_s3_class(t8, "mfrm_rating_scale")

  # unexpected_after_bias_table line 2513
  t10 <- mfrmr::unexpected_after_bias_table(fit, bias_res, diagnostics = NULL, top_n = 5)
  expect_s3_class(t10, "mfrm_unexpected_after_bias")
})

# ---------------------------------------------------------------------------
# 3. Error guards on bias_count_table and unexpected_after_bias_table
# ---------------------------------------------------------------------------
test_that("bias_count_table rejects NULL/empty bias_results", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 2325
  expect_error(mfrmr::bias_count_table(NULL), "estimate_bias")
  # line 2510
  expect_error(
    mfrmr::unexpected_after_bias_table(fit, list(table = data.frame())),
    "estimate_bias"
  )
})

# ---------------------------------------------------------------------------
# 4. make_anchor_table: non-mfrm_fit error + facets filter (lines 1309, 1344-1346)
# ---------------------------------------------------------------------------
test_that("make_anchor_table error guard and facets filter", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  expect_error(mfrmr::make_anchor_table(list()), "mfrm_fit")

  anchor_tbl <- mfrmr::make_anchor_table(fit)
  expect_true(nrow(anchor_tbl) > 0)

  # Filter by specific facets (line 1344-1346)
  anchor_sub <- mfrmr::make_anchor_table(fit, facets = "Rater")
  expect_true(all(anchor_sub$Facet == "Rater"))

  # Include person estimates
  anchor_person <- mfrmr::make_anchor_table(fit, include_person = TRUE)
  expect_true("Person" %in% anchor_person$Facet)
})

# ---------------------------------------------------------------------------
# 5. describe_mfrm_data with agreement (lines 428, 477, 480, 490, 494, 511-512)
# ---------------------------------------------------------------------------
test_that("describe_mfrm_data agreement path and error guards", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  d <- mfrmr:::sample_mfrm_data(seed = 42)

  # include_agreement = TRUE triggers the agreement block (lines 469+)
  desc <- mfrmr::describe_mfrm_data(
    data = d,
    person = "Person",
    facets = c("Rater", "Task", "Criterion"),
    score = "Score",
    include_agreement = TRUE,
    rater_facet = "Rater",
    agreement_top_n = 5
  )
  expect_s3_class(desc, "mfrm_data_description")
  expect_true(desc$agreement$settings$included)
  expect_equal(desc$agreement$settings$top_n, 5L)

  # include_person_facet = TRUE (line 428)
  desc2 <- mfrmr::describe_mfrm_data(
    data = d,
    person = "Person",
    facets = c("Rater", "Task", "Criterion"),
    score = "Score",
    include_person_facet = TRUE
  )
  expect_s3_class(desc2, "mfrm_data_description")

  # Error: rater_facet = "Person" (line 480)
  expect_error(
    mfrmr::describe_mfrm_data(
      data = d, person = "Person", facets = c("Rater", "Task"), score = "Score",
      include_agreement = TRUE, rater_facet = "Person"
    ),
    "Person"
  )

  # Error: unknown context_facets (line 490)
  expect_error(
    mfrmr::describe_mfrm_data(
      data = d, person = "Person", facets = c("Rater", "Task"), score = "Score",
      include_agreement = TRUE, rater_facet = "Rater",
      context_facets = c("Nonexistent")
    ),
    "Unknown"
  )

  # Error: context_facets same as rater_facet (line 494)
  expect_error(
    mfrmr::describe_mfrm_data(
      data = d, person = "Person", facets = c("Rater", "Task"), score = "Score",
      include_agreement = TRUE, rater_facet = "Rater",
      context_facets = c("Rater")
    ),
    "context_facets"
  )
})

# ---------------------------------------------------------------------------
# 6. summary/print methods for data_description (line 649, 670)
# ---------------------------------------------------------------------------
test_that("summary/print for mfrm_data_description covers lines 649, 670", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  d <- mfrmr:::sample_mfrm_data(seed = 42)
  desc <- mfrmr::describe_mfrm_data(
    data = d, person = "Person",
    facets = c("Rater", "Task", "Criterion"), score = "Score",
    include_agreement = TRUE, rater_facet = "Rater"
  )

  s <- summary(desc)
  expect_s3_class(s, "summary.mfrm_data_description")

  out <- capture.output(print(s))
  expect_true(any(grepl("mfrm Data Description Summary", out, fixed = TRUE)))
})

# ---------------------------------------------------------------------------
# 7. plot.mfrm_data_description error guards (lines 765, 787, 812)
# ---------------------------------------------------------------------------
test_that("plot.mfrm_data_description error guards for empty data", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  empty_desc <- structure(
    list(
      score_distribution = data.frame(),
      facet_level_summary = data.frame(),
      missing_by_column = data.frame()
    ),
    class = "mfrm_data_description"
  )

  # line 765
  expect_error(plot(empty_desc, type = "score_distribution", draw = FALSE), "not available")
  # line 787
  expect_error(plot(empty_desc, type = "facet_levels", draw = FALSE), "not available")
  # line 812
  expect_error(plot(empty_desc, type = "missing", draw = FALSE), "not available")
})

# ---------------------------------------------------------------------------
# 8. anchor_audit print/summary (lines 970-971, 1051, 1055, 1076)
# ---------------------------------------------------------------------------
test_that("anchor audit print and summary cover lines 970-1076", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  d <- mfrmr:::sample_mfrm_data(seed = 42)

  # Create audit with anchors that trigger issues
  anchor_tbl <- mfrmr::make_anchor_table(fit, facets = "Rater")
  aud <- mfrmr::audit_mfrm_anchors(
    data = d, person = "Person",
    facets = c("Rater", "Task", "Criterion"), score = "Score",
    anchors = anchor_tbl
  )
  expect_s3_class(aud, "mfrm_anchor_audit")

  # print covers lines 970-971 if there are nonzero issue counts
  out_print <- capture.output(print(aud))
  expect_true(any(grepl("mfrm anchor audit", out_print, fixed = TRUE)))

  # summary covers lines 1051, 1055, 1076
  s <- summary(aud)
  expect_s3_class(s, "summary.mfrm_anchor_audit")

  out_sum <- capture.output(print(s))
  expect_true(any(grepl("mfrm Anchor Audit Summary", out_sum, fixed = TRUE)))
})

# ---------------------------------------------------------------------------
# 9. format_anchor_audit_message edge cases (lines 260, 265)
# ---------------------------------------------------------------------------
test_that("format_anchor_audit_message handles edge cases", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 260: NULL/empty issue_counts
 msg1 <- mfrmr:::format_anchor_audit_message(list(issue_counts = NULL))
  expect_match(msg1, "no issues")

  # line 265: all N == 0
  msg2 <- mfrmr:::format_anchor_audit_message(
    list(issue_counts = data.frame(Issue = "dup", N = 0L))
  )
  expect_match(msg2, "no issues")
})

# ---------------------------------------------------------------------------
# 10. interrater_agreement_table error guards (lines 1543, 1546)
# ---------------------------------------------------------------------------
test_that("interrater_agreement_table rejects bad rater_facet", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 1543: rater_facet not in known facets
  expect_error(
    mfrmr::interrater_agreement_table(fit, rater_facet = "Nonexistent"),
    "rater_facet"
  )
  # line 1546: rater_facet = "Person"
  expect_error(
    mfrmr::interrater_agreement_table(fit, rater_facet = "Person"),
    "Person"
  )
})

# ---------------------------------------------------------------------------
# 11. facets_chisq_table top_n filter (lines 1682-1683, 1688)
# ---------------------------------------------------------------------------
test_that("facets_chisq_table top_n filter works", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  chi <- mfrmr::facets_chisq_table(fit, diagnostics = dx, top_n = 1)
  expect_s3_class(chi, "mfrm_facets_chisq")
  expect_lte(nrow(chi$table), 1)
})

# ---------------------------------------------------------------------------
# 12. rating_scale_table with drop_unused (line 2208)
# ---------------------------------------------------------------------------
test_that("rating_scale_table drop_unused parameter", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  t8 <- mfrmr::rating_scale_table(fit, diagnostics = dx, drop_unused = TRUE)
  expect_s3_class(t8, "mfrm_rating_scale")
  expect_true(all(t8$category_table$Count > 0))
})

# ---------------------------------------------------------------------------
# 13. Legacy table functions (table1_specifications, table2_data_summary, etc.)
# ---------------------------------------------------------------------------
test_that("legacy table1_specifications (lines 2792, 2798, 2884)", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 2792: non-mfrm_fit input
  expect_error(mfrmr:::table1_specifications(list()), "mfrm_fit")

  # Normal invocation covers lines 2798, 2884
  t1 <- mfrmr:::table1_specifications(fit, title = "Test run")
  expect_true(is.list(t1))
  expect_true("header" %in% names(t1))
  expect_true("anchor_summary" %in% names(t1))
})

test_that("legacy table2_data_summary without raw data (lines 2973, 3018-3028)", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 2973: non-mfrm_fit
  expect_error(mfrmr:::table2_data_summary(list()), "mfrm_fit")

  # Without raw data, include_fixed = TRUE -> lines 3018-3028
  t2 <- mfrmr:::table2_data_summary(fit, include_fixed = TRUE)
  expect_true(is.list(t2))
  expect_true("fixed" %in% names(t2))
  expect_true(nchar(t2$fixed) > 0)
})

test_that("legacy table2_data_summary WITH raw data (lines 3034-3093)", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  d <- mfrmr:::sample_mfrm_data(seed = 42)

  # Inject some missing values / out-of-range to trigger audit branches
  d_bad <- d
  d_bad$Score[1:3] <- NA  # missing_score
  d_bad$Person[4] <- NA   # missing_person
  d_bad$Score[5] <- 99    # out of range

  t2 <- mfrmr:::table2_data_summary(
    fit, data = d_bad,
    person = "Person",
    facets = c("Rater", "Task", "Criterion"),
    score = "Score"
  )
  expect_true(is.list(t2))
  expect_true(nrow(t2$row_audit) > 0)

  # line 3034: data is not a data.frame
  expect_error(
    mfrmr:::table2_data_summary(fit, data = "not_a_df", person = "Person",
                                 facets = c("Rater"), score = "Score"),
    "data.frame"
  )

  # line 3038: missing columns
  expect_error(
    mfrmr:::table2_data_summary(fit, data = data.frame(X = 1), person = "Person",
                                 facets = c("Rater"), score = "Score"),
    "missing required"
  )
})

# ---------------------------------------------------------------------------
# 14. table6_subsets_listing legacy (lines 3357-3385)
# ---------------------------------------------------------------------------
test_that("legacy table6_subsets_listing covers lines 3358-3385", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 3358: non-mfrm_fit error
  expect_error(mfrmr:::table6_subsets_listing(list()), "mfrm_fit")

  # Normal call, auto-diagnose
  t6 <- mfrmr:::table6_subsets_listing(fit)
  expect_true(is.list(t6))
  expect_true("summary" %in% names(t6))
  expect_true("listing" %in% names(t6))
})

# ---------------------------------------------------------------------------
# 15. table6_2_facet_statistics legacy (lines 3514-3537)
# ---------------------------------------------------------------------------
test_that("legacy table6_2_facet_statistics covers lines 3514-3537", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 3514: non-mfrm_fit
  expect_error(mfrmr:::table6_2_facet_statistics(list()), "mfrm_fit")

  t62 <- mfrmr:::table6_2_facet_statistics(fit, diagnostics = dx)
  expect_true(is.list(t62))
})

# ---------------------------------------------------------------------------
# 16. facets_output_file_bundle error guards (lines 4072, 4078, 4081, 4089, 4094, 4097, 4100)
# ---------------------------------------------------------------------------
test_that("facets_output_file_bundle input validation", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 4072: non-mfrm_fit
  expect_error(mfrmr::facets_output_file_bundle(list()), "mfrm_fit")

  # line 4078: bad include values
  expect_error(
    mfrmr::facets_output_file_bundle(fit, include = c("badval")),
    "Unsupported"
  )

  # line 4081: empty include
  expect_error(
    mfrmr::facets_output_file_bundle(fit, include = character(0)),
    "include"
  )

  # line 4089: empty file_prefix
  out <- mfrmr::facets_output_file_bundle(fit, file_prefix = "")
  expect_s3_class(out, "mfrm_output_bundle")

  # line 4094: write_files = TRUE but no output_dir
  expect_error(
    mfrmr::facets_output_file_bundle(fit, write_files = TRUE, output_dir = NULL),
    "output_dir"
  )
})

# ---------------------------------------------------------------------------
# 17. analyze_residual_pca (lines 4382, 4386, 4391-4393, 4426)
# ---------------------------------------------------------------------------
test_that("analyze_residual_pca error guards and facets filter", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 4382: non-list diagnostics
  expect_error(mfrmr::analyze_residual_pca("not_a_list"), "diagnose_mfrm")

  # line 4386: empty obs
  expect_error(
    mfrmr::analyze_residual_pca(list(obs = data.frame())),
    "empty"
  )

  # line 4391-4393: facets filter with nonexistent facets
  expect_error(
    mfrmr::analyze_residual_pca(dx, facets = "NonExistent"),
    "No matching facets"
  )

  # Normal call with specific facets (line 4426 / subset filter)
  pca <- mfrmr::analyze_residual_pca(dx, mode = "facet", facets = "Rater")
  expect_s3_class(pca, "mfrm_residual_pca")
  expect_equal(pca$facet_names, "Rater")

  # Calling with mfrm_fit directly (line 4373-4378)
  pca2 <- mfrmr::analyze_residual_pca(fit, mode = "overall")
  expect_s3_class(pca2, "mfrm_residual_pca")
})

# ---------------------------------------------------------------------------
# 18. extract_pca_eigenvalues and build_pca_variance_table (lines 4231, 4238-4241, 4249)
# ---------------------------------------------------------------------------
test_that("extract_pca_eigenvalues edge cases", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 4231: NULL input
  expect_equal(mfrmr:::extract_pca_eigenvalues(NULL), numeric(0))

  # line 4238-4241: fallback to cor_matrix
  fake_pca <- list(cor_matrix = matrix(c(1, 0.5, 0.5, 1), 2, 2))
  eig <- mfrmr:::extract_pca_eigenvalues(fake_pca)
  expect_true(length(eig) > 0)

  # line 4249: build_pca_variance_table with empty eigenvalues
  empty_tbl <- mfrmr:::build_pca_variance_table(NULL)
  expect_equal(nrow(empty_tbl), 0)
})

# ---------------------------------------------------------------------------
# 19. extract_loading_table (lines 4462, 4466-4467, 4471, 4474)
# ---------------------------------------------------------------------------
test_that("extract_loading_table edge cases", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 4462: NULL input
  tbl0 <- mfrmr:::extract_loading_table(NULL)
  expect_equal(nrow(tbl0), 0)

  # line 4471: NULL rownames
  fake_loads <- matrix(c(0.8, 0.5, -0.3), ncol = 1)
  fake_pca <- list(pca = list(loadings = fake_loads))
  tbl1 <- mfrmr:::extract_loading_table(fake_pca)
  expect_true(nrow(tbl1) > 0)
  expect_true("V1" %in% tbl1$Variable || "V2" %in% tbl1$Variable || "V3" %in% tbl1$Variable)
})

# ---------------------------------------------------------------------------
# 20. summary.mfrm_apa_outputs (lines 6421-6501)
# ---------------------------------------------------------------------------
test_that("summary.mfrm_apa_outputs covers lines 6421-6501", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  apa <- mfrmr::build_apa_outputs(fit, dx)
  expect_s3_class(apa, "mfrm_apa_outputs")

  s <- summary(apa)
  expect_s3_class(s, "summary.mfrm_apa_outputs")
  expect_true("overview" %in% names(s))
  expect_true("components" %in% names(s))
  expect_true("DraftContractPass" %in% names(s$overview))
  expect_true(any(grepl("contract completeness", s$notes, fixed = TRUE)))

  # error guard (line 6421): non-mfrm_apa_outputs
  expect_error(summary.mfrm_apa_outputs(list()), "mfrm_apa_outputs")
})

# ---------------------------------------------------------------------------
# 21. summary.mfrm_bundle dispatch to specialized summarizers
# ---------------------------------------------------------------------------
test_that("summary.mfrm_bundle dispatches to specialized summarizers", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # bias_count -> summarize_bias_count_bundle
  t11 <- mfrmr::bias_count_table(bias_res, branch = "original")
  s11 <- summary(t11)
  expect_s3_class(s11, "summary.mfrm_bundle")

  # measurable_summary -> generic bundle
  t5 <- mfrmr::measurable_summary_table(fit, diagnostics = dx)
  s5 <- summary(t5)
  expect_s3_class(s5, "summary.mfrm_bundle")

  # rating_scale -> generic bundle
  t8 <- mfrmr::rating_scale_table(fit, diagnostics = dx)
  s8 <- summary(t8)
  expect_s3_class(s8, "summary.mfrm_bundle")
})

# ---------------------------------------------------------------------------
# 22. print.summary.mfrm_bundle (lines 8748-8763) bias_count path
# ---------------------------------------------------------------------------
test_that("print.summary.mfrm_bundle bias_count path", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  t11 <- mfrmr::bias_count_table(bias_res, branch = "original")
  s11 <- summary(t11)
  out <- capture.output(print(s11))
  expect_true(any(grepl("Bias Count", out, fixed = TRUE)))
})

# ---------------------------------------------------------------------------
# 23. bundle_settings_table helper (line 7863, 7866)
# ---------------------------------------------------------------------------
test_that("bundle_settings_table handles edge cases", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 7863: NULL input
  tbl0 <- mfrmr:::bundle_settings_table(NULL)
  expect_equal(nrow(tbl0), 0)

  # line 7866: unnamed settings
  tbl1 <- mfrmr:::bundle_settings_table(list("a", 1, TRUE))
  expect_true(nrow(tbl1) == 3)
  expect_true(all(grepl("Setting", tbl1$Setting)))

  # nested list & data.frame values
  tbl2 <- mfrmr:::bundle_settings_table(
    list(
      a = NULL,
      b = data.frame(x = 1:3),
      c = list(1, 2),
      d = "hello"
    )
  )
  expect_equal(nrow(tbl2), 4)
})

# ---------------------------------------------------------------------------
# 24. bundle_preview_table (lines 7893, 7905, 7908, 7911)
# ---------------------------------------------------------------------------
test_that("bundle_preview_table covers edge cases", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 7893: empty table
  obj_empty <- list(table = data.frame())
  r1 <- mfrmr:::bundle_preview_table(obj_empty)
  expect_equal(nrow(r1$table), 0)

  # line 7905: no names
  obj_no_names <- list()
  r2 <- mfrmr:::bundle_preview_table(obj_no_names)
  expect_true(is.na(r2$name))
})

# ---------------------------------------------------------------------------
# 25. resolve_palette (lines 11656, 11662-11664)
# ---------------------------------------------------------------------------
test_that("resolve_palette handles edge cases", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 11656: empty defaults
  r0 <- mfrmr:::resolve_palette(NULL, character(0))
  expect_length(r0, 0)

  # line 11662-11664: unnamed palette overrides positionally
  r1 <- mfrmr:::resolve_palette(
    palette = c("red", "blue"),
    defaults = c(a = "green", b = "yellow", c = "white")
  )
  expect_equal(r1[["a"]], "red")
  expect_equal(r1[["b"]], "blue")
  expect_equal(r1[["c"]], "white")
})

# ---------------------------------------------------------------------------
# 26. signal_legacy_name_deprecation (lines 2702, 2712)
# ---------------------------------------------------------------------------
test_that("signal_legacy_name_deprecation edge cases", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # suppress_if_called_from suppresses warning for specific callers (line 2712)
  result <- mfrmr:::signal_legacy_name_deprecation(
    "old_func", "new_func",
    suppress_if_called_from = NULL
  )
  expect_null(result)
})

# ---------------------------------------------------------------------------
# 27. as_mfrm_bundle edge case (line 2735)
# ---------------------------------------------------------------------------
test_that("as_mfrm_bundle handles non-list input", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 2735: non-list
  expect_equal(mfrmr:::as_mfrm_bundle(42, "test"), 42)

  # normal list
  bnd <- mfrmr:::as_mfrm_bundle(list(a = 1), "test_class")
  expect_true(inherits(bnd, "test_class"))
  expect_true(inherits(bnd, "mfrm_bundle"))
})

# ---------------------------------------------------------------------------
# 28. summary/print for mfrm_fit (lines 11053, 11100, 11143)
# ---------------------------------------------------------------------------
test_that("summary.mfrm_fit covers person SD + convergence notes", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  s <- summary(fit)
  expect_s3_class(s, "summary.mfrm_fit")
  expect_true("facet_overview" %in% names(s))
  expect_true("person_overview" %in% names(s))
  expect_true("step_overview" %in% names(s))
  expect_true("notes" %in% names(s))

  # print
  out <- capture.output(print(s))
  expect_true(any(grepl("Many-Facet Rasch Model Summary", out, fixed = TRUE)))
})

# ---------------------------------------------------------------------------
# 29. summary/print for mfrm_diagnostics (lines 10689, 10753, 10759)
# ---------------------------------------------------------------------------
test_that("summary.mfrm_diagnostics covers lines 10689-10759", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  s <- summary(dx)
  expect_s3_class(s, "summary.mfrm_diagnostics")
  expect_true("flags" %in% names(s))
  expect_true("notes" %in% names(s))

  out <- capture.output(print(s))
  expect_true(any(grepl("Diagnostics Summary", out, fixed = TRUE)))
})

# ---------------------------------------------------------------------------
# 30. summary/print for mfrm_bias (lines 10867, 10883, 10913, 10939, 10964)
# ---------------------------------------------------------------------------
test_that("summary.mfrm_bias covers lines 10867-10964", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  s <- summary(bias_res)
  expect_s3_class(s, "summary.mfrm_bias")
  expect_true("overview" %in% names(s))
  expect_true("top_rows" %in% names(s))

  out <- capture.output(print(s))
  expect_true(any(grepl("Bias Summary", out, fixed = TRUE)))

  # line 10867: empty bias
  expect_error(summary.mfrm_bias(list(table = data.frame())), "non-empty")
})

# ---------------------------------------------------------------------------
# 31. compute_iteration_state (lines 2608, 2619-2620, 2639, 2643, 2667, 2677)
# ---------------------------------------------------------------------------
test_that("table3_iteration_report / compute_iteration_state covers iteration lines", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # This triggers compute_iteration_state internally
  t3 <- mfrmr:::table3_iteration_report(fit, max_iter = 3, include_prox = TRUE)
  expect_true(is.list(t3))
  expect_true("table" %in% names(t3))
  expect_true(nrow(t3$table) > 0)
})

# ---------------------------------------------------------------------------
# 32. plot.mfrm_bundle dispatch (lines 10396-10416)
# ---------------------------------------------------------------------------
test_that("plot.mfrm_bundle dispatches with type argument", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # fair_average (line 10396)
  t12 <- mfrmr::fair_average_table(fit, diagnostics = dx)
  p12 <- plot(t12, type = "scatter", draw = FALSE)
  expect_s3_class(p12, "mfrm_plot_data")

  # displacement (line 10401)
  disp <- mfrmr::displacement_table(fit, diagnostics = dx)
  p_disp <- plot(disp, type = "lollipop", draw = FALSE)
  expect_s3_class(p_disp, "mfrm_plot_data")

  # interrater (line 10406)
  ir <- mfrmr::interrater_agreement_table(fit, diagnostics = dx, rater_facet = "Rater")
  p_ir <- plot(ir, draw = FALSE)
  expect_s3_class(p_ir, "mfrm_plot_data")

  # facets_chisq (line 10411)
  chi <- mfrmr::facets_chisq_table(fit, diagnostics = dx)
  p_chi <- plot(chi, draw = FALSE)
  expect_s3_class(p_chi, "mfrm_plot_data")

  # bias_interaction (line 10416) - pass bias_results as x
  bi <- mfrmr::bias_interaction_report(
    x = bias_res,
    facet_a = "Rater", facet_b = "Criterion"
  )
  p_bi <- plot(bi, draw = FALSE)
  expect_s3_class(p_bi, "mfrm_plot_data")
})

# ---------------------------------------------------------------------------
# 33. step_index_from_label (lines 11229, 11231-11232)
# ---------------------------------------------------------------------------
test_that("step_index_from_label handles edge cases", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 11229: all non-numeric labels
  idx1 <- mfrmr:::step_index_from_label(c("abc", "def"))
  expect_equal(idx1, 1:2)

  # line 11231-11232: partially numeric
  idx2 <- mfrmr:::step_index_from_label(c("Step_1", "abc", "Step_3"))
  expect_true(all(is.finite(idx2)))
  expect_equal(length(idx2), 3)
})

# ---------------------------------------------------------------------------
# 34. build_step_curve_spec edge cases (lines 11240, 11246, 11250, 11272, 11301)
# ---------------------------------------------------------------------------
test_that("build_step_curve_spec from fit object", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  spec <- mfrmr:::build_step_curve_spec(fit)
  expect_true(is.list(spec))
  expect_equal(spec$model, "RSM")
  expect_true(length(spec$groups) > 0)

  # line 11240: empty step table
  bad_fit <- fit
  bad_fit$steps <- data.frame()
  expect_error(mfrmr:::build_step_curve_spec(bad_fit), "Step estimates")
})

# ---------------------------------------------------------------------------
# 35. build_wright_map_data (lines 11348, 11352, 11365, 11379-11383)
# ---------------------------------------------------------------------------
test_that("build_wright_map_data from fit", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  wd <- mfrmr:::build_wright_map_data(fit, top_n = 5)
  expect_true(is.list(wd))
  expect_true("person" %in% names(wd))
  expect_true("locations" %in% names(wd))
  expect_lte(nrow(wd$locations), 5)
})

# ---------------------------------------------------------------------------
# 36. truncate_axis_label (line 11620+)
# ---------------------------------------------------------------------------
test_that("truncate_axis_label truncates long labels", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  short <- mfrmr:::truncate_axis_label("short", width = 28L)
  expect_equal(short, "short")

  long <- mfrmr:::truncate_axis_label(paste(rep("A", 40), collapse = ""), width = 10)
  expect_true(grepl("\\.\\.\\.$", long))
  expect_true(nchar(long) <= 10)
})

# ---------------------------------------------------------------------------
# 37. normalize_bias_plot_input (lines 5105, 5113, 5115-5116, 5118, 5121, 5135)
# ---------------------------------------------------------------------------
test_that("normalize_bias_plot_input error guards", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 5105: mfrm_fit without facet_a/facet_b
  expect_error(
    mfrmr:::normalize_bias_plot_input(fit),
    "interaction_facets"
  )

  # line 5113: interaction_facets with only one element
  expect_error(
    mfrmr:::normalize_bias_plot_input(fit, interaction_facets = "Rater"),
    "at least two"
  )

  # line 5135: non-fit, non-bias input
  expect_error(
    mfrmr:::normalize_bias_plot_input("junk"),
    "estimate_bias"
  )

  # Successful call with fit + interaction_facets
  result <- mfrmr:::normalize_bias_plot_input(
    fit, interaction_facets = c("Rater", "Criterion")
  )
  expect_true(is.list(result))
  expect_true("table" %in% names(result))
})

# ---------------------------------------------------------------------------
# 38. bundle_summary_labels (lines 8696, 8730)
# ---------------------------------------------------------------------------
test_that("bundle_summary_labels handles unknown key", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 8730: unknown key falls through to defaults
  labels <- mfrmr:::bundle_summary_labels("unknown_class")
  expect_equal(labels$title, "mfrmr Bundle Summary")

  # line 8696: empty key
  labels2 <- mfrmr:::bundle_summary_labels("")
  expect_equal(labels2$title, "mfrmr Bundle Summary")

  # Known key
  labels3 <- mfrmr:::bundle_summary_labels("mfrm_unexpected")
  expect_true(grepl("Unexpected", labels3$title))
})

# ---------------------------------------------------------------------------
# 39. print_bundle_section (lines 8735-8736)
# ---------------------------------------------------------------------------
test_that("print_bundle_section handles NULL/empty table", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 8736: NULL table
  r1 <- mfrmr:::print_bundle_section("Test", NULL)
  expect_null(r1)

  # line 8736: empty data.frame
  r2 <- mfrmr:::print_bundle_section("Test", data.frame())
  expect_null(r2)

  # Non-empty
  out <- capture.output(mfrmr:::print_bundle_section("Test Section", data.frame(A = 1:3)))
  expect_true(any(grepl("Test Section", out)))
})

# ---------------------------------------------------------------------------
# 40. summarize_parity_bundle / parity report paths (lines 8319-8332)
# ---------------------------------------------------------------------------
test_that("facets_parity_report summary covers lines 8319-8332", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  parity <- mfrmr::facets_parity_report(fit, diagnostics = dx, bias_results = bias_res)
  expect_s3_class(parity, "mfrm_parity_report")

  s <- summary(parity)
  expect_s3_class(s, "summary.mfrm_bundle")
  expect_true("notes" %in% names(s))
})

# ---------------------------------------------------------------------------
# 41. specifications_report / plot (lines 9393-9430, 9439-9446)
# ---------------------------------------------------------------------------
test_that("specifications_report and plot cover spec lines", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  spec <- mfrmr::specifications_report(fit)
  expect_s3_class(spec, "mfrm_specifications")

  s <- summary(spec)
  expect_s3_class(s, "summary.mfrm_bundle")

  # plot with draw = FALSE
  p <- plot(spec, type = "convergence", draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
})

# ---------------------------------------------------------------------------
# 42. data_quality_report plot (lines 9511, 9532, 9534)
# ---------------------------------------------------------------------------
test_that("data_quality_report and plot cover lines 9511-9534", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  d <- mfrmr:::sample_mfrm_data(seed = 42)
  dq <- mfrmr::data_quality_report(fit, data = d, person = "Person",
                                     facets = c("Rater", "Task", "Criterion"),
                                     score = "Score")
  expect_s3_class(dq, "mfrm_data_quality")

  # plot type = "category_counts" (line 9511)
  p1 <- plot(dq, type = "category_counts", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")

  # plot type = "missing_rows" (line 9532)
  p2 <- plot(dq, type = "missing_rows", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
})

# ---------------------------------------------------------------------------
# 43. estimation_iteration_report plot (lines 9572, 9575, 9581)
# ---------------------------------------------------------------------------
test_that("estimation_iteration_report plot covers lines 9572-9581", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  iter_rep <- mfrmr::estimation_iteration_report(fit, max_iter = 3)
  expect_s3_class(iter_rep, "mfrm_iteration_report")

  p1 <- plot(iter_rep, type = "residual", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")

  p2 <- plot(iter_rep, type = "logit_change", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
})

# ---------------------------------------------------------------------------
# 44. visual_summaries / plot path (lines 8014, 8018, 10281-10295)
# ---------------------------------------------------------------------------
test_that("build_visual_summaries summary and plot", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  vs <- mfrmr::build_visual_summaries(fit, diagnostics = dx)
  expect_s3_class(vs, "mfrm_visual_summaries")

  s <- summary(vs)
  expect_s3_class(s, "summary.mfrm_bundle")

  out <- capture.output(print(s))
  expect_true(any(grepl("Visual", out)))
})

# ---------------------------------------------------------------------------
# 45. infer_facet_names (line 4264+)
# ---------------------------------------------------------------------------
test_that("infer_facet_names from different sources", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # Normal path: facet_names directly available
  fn <- mfrmr:::infer_facet_names(dx)
  expect_true(length(fn) > 0)

  # Fallback: measures$Facet
  dx_mini <- list(
    measures = data.frame(Facet = c("Rater", "Task", "Person"), stringsAsFactors = FALSE)
  )
  fn2 <- mfrmr:::infer_facet_names(dx_mini)
  expect_true("Rater" %in% fn2)
  expect_false("Person" %in% fn2)
})

# ---------------------------------------------------------------------------
# 46. with_legacy_name_warning_suppressed (line 2728+)
# ---------------------------------------------------------------------------
test_that("with_legacy_name_warning_suppressed suppresses warnings", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  result <- mfrmr:::with_legacy_name_warning_suppressed({
    1 + 1
  })
  expect_equal(result, 2)
})

# ---------------------------------------------------------------------------
# 47. resolve_pca_input (lines 4452-4457)
# ---------------------------------------------------------------------------
test_that("resolve_pca_input handles different inputs", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 4453: NULL
  expect_error(mfrmr:::resolve_pca_input(NULL), "NULL")

  # line 4457: invalid input (non-list, non-fit)
  expect_error(mfrmr:::resolve_pca_input(list(a = 1)))

  # mfrm_fit input (line 4455)
  pca <- mfrmr:::resolve_pca_input(fit)
  expect_true(!is.null(pca$overall_table))

  # diagnostics input (line 4456)
  pca2 <- mfrmr:::resolve_pca_input(dx)
  expect_true(!is.null(pca2$overall_table))
})

# ---------------------------------------------------------------------------
# 48. plot.mfrm_fit type guards (lines 13075, 13081, 13126, 13136, 13146, 13150, 13162)
# ---------------------------------------------------------------------------
test_that("plot.mfrm_fit error guards", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  # line 13081: bad theta_range
  expect_error(
    plot(fit, theta_range = c(5, 2), draw = FALSE),
    "theta_range"
  )

  # line 13162: facet filter
  p_facet <- plot(fit, type = "facet", facet = "Rater", draw = FALSE)
  expect_s3_class(p_facet, "mfrm_plot_data")

  # line 13150: nonexistent facet filter
  expect_error(
    plot(fit, type = "facet", facet = "Nonexistent", draw = FALSE),
    "not found"
  )
})

# ---------------------------------------------------------------------------
# 49. category_structure_report and category_curves_report
# ---------------------------------------------------------------------------
test_that("category_structure_report and category_curves_report cover bundle lines", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  cs <- mfrmr::category_structure_report(fit, diagnostics = dx)
  expect_s3_class(cs, "mfrm_category_structure")
  s_cs <- summary(cs)
  expect_s3_class(s_cs, "summary.mfrm_bundle")

  cc <- mfrmr::category_curves_report(fit)
  expect_s3_class(cc, "mfrm_category_curves")
  s_cc <- summary(cc)
  expect_s3_class(s_cc, "summary.mfrm_bundle")
})

# ---------------------------------------------------------------------------
# 50. fit_mfrm with anchor_policy = "warn" (line 226)
# ---------------------------------------------------------------------------
test_that("fit_mfrm with anchor_policy error triggers error", {
  skip_on_cran()
  old_opt <- options(lifecycle_verbosity = "quiet")
  on.exit(options(old_opt), add = TRUE)

  d <- mfrmr:::sample_mfrm_data(seed = 42)

  # Create anchors with a nonexistent level to trigger an audit issue
  bad_anchor <- data.frame(
    Facet = c("Rater", "Rater"),
    Level = c("R1", "R_NONEXIST"),
    Anchor = c(0.5, -0.5),
    stringsAsFactors = FALSE
  )

  expect_error(
    mfrmr::fit_mfrm(
      data = d, person = "Person",
      facets = c("Rater", "Task", "Criterion"), score = "Score",
      method = "JML", maxit = 15,
      anchors = bad_anchor,
      anchor_policy = "error"
    ),
    regexp = "anchor|Anchor|audit|issue",
    ignore.case = TRUE
  )

  # Also test anchor_policy = "silent" path for code coverage
  # This should continue after removing invalid rows.
  result <- suppressWarnings(
    suppressWarnings(mfrmr::fit_mfrm(
      data = d, person = "Person",
      facets = c("Rater", "Task", "Criterion"), score = "Score",
      method = "JML", maxit = 15,
      anchors = bad_anchor,
      anchor_policy = "silent"
    ))
  )
  expect_s3_class(result, "mfrm_fit")
})