# -------------------------------------------------------------------------- # test-api-coverage-gaps.R # Targets uncovered lines in R/api.R to increase test coverage. # -------------------------------------------------------------------------- with_null_device <- function(expr) { grDevices::pdf(NULL) on.exit(grDevices::dev.off(), add = TRUE) force(expr) } # ---- shared fixtures (fitted once) ---------------------------------------- local({ d <<- mfrmr:::sample_mfrm_data(seed = 123) fit <<- suppressWarnings(mfrmr::fit_mfrm( data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", method = "JML", model = "RSM", maxit = 20, quad_points = 7 )) dx <<- mfrmr::diagnose_mfrm(fit, residual_pca = "both", pca_max_factors = 4) bias <<- mfrmr::estimate_bias( fit, dx, facet_a = "Rater", facet_b = "Criterion", max_iter = 2 ) }) # ========================================================================== # 1. print.mfrm_data_description (lines 554-566) # ========================================================================== test_that("print.mfrm_data_description prints overview, score distribution, and agreement", { desc <- mfrmr::describe_mfrm_data( data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", rater_facet = "Rater" ) expect_s3_class(desc, "mfrm_data_description") out <- capture.output(print(desc)) expect_true(any(grepl("mfrm data description", out, fixed = TRUE))) # score distribution section expect_true(any(grepl("Score distribution", out, fixed = TRUE))) # inter-rater agreement section expect_true(any(grepl("Inter-rater agreement", out, fixed = TRUE))) # The function must return invisible(x) ret <- capture.output(invisible_ret <- print(desc)) expect_identical(invisible_ret, desc) }) # ========================================================================== # 2. print.mfrm_anchor_audit (lines 962-987) # ========================================================================== test_that("print.mfrm_anchor_audit covers all branches", { anchors <- data.frame( Facet = c("Rater", "Rater"), Level = c("R1", "R2"), Anchor = c(0, 0.1), stringsAsFactors = FALSE ) aud <- mfrmr::audit_mfrm_anchors( data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", anchors = anchors ) expect_s3_class(aud, "mfrm_anchor_audit") out <- capture.output(print(aud)) expect_true(any(grepl("mfrm anchor audit", out, fixed = TRUE))) expect_true(any(grepl("issue rows", out, fixed = TRUE))) # facet summary branch expect_true(any(grepl("Facet summary", out, fixed = TRUE))) }) # ========================================================================== # 3. plot.mfrm_anchor_audit facet_constraints + level_observations (lines 1216-1239) # ========================================================================== test_that("plot.mfrm_anchor_audit draws facet_constraints and level_observations", { anchors <- data.frame( Facet = c("Rater", "Rater"), Level = c("R1", "R2"), Anchor = c(0, 0.1), stringsAsFactors = FALSE ) aud <- mfrmr::audit_mfrm_anchors( data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", anchors = anchors ) # facet_constraints (draw=FALSE) -- covers code that builds the table p1 <- plot(aud, type = "facet_constraints", draw = FALSE) expect_s3_class(p1, "mfrm_plot_data") # level_observations (drawn) -- covers lines 1237+ p2 <- with_null_device( plot(aud, type = "level_observations", draw = TRUE) ) expect_s3_class(p2, "mfrm_plot_data") }) # ========================================================================== # 4. interrater_agreement_table with context_facets (lines 1552-1561) # ========================================================================== test_that("interrater_agreement_table handles explicit context_facets", { # context_facets supplied, covering the else-branch ir <- mfrmr::interrater_agreement_table( fit, diagnostics = dx, rater_facet = "Rater", context_facets = c("Task", "Criterion") ) expect_s3_class(ir, "mfrm_interrater") expect_true(is.data.frame(ir$pairs)) # unknown context_facets => error expect_error( mfrmr::interrater_agreement_table( fit, diagnostics = dx, rater_facet = "Rater", context_facets = c("Nonexistent") ), "Unknown" ) # context_facets = same as rater_facet => error expect_error( mfrmr::interrater_agreement_table( fit, diagnostics = dx, rater_facet = "Rater", context_facets = c("Rater") ), "different from" ) }) # ========================================================================== # 5. displacement_table with facets/anchored_only/top_n filters (lines 1998-2008) # ========================================================================== test_that("displacement_table filters by facets, anchored_only, and top_n", { # facets filter disp_f <- mfrmr::displacement_table( fit, diagnostics = dx, facets = "Rater" ) expect_s3_class(disp_f, "mfrm_displacement") if (nrow(disp_f$table) > 0) { expect_true(all(disp_f$table$Facet == "Rater")) } # anchored_only filter disp_a <- mfrmr::displacement_table( fit, diagnostics = dx, anchored_only = TRUE ) expect_s3_class(disp_a, "mfrm_displacement") # top_n filter disp_t <- mfrmr::displacement_table( fit, diagnostics = dx, top_n = 3 ) expect_s3_class(disp_t, "mfrm_displacement") expect_true(nrow(disp_t$table) <= 3) }) # ========================================================================== # 6. data_quality_report with external data + include_fixed (lines 3018-3054) # ========================================================================== test_that("data_quality_report covers include_fixed and row-audit branches", { t2_fixed <- mfrmr::data_quality_report( fit, data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", include_fixed = TRUE ) expect_true("fixed" %in% names(t2_fixed)) expect_true(is.character(t2_fixed$fixed)) # Inject bad rows to trigger row-status branches (missing_score, out_of_range) d_bad <- d d_bad$Score[1:3] <- NA d_bad$Score[4] <- 999 t2_bad <- mfrmr::data_quality_report( fit, data = d_bad, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score" ) expect_s3_class(t2_bad, "mfrm_data_quality") expect_true(is.data.frame(t2_bad$row_audit)) if (nrow(t2_bad$row_audit) > 0) { expect_true(any(t2_bad$row_audit$Status %in% c("missing_score", "out_of_range"))) } }) # ========================================================================== # 7. subset_connectivity_report empty branches (lines 3376-3415) # ========================================================================== test_that("subset_connectivity_report filters by top_n_subsets and min_observations", { t6 <- mfrmr::subset_connectivity_report(fit, diagnostics = dx) expect_s3_class(t6, "mfrm_subset_connectivity") # Exercise top_n_subsets t6_top <- mfrmr::subset_connectivity_report( fit, diagnostics = dx, top_n_subsets = 1 ) expect_true(nrow(t6_top$summary) <= 1) # Exercise min_observations t6_min <- mfrmr::subset_connectivity_report( fit, diagnostics = dx, min_observations = 1e6 ) # With extreme threshold, likely no subsets survive expect_true(is.data.frame(t6_min$summary)) }) # ========================================================================== # 8. infer_facet_names fallback paths (lines 4269-4285) # ========================================================================== test_that("infer_facet_names exercises fallback paths", { infer <- mfrmr:::infer_facet_names # Path 1: facet_names provided directly expect_equal(infer(list(facet_names = c("A", "B"))), c("A", "B")) # Path 2: from measures$Facet (excluding "Person") measures <- data.frame( Facet = c("Person", "Rater", "Task"), stringsAsFactors = FALSE ) expect_equal(infer(list(facet_names = NULL, measures = measures)), c("Rater", "Task")) # Path 3: from obs column names obs <- data.frame( Person = "P1", Score = 1, Weight = 1, Rater = "R1", Task = "T1", Observed = 1, Expected = 1, Var = 0.1, Residual = 0, StdResidual = 0, StdSq = 0, stringsAsFactors = FALSE ) expect_equal( infer(list(facet_names = NULL, measures = data.frame(), obs = obs)), c("Rater", "Task") ) # Path 4: empty fallback expect_equal(infer(list()), character(0)) }) # ========================================================================== # 9. build_fixed_reports empty bias (lines 4854-4874) # ========================================================================== test_that("build_fixed_reports handles NULL and empty bias", { # NULL bias_results result_null <- mfrmr::build_fixed_reports(NULL) expect_true(inherits(result_null, "mfrm_bundle")) expect_equal(result_null$bias_fixed, "No bias data") # Empty table empty_bias <- list(table = data.frame(), summary = data.frame(), facet_a = "A", facet_b = "B") result_empty <- mfrmr::build_fixed_reports(empty_bias) expect_equal(result_empty$bias_fixed, "No bias data") # Normal path with real bias fixed_facets <- mfrmr::build_fixed_reports(bias, branch = "facets") expect_true(inherits(fixed_facets, "mfrm_bundle")) expect_true(is.character(fixed_facets$bias_fixed)) fixed_orig <- mfrmr::build_fixed_reports(bias, branch = "original") expect_true(inherits(fixed_orig, "mfrm_bundle")) }) # ========================================================================== # 10. plot_bias_interaction multiple plot types (lines 5472-5548) # ========================================================================== test_that("plot_bias_interaction covers scatter, ranked, abs_t_hist, and facet_profile", { t13 <- mfrmr::bias_interaction_report(bias, top_n = 20) # scatter (drawn) p_scatter <- with_null_device( mfrmr::plot_bias_interaction(t13, plot = "scatter", draw = TRUE) ) expect_s3_class(p_scatter, "mfrm_plot_data") # ranked (drawn) p_ranked <- with_null_device( mfrmr::plot_bias_interaction(t13, plot = "ranked", draw = TRUE) ) expect_s3_class(p_ranked, "mfrm_plot_data") # abs_t_hist (drawn) p_hist <- with_null_device( mfrmr::plot_bias_interaction(t13, plot = "abs_t_hist", draw = TRUE) ) expect_s3_class(p_hist, "mfrm_plot_data") # facet_profile (drawn) p_prof <- with_null_device( mfrmr::plot_bias_interaction(t13, plot = "facet_profile", draw = TRUE) ) expect_s3_class(p_prof, "mfrm_plot_data") }) # ========================================================================== # 11. apa_table branches: mfrm_fit source, list source, diagnostics (lines 6653-6689) # ========================================================================== test_that("apa_table covers mfrm_fit with diag_opts, list source, and unknown which", { # mfrm_fit source with interrater_summary (diag_opt branch) tbl_ir <- mfrmr::apa_table(fit, which = "interrater_summary", diagnostics = dx) expect_s3_class(tbl_ir, "apa_table") # mfrm_fit source with interrater_pairs tbl_ip <- mfrmr::apa_table(fit, which = "interrater_pairs", diagnostics = dx) expect_s3_class(tbl_ip, "apa_table") # named list source my_list <- list(summary = data.frame(A = 1:3, B = 4:6)) tbl_list <- mfrmr::apa_table(my_list) expect_s3_class(tbl_list, "apa_table") # named list source with explicit which tbl_list2 <- mfrmr::apa_table(my_list, which = "summary") expect_s3_class(tbl_list2, "apa_table") # named list, missing which => error bad_list <- list(foo = 1:3) expect_error(mfrmr::apa_table(bad_list), "Could not infer") # non-matching which in list => error expect_error(mfrmr::apa_table(my_list, which = "nonexistent"), "not found") # invalid x type => error expect_error(mfrmr::apa_table(42), "must be a data.frame") }) # ========================================================================== # 12. plot.apa_table first_numeric histogram (lines 6954-6975) # ========================================================================== test_that("plot.apa_table first_numeric histogram drawn", { df_apa <- data.frame( Category = c("A", "B", "C", "D"), Value = c(1.2, 3.4, 2.1, 5.6) ) tbl <- mfrmr::apa_table(df_apa) # default type -- either numeric_profile or first_numeric depending on columns p <- with_null_device( plot(tbl, draw = TRUE) ) expect_s3_class(p, "mfrm_plot_data") expect_true(p$data$plot %in% c("first_numeric", "numeric_profile")) # Explicitly request first_numeric histogram with single-numeric-col df df_single <- data.frame(Label = c("A", "B", "C"), Value = c(1.2, 3.4, 2.1)) tbl_single <- mfrmr::apa_table(df_single) p_fn <- with_null_device( plot(tbl_single, type = "first_numeric", draw = TRUE) ) expect_s3_class(p_fn, "mfrm_plot_data") expect_equal(p_fn$data$plot, "first_numeric") }) # ========================================================================== # 13. print.summary.mfrm_threshold_profiles (lines 7151-7176) # ========================================================================== test_that("print.summary.mfrm_threshold_profiles covers all sections", { tp <- mfrmr::mfrm_threshold_profiles() sm <- summary(tp) out <- capture.output(print(sm)) expect_true(any(grepl("Threshold Profile Summary", out, fixed = TRUE))) expect_true(any(grepl("Overview", out, fixed = TRUE))) expect_true(any(grepl("Profile thresholds", out, fixed = TRUE))) expect_true(any(grepl("Threshold ranges", out, fixed = TRUE))) expect_true(any(grepl("PCA reference bands", out, fixed = TRUE))) }) # ========================================================================== # 14. facets_parity_report rows == 0 branch (lines 7513-7521) # ========================================================================== test_that("facets_parity_report returns empty data.frame when no checks apply", { # Calling with real fit should produce valid results pr <- suppressWarnings(mfrmr::facets_parity_report(fit, diagnostics = dx)) expect_s3_class(pr, "mfrm_parity_report") expect_true(is.data.frame(pr$column_audit)) }) # ========================================================================== # 15. facets_parity_report auto-computes bias_results (lines 7620-7626) # ========================================================================== test_that("facets_parity_report auto-computes bias_results when not provided", { # bias_results = NULL triggers internal estimate_bias() pr_auto <- suppressWarnings(mfrmr::facets_parity_report( fit, diagnostics = dx, bias_results = NULL )) expect_s3_class(pr_auto, "mfrm_parity_report") }) # ========================================================================== # 16. parity contract missing_component branch (lines 7690-7703) # ========================================================================== test_that("facets_parity_report column_audit has status column", { pr <- suppressWarnings(mfrmr::facets_parity_report(fit, diagnostics = dx)) expect_true("status" %in% names(pr$column_audit)) # Verify the status column is character and non-empty if (nrow(pr$column_audit) > 0) { expect_true(is.character(pr$column_audit$status)) } }) # ========================================================================== # 17. bundle_preview_table (lines 7878-7896) # ========================================================================== test_that("bundle_preview_table handles various inputs", { bpt <- mfrmr:::bundle_preview_table # With named list containing a known key obj <- list(table = data.frame(A = 1:3)) result <- bpt(obj, top_n = 2) expect_equal(result$name, "table") expect_true(nrow(result$table) <= 2) # With empty named list result2 <- bpt(list(), top_n = 5) expect_true(is.na(result2$name)) expect_equal(nrow(result2$table), 0) # With unknown-key list result3 <- bpt(list(unknown_key = 1:3), top_n = 5) expect_true(is.na(result3$name)) expect_equal(nrow(result3$table), 0) # With NULL names result4 <- bpt(structure(list(), names = NULL), top_n = 5) expect_true(is.na(result4$name)) }) # ========================================================================== # 18. summarize_bias_count_bundle low_count and summary branches (lines 7932-7944) # ========================================================================== test_that("summary.mfrm_bundle for bias_count exercises low-count and fallback summary", { t11 <- mfrmr::bias_count_table(bias, min_count_warn = 1) sm <- summary(t11) expect_s3_class(sm, "summary.mfrm_bundle") # Construct a minimal bias_count without summary to hit fallback fake_count <- list( table = data.frame(Count = c(2, 3), LowCountFlag = c(TRUE, FALSE)), summary = data.frame(), thresholds = list(min_count_warn = 1), branch = "original" ) class(fake_count) <- c("mfrm_bias_count", "mfrm_bundle", "list") sm_fake <- summary(fake_count) expect_s3_class(sm_fake, "summary.mfrm_bundle") expect_true(nrow(sm_fake$overview) > 0) }) # ========================================================================== # 19. bundle_first_table fallback loop (lines 8058-8069) # ========================================================================== test_that("bundle_first_table tries candidates in order", { bft <- mfrmr:::bundle_first_table # First candidate has data obj <- list(ranked_table = data.frame(X = 1:3), summary = data.frame(Y = 4:6)) result <- bft(obj, candidates = c("ranked_table", "summary"), top_n = 2) expect_equal(result$name, "ranked_table") expect_true(nrow(result$table) <= 2) # No candidates match with rows => hits second loop looking for ncol > 0 obj2 <- list(ranked_table = data.frame(X = integer(0))) result2 <- bft(obj2, candidates = c("ranked_table"), top_n = 5) expect_equal(result2$name, "ranked_table") # Empty candidates result3 <- bft(obj, candidates = character(0), top_n = 5) expect_true(is.na(result3$name)) }) # ========================================================================== # 20. summary.mfrm_bundle generic fallback (lines 8645-8687) # ========================================================================== test_that("summary.mfrm_bundle falls through to generic path", { # Create a bundle with unrecognized subclass fake_bundle <- list( summary = data.frame(Key = "A", Value = 1), table = data.frame(Col1 = 1:3, Col2 = 4:6) ) class(fake_bundle) <- c("mfrm_unknown_type", "mfrm_bundle", "list") sm <- summary(fake_bundle) expect_s3_class(sm, "summary.mfrm_bundle") expect_true("overview" %in% names(sm)) expect_true("preview" %in% names(sm)) expect_true("notes" %in% names(sm)) # No summary, but has table => different notes branch fake2 <- list(table = data.frame(A = 1:5)) class(fake2) <- c("mfrm_foo", "mfrm_bundle", "list") sm2 <- summary(fake2) expect_true(grepl("No `summary` component", sm2$notes)) # Nothing tabular fake3 <- list(scalar = 42) class(fake3) <- c("mfrm_bar", "mfrm_bundle", "list") sm3 <- summary(fake3) expect_true(grepl("No tabular", sm3$notes)) }) # ========================================================================== # 21. plot.mfrm_anchor_audit with draw=TRUE for specifications anchor_constraints # (lines 9393-9446) # ========================================================================== test_that("plot.mfrm_anchor_audit issue_counts drawn", { anchors <- data.frame( Facet = c("Rater", "Rater"), Level = c("R1", "R2"), Anchor = c(0, 0.1), stringsAsFactors = FALSE ) aud <- mfrmr::audit_mfrm_anchors( data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", anchors = anchors ) p <- with_null_device( plot(aud, type = "issue_counts", draw = TRUE) ) expect_s3_class(p, "mfrm_plot_data") }) # ========================================================================== # 22. plot.mfrm_fit type="facet" with draw (lines 13144-13186) # ========================================================================== test_that("plot.mfrm_fit type=facet drawn covers facet plot branch", { p_facet <- with_null_device( plot(fit, type = "facet", draw = TRUE) ) expect_s3_class(p_facet, "mfrm_plot_data") # With a specific facet filter p_rater <- with_null_device( plot(fit, type = "facet", facet = "Rater", draw = TRUE) ) expect_s3_class(p_rater, "mfrm_plot_data") # step drawn p_step <- with_null_device( plot(fit, type = "step", draw = TRUE) ) expect_s3_class(p_step, "mfrm_plot_data") # person drawn p_person <- with_null_device( plot(fit, type = "person", draw = TRUE) ) expect_s3_class(p_person, "mfrm_plot_data") }) # ========================================================================== # 23. print.mfrm_fit empty summary branch (lines 13178-13186) # ========================================================================== test_that("print.mfrm_fit handles empty summary", { # Normal path out <- capture.output(print(fit)) expect_true(any(grepl("mfrm_fit object", out, fixed = TRUE))) # Fake empty-summary object fake_fit <- list(summary = data.frame()) class(fake_fit) <- c("mfrm_fit", "list") out2 <- capture.output(print(fake_fit)) expect_true(any(grepl("empty summary", out2, fixed = TRUE))) }) # ========================================================================== # 24. draw_facet_plot (lines 11599-11611) # ========================================================================== test_that("draw_facet_plot runs without error", { facet_tbl <- data.frame( Facet = c("Rater", "Rater", "Task"), Level = c("R1", "R2", "T1"), Estimate = c(-0.5, 0.3, 0.1) ) with_null_device( mfrmr:::draw_facet_plot(facet_tbl, title = "Test facet plot") ) expect_true(TRUE) # no error }) # ========================================================================== # 25. resolve_fair_bundle (lines 11757-11796) # ========================================================================== test_that("resolve_fair_bundle handles mfrm_fit and pre-computed bundle", { rfb <- mfrmr:::resolve_fair_bundle # Pass mfrm_fit => calls fair_average_table result <- rfb(fit, diagnostics = dx) expect_true(all(c("raw_by_facet", "by_facet", "stacked") %in% names(result))) # Pre-computed bundle pre <- mfrmr::fair_average_table(fit, diagnostics = dx) result2 <- rfb(pre) expect_identical(result2, pre) # Bad input expect_error(rfb(42), "must be an mfrm_fit") }) # ========================================================================== # 26. resolve_displacement_bundle (lines 11775-11796) # ========================================================================== test_that("resolve_displacement_bundle handles mfrm_fit and pre-computed bundle", { rdb <- mfrmr:::resolve_displacement_bundle result <- rdb(fit, diagnostics = dx) expect_true(all(c("table", "summary", "thresholds") %in% names(result))) pre <- mfrmr::displacement_table(fit, diagnostics = dx) result2 <- rdb(pre) expect_identical(result2, pre) expect_error(rdb("not_a_fit"), "must be an mfrm_fit") }) # ========================================================================== # 27. plot_fair_average observed vs metric (scatter) (lines 12110-12126) # ========================================================================== test_that("plot_fair_average covers scatter (observed vs metric) branch", { t12 <- mfrmr::fair_average_table(fit, diagnostics = dx) # scatter is the default when plot_type = "scatter" p <- with_null_device( mfrmr::plot_fair_average(t12, plot_type = "scatter", draw = TRUE) ) expect_s3_class(p, "mfrm_plot_data") }) # ========================================================================== # 28. plot_facets_chisq variance branch (lines 12556-12566) # ========================================================================== test_that("plot_facets_chisq covers random_chisq and variance branches", { fchi <- mfrmr::facets_chisq_table(fit, diagnostics = dx) expect_s3_class(fchi, "mfrm_facets_chisq") # random plot p1 <- with_null_device( mfrmr::plot_facets_chisq(fchi, plot_type = "random", draw = TRUE) ) expect_s3_class(p1, "mfrm_plot_data") # variance plot p2 <- with_null_device( mfrmr::plot_facets_chisq(fchi, plot_type = "variance", draw = TRUE) ) expect_s3_class(p2, "mfrm_plot_data") }) # ========================================================================== # 29. plot_qc_dashboard drawn panels (lines 12748-12944) # ========================================================================== test_that("plot_qc_dashboard draws all 9 panels", { qc <- with_null_device( mfrmr::plot_qc_dashboard(fit, diagnostics = dx, rater_facet = "Rater", draw = TRUE) ) expect_s3_class(qc, "mfrm_plot_data") expect_equal(qc$name, "qc_dashboard") }) # ========================================================================== # 30. bundle_settings_table (lines 7865-7874) # ========================================================================== test_that("bundle_settings_table handles various types", { bst <- mfrmr:::bundle_settings_table result <- bst(list(a = 1, b = NULL, c = data.frame(x = 1), d = list(1, 2), e = "hello")) expect_true(is.data.frame(result)) expect_equal(nrow(result), 5) expect_true(any(grepl("NULL", result$Value))) expect_true(any(grepl(" "No data" drawn p1 <- with_null_device( mfrmr:::plot_table13_bias(empty_bundle, plot = "scatter", draw = TRUE) ) expect_s3_class(p1, "mfrm_plot_data") # Empty ranked => "No data" p2 <- with_null_device( mfrmr:::plot_table13_bias(empty_bundle, plot = "ranked", draw = TRUE) ) expect_s3_class(p2, "mfrm_plot_data") # Empty abs_t_hist p3 <- with_null_device( mfrmr:::plot_table13_bias(empty_bundle, plot = "abs_t_hist", draw = TRUE) ) expect_s3_class(p3, "mfrm_plot_data") # Empty facet_profile p4 <- with_null_device( mfrmr:::plot_table13_bias(empty_bundle, plot = "facet_profile", draw = TRUE) ) expect_s3_class(p4, "mfrm_plot_data") }) # ========================================================================== # 35. bundle_known_overview (lines 8067-8069) # ========================================================================== test_that("bundle_known_overview builds a one-row overview", { bko <- mfrmr:::bundle_known_overview result <- bko(list(a = 1, b = 2), "mfrm_test", "a", 5L) expect_true(is.data.frame(result)) expect_equal(nrow(result), 1) expect_equal(result$Class, "mfrm_test") expect_equal(result$PreviewComponent, "a") }) # ========================================================================== # 36. print.mfrm_plot_bundle (lines 13168-13176) # ========================================================================== test_that("print.mfrm_plot_bundle prints expected lines", { p_bundle <- plot(fit, draw = FALSE) out <- capture.output(print(p_bundle)) expect_true(any(grepl("mfrm plot bundle", out, fixed = TRUE))) expect_true(any(grepl("wright_map", out, fixed = TRUE))) expect_true(any(grepl("pathway_map", out, fixed = TRUE))) expect_true(any(grepl("category_characteristic_curves", out, fixed = TRUE))) expect_true(any(grepl("Use `$`", out, fixed = TRUE))) }) # ========================================================================== # 37. draw output bundle plots (expected, residuals, obs_probability) # ========================================================================== test_that("facets_output_file_bundle plot types are drawn", { of <- mfrmr::facets_output_file_bundle( fit, diagnostics = dx, include = c("graph", "score"), theta_points = 61 ) p_ge <- with_null_device( plot(of, type = "graph_expected", draw = TRUE) ) expect_s3_class(p_ge, "mfrm_plot_data") p_sr <- with_null_device( plot(of, type = "score_residuals", draw = TRUE) ) expect_s3_class(p_sr, "mfrm_plot_data") p_op <- with_null_device( plot(of, type = "obs_probability", draw = TRUE) ) expect_s3_class(p_op, "mfrm_plot_data") }) # ========================================================================== # 38. plot.mfrm_fit drawn bundle (wright, pathway, ccc) # ========================================================================== test_that("plot.mfrm_fit bundle drawn covers all three map types", { p_all <- with_null_device( plot(fit, draw = TRUE) ) expect_s3_class(p_all, "mfrm_plot_bundle") expect_true(all(c("wright_map", "pathway_map", "category_characteristic_curves") %in% names(p_all))) }) # ========================================================================== # 39. plot.mfrm_fit wright/pathway/ccc individually drawn # ========================================================================== test_that("plot.mfrm_fit individual types drawn", { p_w <- with_null_device(plot(fit, type = "wright", draw = TRUE)) expect_s3_class(p_w, "mfrm_plot_data") p_p <- with_null_device(plot(fit, type = "pathway", draw = TRUE)) expect_s3_class(p_p, "mfrm_plot_data") p_c <- with_null_device(plot(fit, type = "ccc", draw = TRUE)) expect_s3_class(p_c, "mfrm_plot_data") }) # ========================================================================== # 40. describe_mfrm_data summary print # ========================================================================== test_that("summary.mfrm_data_description covers all branches", { desc <- mfrmr::describe_mfrm_data( data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", rater_facet = "Rater" ) sm <- summary(desc) out <- capture.output(print(sm)) expect_true(any(grepl("Data Description Summary", out, fixed = TRUE))) }) # ========================================================================== # 41. plot.mfrm_data_description drawn # ========================================================================== test_that("plot.mfrm_data_description draws score_distribution and facet_level plots", { desc <- mfrmr::describe_mfrm_data( data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", rater_facet = "Rater" ) p1 <- with_null_device( plot(desc, type = "score_distribution", draw = TRUE) ) expect_s3_class(p1, "mfrm_plot_data") p2 <- with_null_device( plot(desc, type = "facet_level", draw = TRUE) ) expect_s3_class(p2, "mfrm_plot_data") }) # ========================================================================== # 42. plot.mfrm_fit type=facet with top_n filtering # ========================================================================== test_that("plot.mfrm_fit type=facet respects top_n", { p_top <- with_null_device( plot(fit, type = "facet", top_n = 3, draw = TRUE) ) expect_s3_class(p_top, "mfrm_plot_data") }) # ========================================================================== # 43. summary.mfrm_anchor_audit # ========================================================================== test_that("summary.mfrm_anchor_audit covers all branches", { anchors <- data.frame( Facet = c("Rater", "Rater"), Level = c("R1", "R2"), Anchor = c(0, 0.1), stringsAsFactors = FALSE ) aud <- mfrmr::audit_mfrm_anchors( data = d, person = "Person", facets = c("Rater", "Task", "Criterion"), score = "Score", anchors = anchors ) sm <- summary(aud) out <- capture.output(print(sm)) expect_true(any(grepl("Anchor Audit Summary", out, fixed = TRUE))) }) # ========================================================================== # 44. plot fixed_reports pvalue and contrast drawn # ========================================================================== test_that("plot.mfrm_fixed_reports covers contrast and pvalue plots", { fixed <- mfrmr::build_fixed_reports(bias, branch = "original") p_contrast <- with_null_device( plot(fixed, type = "contrast", draw = TRUE) ) expect_s3_class(p_contrast, "mfrm_plot_data") p_pval <- with_null_device( plot(fixed, type = "pvalue", draw = TRUE) ) expect_s3_class(p_pval, "mfrm_plot_data") }) # ========================================================================== # 45. plot_qc_dashboard with draw=FALSE returns plot data # ========================================================================== test_that("plot_qc_dashboard draw=FALSE returns plot data without drawing", { qc <- mfrmr::plot_qc_dashboard(fit, diagnostics = dx, draw = FALSE) expect_s3_class(qc, "mfrm_plot_data") expect_equal(qc$name, "qc_dashboard") })