tests/testthat/test-bundle-coverage.R

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

# test-bundle-coverage.R
# Exercises print.summary.mfrm_bundle branches (lines 8747-8841)
# and plot.mfrm_bundle dispatch branches (lines 10303-10634) in api.R.
# Goal: cover all summary_kind branches and all plot type sub-variants.

# ---- Shared fixture ----

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

  .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)
  .bias <<- estimate_bias(.fit, .diag, facet_a = "Rater", facet_b = "Task")
})

# ---- Helper: run code in a null graphics device ----
with_null_device <- function(expr) {
  grDevices::pdf(NULL)
  on.exit(grDevices::dev.off(), add = TRUE)
  testthat::expect_gt(grDevices::dev.cur(), 1)
  value <- force(expr)
  invisible(value)
}

# ============================================================================
# SECTION 1: print.summary.mfrm_bundle -- all summary_kind branches
# ============================================================================

# ---- bias_count summary_kind ----
test_that("print.summary.mfrm_bundle: bias_count branch", {
  bc <- bias_count_table(.bias)
  s <- summary(bc)
  out <- capture.output(print(s))
  expect_true(any(grepl("Bias Count", out)))
})

# ---- visual_summaries summary_kind ----
test_that("print.summary.mfrm_bundle: visual_summaries branch", {
  vs <- build_visual_summaries(.fit, diagnostics = .diag)
  s <- summary(vs)
  out <- capture.output(print(s))
  expect_true(any(grepl("Visual Summary", out)))
})

# ---- fixed_reports summary_kind ----
test_that("print.summary.mfrm_bundle: fixed_reports branch", {
  fr <- build_fixed_reports(.bias)
  s <- summary(fr)
  out <- capture.output(print(s))
  expect_true(any(grepl("Fixed-Report", out)) || length(out) > 0)
})

# ---- unexpected summary_kind (generic path through bundle_summary_labels) ----
test_that("print.summary.mfrm_bundle: unexpected (generic path)", {
  ut <- unexpected_response_table(.fit, diagnostics = .diag)
  s <- summary(ut)
  out <- capture.output(print(s))
  expect_true(any(grepl("Unexpected", out)))
})

# ---- fair_average summary_kind ----
test_that("print.summary.mfrm_bundle: fair_average", {
  fa <- fair_average_table(.fit, diagnostics = .diag)
  s <- summary(fa)
  out <- capture.output(print(s))
  expect_true(any(grepl("Adjusted Score|Fair Average", out)))
})

# ---- displacement summary_kind ----
test_that("print.summary.mfrm_bundle: displacement", {
  dt <- displacement_table(.fit, diagnostics = .diag)
  s <- summary(dt)
  out <- capture.output(print(s))
  expect_true(any(grepl("Displacement", out)))
})

# ---- interrater summary_kind ----
test_that("print.summary.mfrm_bundle: interrater", {
  ia <- interrater_agreement_table(.fit, diagnostics = .diag)
  s <- summary(ia)
  out <- capture.output(print(s))
  expect_true(any(grepl("Agreement", out)))
})

# ---- facets_chisq summary_kind ----
test_that("print.summary.mfrm_bundle: facets_chisq", {
  fc <- facets_chisq_table(.fit, diagnostics = .diag)
  s <- summary(fc)
  out <- capture.output(print(s))
  expect_true(any(grepl("Facet Variability|Chi-square", out)))
})

# ---- bias_interaction summary_kind ----
test_that("print.summary.mfrm_bundle: bias_interaction", {
  bi <- bias_interaction_report(.fit, diagnostics = .diag,
                                facet_a = "Rater", facet_b = "Task")
  s <- summary(bi)
  out <- capture.output(print(s))
  expect_true(any(grepl("Interaction", out)) || length(out) > 0)
})

# ---- rating_scale summary_kind ----
test_that("print.summary.mfrm_bundle: rating_scale", {
  rs <- rating_scale_table(.fit, diagnostics = .diag)
  s <- summary(rs)
  out <- capture.output(print(s))
  expect_true(any(grepl("Rating Scale", out)))
})

# ---- category_structure summary_kind ----
test_that("print.summary.mfrm_bundle: category_structure", {
  cs <- category_structure_report(.fit, diagnostics = .diag)
  s <- summary(cs)
  out <- capture.output(print(s))
  expect_true(any(grepl("Category Structure", out)))
})

# ---- category_curves summary_kind ----
test_that("print.summary.mfrm_bundle: category_curves", {
  cc <- category_curves_report(.fit)
  s <- summary(cc)
  out <- capture.output(print(s))
  expect_true(any(grepl("Category Curves", out)))
})

# ---- measurable summary_kind ----
test_that("print.summary.mfrm_bundle: measurable", {
  ms <- measurable_summary_table(.fit, diagnostics = .diag)
  s <- summary(ms)
  out <- capture.output(print(s))
  expect_true(any(grepl("Measurable", out)))
})

# ---- unexpected_after_bias summary_kind ----
test_that("print.summary.mfrm_bundle: unexpected_after_bias", {
  ub <- unexpected_after_bias_table(.fit, bias_results = .bias, diagnostics = .diag)
  s <- summary(ub)
  out <- capture.output(print(s))
  expect_true(any(grepl("Unexpected", out)) || length(out) > 0)
})

# ---- output_bundle summary_kind ----
test_that("print.summary.mfrm_bundle: output_bundle", {
  ob <- facets_output_file_bundle(.fit, diagnostics = .diag)
  s <- summary(ob)
  out <- capture.output(print(s))
  expect_true(any(grepl("Output", out)) || length(out) > 0)
})

# ---- residual_pca summary_kind ----
test_that("print.summary.mfrm_bundle: residual_pca", {
  pca <- analyze_residual_pca(.diag, mode = "both")
  s <- summary(pca)
  out <- capture.output(print(s))
  expect_true(any(grepl("PCA", out)) || length(out) > 0)
})

# ---- specifications summary_kind ----
test_that("print.summary.mfrm_bundle: specifications", {
  spec <- specifications_report(.fit)
  s <- summary(spec)
  out <- capture.output(print(s))
  expect_true(any(grepl("Specification", out)))
})

# ---- data_quality summary_kind ----
test_that("print.summary.mfrm_bundle: data_quality", {
  dq <- data_quality_report(.fit)
  s <- summary(dq)
  out <- capture.output(print(s))
  expect_true(any(grepl("Data Quality", out)))
})

# ---- iteration_report summary_kind ----
test_that("print.summary.mfrm_bundle: iteration_report", {
  ir <- suppressWarnings(estimation_iteration_report(.fit))
  s <- summary(ir)
  out <- capture.output(print(s))
  expect_true(any(grepl("Iteration", out)) || length(out) > 0)
})

# ---- subset_connectivity summary_kind ----
test_that("print.summary.mfrm_bundle: subset_connectivity", {
  sc <- subset_connectivity_report(.fit)
  s <- summary(sc)
  out <- capture.output(print(s))
  expect_true(any(grepl("Subset", out)) || any(grepl("Connectivity", out)))
})

# ---- facet_statistics summary_kind ----
test_that("print.summary.mfrm_bundle: facet_statistics", {
  fs <- facet_statistics_report(.fit, diagnostics = .diag)
  s <- summary(fs)
  out <- capture.output(print(s))
  expect_true(any(grepl("Facet", out)))
})

# ---- parity_report summary_kind ----
test_that("print.summary.mfrm_bundle: parity_report", {
  pr <- facets_parity_report(.fit, diagnostics = .diag, bias_results = .bias)
  s <- summary(pr)
  out <- capture.output(print(s))
  expect_true(any(grepl("Parity", out)) || length(out) > 0)
})

# ============================================================================
# SECTION 2: plot.mfrm_bundle -- all class dispatches with draw=FALSE
# ============================================================================

# ---- mfrm_unexpected via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_unexpected", {
  ut <- unexpected_response_table(.fit, diagnostics = .diag)
  p <- plot(ut, draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
  p2 <- plot(ut, type = "severity", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
})

# ---- mfrm_fair_average via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_fair_average", {
  fa <- fair_average_table(.fit, diagnostics = .diag)
  p <- plot(fa, draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
})

# ---- mfrm_displacement via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_displacement", {
  dt <- displacement_table(.fit, diagnostics = .diag)
  p <- plot(dt, draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
})

# ---- mfrm_interrater via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_interrater", {
  ia <- interrater_agreement_table(.fit, diagnostics = .diag)
  p <- plot(ia, draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
})

# ---- mfrm_facets_chisq via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_facets_chisq", {
  fc <- facets_chisq_table(.fit, diagnostics = .diag)
  p <- plot(fc, draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
})

# ---- mfrm_bias_interaction via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_bias_interaction", {
  bi <- bias_interaction_report(.fit, diagnostics = .diag,
                                facet_a = "Rater", facet_b = "Task")
  p <- plot(bi, draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
})

# ---- mfrm_bias_count via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_bias_count", {
  bc <- bias_count_table(.bias)
  p <- plot(bc, draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
  p2 <- plot(bc, type = "lowcount_by_facet", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
})

# ---- mfrm_fixed_reports via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_fixed_reports", {
  fr <- build_fixed_reports(.bias)
  p <- plot(fr, draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
  p2 <- plot(fr, type = "pvalue", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
})

# ---- mfrm_visual_summaries via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_visual_summaries", {
  vs <- build_visual_summaries(.fit, diagnostics = .diag)
  p <- plot(vs, type = "comparison", draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
  p2 <- plot(vs, type = "warning_counts", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(vs, type = "summary_counts", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- mfrm_category_structure via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_category_structure", {
  cs <- category_structure_report(.fit, diagnostics = .diag)
  p <- plot(cs, type = "counts", draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
})

# ---- mfrm_category_curves via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_category_curves", {
  cc <- category_curves_report(.fit)
  p <- plot(cc, type = "ogive", draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
  p2 <- plot(cc, type = "ccc", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
})

# ---- mfrm_rating_scale via plot.mfrm_bundle ----
test_that("plot.mfrm_bundle dispatches for mfrm_rating_scale", {
  rs <- rating_scale_table(.fit, diagnostics = .diag)
  p <- plot(rs, type = "counts", draw = FALSE)
  expect_s3_class(p, "mfrm_plot_data")
  p2 <- plot(rs, type = "thresholds", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
})

# ---- mfrm_measurable via plot.mfrm_bundle: facet_coverage, category_counts, subset_observations ----
test_that("plot.mfrm_bundle dispatches for mfrm_measurable -- all sub-types", {
  ms <- measurable_summary_table(.fit, diagnostics = .diag)
  p1 <- plot(ms, type = "facet_coverage", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(ms, type = "category_counts", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(ms, type = "subset_observations", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- mfrm_unexpected_after_bias via plot.mfrm_bundle: scatter, severity, comparison ----
test_that("plot.mfrm_bundle dispatches for mfrm_unexpected_after_bias -- all sub-types", {
  ub <- unexpected_after_bias_table(.fit, bias_results = .bias, diagnostics = .diag)
  p1 <- plot(ub, type = "scatter", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(ub, type = "severity", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(ub, type = "comparison", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- mfrm_output_bundle via plot.mfrm_bundle: graph_expected, score_residuals, obs_probability ----
test_that("plot.mfrm_bundle dispatches for mfrm_output_bundle -- all sub-types", {
  ob <- facets_output_file_bundle(.fit, diagnostics = .diag)
  p1 <- plot(ob, type = "graph_expected", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(ob, type = "score_residuals", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(ob, type = "obs_probability", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- mfrm_residual_pca via plot.mfrm_bundle: overall_scree, overall_loadings ----
test_that("plot.mfrm_bundle dispatches for mfrm_residual_pca", {
  pca <- analyze_residual_pca(.diag, mode = "both")
  p1 <- plot(pca, type = "overall_scree", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(pca, type = "overall_loadings", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(pca, type = "facet_scree", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
  p4 <- plot(pca, type = "facet_loadings", draw = FALSE)
  expect_s3_class(p4, "mfrm_plot_data")
})

# ---- mfrm_specifications via plot.mfrm_bundle: facet_elements, convergence ----
test_that("plot.mfrm_bundle dispatches for mfrm_specifications -- all sub-types", {
  spec <- specifications_report(.fit)
  p1 <- plot(spec, type = "facet_elements", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(spec, type = "convergence", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(spec, type = "anchor_constraints", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- mfrm_data_quality via plot.mfrm_bundle: row_audit, category_counts, missing_rows ----
test_that("plot.mfrm_bundle dispatches for mfrm_data_quality -- all sub-types", {
  d <- mfrmr:::sample_mfrm_data(seed = 42)
  dq <- data_quality_report(.fit, data = d)
  p1 <- plot(dq, type = "row_audit", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(dq, type = "category_counts", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(dq, type = "missing_rows", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- mfrm_iteration_report via plot.mfrm_bundle: residual, logit_change, objective ----
test_that("plot.mfrm_bundle dispatches for mfrm_iteration_report -- all sub-types", {
  ir <- suppressWarnings(estimation_iteration_report(.fit))
  p1 <- plot(ir, type = "residual", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(ir, type = "logit_change", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(ir, type = "objective", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- mfrm_subset_connectivity via plot.mfrm_bundle: subset_observations, facet_levels ----
test_that("plot.mfrm_bundle dispatches for mfrm_subset_connectivity -- all sub-types", {
  sc <- subset_connectivity_report(.fit)
  p1 <- plot(sc, type = "subset_observations", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(sc, type = "facet_levels", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
})

# ---- mfrm_facet_statistics via plot.mfrm_bundle: means, sds, ranges ----
test_that("plot.mfrm_bundle dispatches for mfrm_facet_statistics -- all sub-types", {
  fs <- facet_statistics_report(.fit, diagnostics = .diag)
  p1 <- plot(fs, type = "means", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(fs, type = "sds", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(fs, type = "ranges", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
})

# ---- mfrm_parity_report via plot.mfrm_bundle: column_coverage, table_coverage, metric_status, metric_by_table ----
test_that("plot.mfrm_bundle dispatches for mfrm_parity_report -- all sub-types", {
  pr <- facets_parity_report(.fit, diagnostics = .diag, bias_results = .bias)
  p1 <- plot(pr, type = "column_coverage", draw = FALSE)
  expect_s3_class(p1, "mfrm_plot_data")
  p2 <- plot(pr, type = "table_coverage", draw = FALSE)
  expect_s3_class(p2, "mfrm_plot_data")
  p3 <- plot(pr, type = "metric_status", draw = FALSE)
  expect_s3_class(p3, "mfrm_plot_data")
  p4 <- plot(pr, type = "metric_by_table", draw = FALSE)
  expect_s3_class(p4, "mfrm_plot_data")
})

# ============================================================================
# SECTION 3: draw=TRUE code paths inside pdf(NULL) for the draw_* functions
# ============================================================================

# ---- draw_category_structure_bundle: counts, mode_boundaries, mean_halfscore ----
test_that("draw_category_structure_bundle draws all sub-types", {
  cs <- category_structure_report(.fit, diagnostics = .diag)
  with_null_device(plot(cs, type = "counts", draw = TRUE))
  # mode_boundaries and mean_halfscore may fail if data lacks those columns;
  # we still exercise the entry path
  tryCatch(
    with_null_device(plot(cs, type = "mode_boundaries", draw = TRUE)),
    error = function(e) expect_true(grepl("mode-boundary", e$message, ignore.case = TRUE))
  )
  tryCatch(
    with_null_device(plot(cs, type = "mean_halfscore", draw = TRUE)),
    error = function(e) expect_true(grepl("mean half-score", e$message, ignore.case = TRUE))
  )
})

# ---- draw_category_curves_bundle: ogive, ccc ----
test_that("draw_category_curves_bundle draws all sub-types", {
  cc <- category_curves_report(.fit)
  with_null_device(plot(cc, type = "ogive", draw = TRUE))
  with_null_device(plot(cc, type = "ccc", draw = TRUE))
})

# ---- draw_rating_scale_bundle: counts, thresholds ----
test_that("draw_rating_scale_bundle draws all sub-types", {
  rs <- rating_scale_table(.fit, diagnostics = .diag)
  with_null_device(plot(rs, type = "counts", draw = TRUE))
  with_null_device(plot(rs, type = "thresholds", draw = TRUE))
})

# ---- draw_measurable_bundle: facet_coverage, category_counts, subset_observations ----
test_that("draw_measurable_bundle draws all sub-types", {
  ms <- measurable_summary_table(.fit, diagnostics = .diag)
  with_null_device(plot(ms, type = "facet_coverage", draw = TRUE))
  with_null_device(plot(ms, type = "category_counts", draw = TRUE))
  with_null_device(plot(ms, type = "subset_observations", draw = TRUE))
})

# ---- draw_unexpected_after_bias_bundle: scatter, severity, comparison ----
test_that("draw_unexpected_after_bias_bundle draws all sub-types", {
  ub <- unexpected_after_bias_table(.fit, bias_results = .bias, diagnostics = .diag)
  with_null_device(plot(ub, type = "scatter", draw = TRUE))
  with_null_device(plot(ub, type = "severity", draw = TRUE))
  with_null_device(plot(ub, type = "comparison", draw = TRUE))
})

# ---- draw_output_bundle: graph_expected, score_residuals, obs_probability ----
test_that("draw_output_bundle draws all sub-types", {
  ob <- facets_output_file_bundle(.fit, diagnostics = .diag)
  with_null_device(plot(ob, type = "graph_expected", draw = TRUE))
  with_null_device(plot(ob, type = "score_residuals", draw = TRUE))
  with_null_device(plot(ob, type = "obs_probability", draw = TRUE))
})

# ---- draw_specifications_bundle: facet_elements, anchor_constraints, convergence ----
test_that("draw_specifications_bundle draws all sub-types", {
  spec <- specifications_report(.fit)
  with_null_device(plot(spec, type = "facet_elements", draw = TRUE))
  # anchor_constraints may trigger barplot error with certain data shapes;
  # exercise the entry path and tolerate errors from graphics internals.
  tryCatch(
    with_null_device(plot(spec, type = "anchor_constraints", draw = TRUE)),
    error = function(e) expect_match(conditionMessage(e), ".+")
  )
  with_null_device(plot(spec, type = "convergence", draw = TRUE))
})

# ---- draw_data_quality_bundle: row_audit, category_counts, missing_rows ----
test_that("draw_data_quality_bundle draws all sub-types", {
  d <- mfrmr:::sample_mfrm_data(seed = 42)
  dq <- data_quality_report(.fit, data = d)
  with_null_device(plot(dq, type = "row_audit", draw = TRUE))
  with_null_device(plot(dq, type = "category_counts", draw = TRUE))
  with_null_device(plot(dq, type = "missing_rows", draw = TRUE))
})

# ---- draw_iteration_report_bundle: residual, logit_change, objective ----
test_that("draw_iteration_report_bundle draws all sub-types", {
  ir <- suppressWarnings(estimation_iteration_report(.fit))
  with_null_device(plot(ir, type = "residual", draw = TRUE))
  with_null_device(plot(ir, type = "logit_change", draw = TRUE))
  with_null_device(plot(ir, type = "objective", draw = TRUE))
})

# ---- draw_subset_connectivity_bundle: subset_observations, facet_levels ----
test_that("draw_subset_connectivity_bundle draws all sub-types", {
  sc <- subset_connectivity_report(.fit)
  with_null_device(plot(sc, type = "subset_observations", draw = TRUE))
  with_null_device(plot(sc, type = "facet_levels", draw = TRUE))
})

# ---- draw_facet_statistics_bundle: means, sds, ranges ----
test_that("draw_facet_statistics_bundle draws all sub-types", {
  fs <- facet_statistics_report(.fit, diagnostics = .diag)
  with_null_device(plot(fs, type = "means", draw = TRUE))
  with_null_device(plot(fs, type = "sds", draw = TRUE))
  with_null_device(plot(fs, type = "ranges", draw = TRUE))
})

# ---- draw_parity_bundle: column_coverage, table_coverage, metric_status, metric_by_table ----
test_that("draw_parity_bundle draws all sub-types", {
  pr <- facets_parity_report(.fit, diagnostics = .diag, bias_results = .bias)
  with_null_device(plot(pr, type = "column_coverage", draw = TRUE))
  with_null_device(plot(pr, type = "table_coverage", draw = TRUE))
  with_null_device(plot(pr, type = "metric_status", draw = TRUE))
  with_null_device(plot(pr, type = "metric_by_table", draw = TRUE))
})

# ---- plot_bias_count_bundle: cell_counts, lowcount_by_facet ----
test_that("plot_bias_count_bundle draws all sub-types", {
  bc <- bias_count_table(.bias)
  with_null_device(plot(bc, type = "cell_counts", draw = TRUE))
  with_null_device(plot(bc, type = "lowcount_by_facet", draw = TRUE))
})

# ---- plot_fixed_reports_bundle: contrast, pvalue ----
test_that("plot_fixed_reports_bundle draws all sub-types", {
  fr <- build_fixed_reports(.bias)
  with_null_device(plot(fr, type = "contrast", draw = TRUE))
  with_null_device(plot(fr, type = "pvalue", draw = TRUE))
})

# ---- plot_visual_summaries_bundle: comparison, warning_counts, summary_counts ----
test_that("plot_visual_summaries_bundle draws all sub-types", {
  vs <- build_visual_summaries(.fit, diagnostics = .diag)
  # comparison draw may fail if no visuals have both warning and summary counts;
  # tolerate graphics errors while exercising the dispatch path.
  tryCatch(
    with_null_device(plot(vs, type = "comparison", draw = TRUE)),
    error = function(e) expect_match(conditionMessage(e), ".+")
  )
  with_null_device(plot(vs, type = "warning_counts", draw = TRUE))
  with_null_device(plot(vs, type = "summary_counts", draw = TRUE))
})

# ---- draw_residual_pca_bundle: overall_scree, facet_scree, overall_loadings, facet_loadings ----
test_that("draw_residual_pca_bundle draws all sub-types", {
  pca <- analyze_residual_pca(.diag, mode = "both")
  with_null_device(plot(pca, type = "overall_scree", draw = TRUE))
  with_null_device(plot(pca, type = "overall_loadings", draw = TRUE))
  with_null_device(plot(pca, type = "facet_scree", draw = TRUE))
  with_null_device(plot(pca, type = "facet_loadings", draw = TRUE))
})

# ============================================================================
# SECTION 4: plot.mfrm_bundle custom main/palette/label_angle pass-through
# ============================================================================

test_that("plot.mfrm_bundle passes custom main and palette to draw functions", {
  spec <- specifications_report(.fit)
  with_null_device(
    plot(spec, type = "facet_elements", draw = TRUE,
         main = "Custom Title", palette = c(facet = "#ff0000"),
         label_angle = 30)
  )
  d2 <- mfrmr:::sample_mfrm_data(seed = 42)
  dq <- data_quality_report(.fit, data = d2)
  with_null_device(
    plot(dq, type = "row_audit", draw = TRUE,
         main = "Custom DQ Title", label_angle = 60)
  )
})

# ============================================================================
# SECTION 5: plot.mfrm_bundle error for unknown class
# ============================================================================

test_that("plot.mfrm_bundle errors for unrecognized class", {
  fake <- list(a = 1)
  class(fake) <- c("mfrm_unknown_thing", "mfrm_bundle", "list")
  expect_error(plot(fake), "No default plot method")
})