# 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") })