summary_table_bundle_workflow_fixture <- local({ toy <- load_mfrmr_data("example_core") keep_people <- unique(toy$Person)[1:14] toy <- toy[toy$Person %in% keep_people, , drop = FALSE] fit <- suppressWarnings(fit_mfrm( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 20 )) diag <- suppressWarnings(diagnose_mfrm(fit, residual_pca = "none")) run <- suppressWarnings(run_mfrm_facets( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 20 )) bias <- suppressWarnings(estimate_bias( fit, diagnostics = diag, facet_a = "Rater", facet_b = "Criterion", max_iter = 2 )) audit <- audit_mfrm_anchors( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score" ) toy_wave_a <- toy[toy$Person %in% keep_people[1:7], , drop = FALSE] toy_wave_b <- toy[toy$Person %in% keep_people[8:14], , drop = FALSE] fit_wave_a <- suppressWarnings(fit_mfrm( toy_wave_a, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 20 )) fit_wave_b <- suppressWarnings(fit_mfrm( toy_wave_b, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 20 )) drift <- suppressWarnings(detect_anchor_drift(list(W1 = fit_wave_a, W2 = fit_wave_b))) chain <- suppressWarnings(build_equating_chain(list(W1 = fit_wave_a, W2 = fit_wave_b))) linking_review <- build_linking_review(anchor_audit = audit, drift = drift, chain = chain) list( run = run, bias = bias, audit = audit, linking_review = linking_review ) }) summary_table_bundle_prediction_fixture <- local({ toy <- load_mfrmr_data("example_core") keep_people <- unique(toy$Person)[1:18] toy <- toy[toy$Person %in% keep_people, , drop = FALSE] fit <- suppressWarnings(fit_mfrm( toy, "Person", c("Rater", "Criterion"), "Score", method = "MML", quad_points = 5, maxit = 15 )) new_units <- data.frame( Person = c("NEW01", "NEW01"), Rater = unique(toy$Rater)[1], Criterion = unique(toy$Criterion)[1:2], Score = c(2, 3) ) list( unit_prediction = predict_mfrm_units( fit, new_units, n_draws = 2, seed = 1 ), plausible_values = sample_mfrm_plausible_values( fit, new_units, n_draws = 2, seed = 1 ) ) }) test_that("build_summary_table_bundle converts supported reporting summaries into named tables", { toy <- load_mfrmr_data("example_core") fit <- suppressWarnings(fit_mfrm( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 25 )) diag <- suppressWarnings(diagnose_mfrm(fit, residual_pca = "none")) ds <- describe_mfrm_data(toy, "Person", c("Rater", "Criterion"), "Score") chk <- reporting_checklist(fit, diagnostics = diag) apa <- build_apa_outputs(fit, diagnostics = diag) fit_bundle <- build_summary_table_bundle(fit) expect_s3_class(fit_bundle, "mfrm_summary_table_bundle") expect_identical(fit_bundle$source_class, "mfrm_fit") expect_identical(fit_bundle$summary_class, "summary.mfrm_fit") expect_true(all(c("overview", "facet_overview", "reporting_map") %in% names(fit_bundle$tables))) expect_true(all(c("Table", "Rows", "Cols", "Role", "Description") %in% names(fit_bundle$table_index))) expect_true(all(c("Table", "PlotReady", "NumericColumns", "DefaultPlotTypes") %in% names(fit_bundle$plot_index))) printed <- capture.output(print(fit_bundle)) expect_true(any(grepl("mfrmr Summary Table Bundle", printed, fixed = TRUE))) fit_bundle_summary <- summary(fit_bundle) expect_s3_class(fit_bundle_summary, "summary.mfrm_summary_table_bundle") expect_true(is.data.frame(fit_bundle_summary$overview)) expect_true(is.data.frame(fit_bundle_summary$table_catalog)) expect_true(is.data.frame(fit_bundle_summary$table_profile)) expect_true(is.data.frame(fit_bundle_summary$plot_index)) expect_true(is.data.frame(fit_bundle_summary$appendix_presets)) expect_true(is.data.frame(fit_bundle_summary$appendix_role_summary)) expect_true(is.data.frame(fit_bundle_summary$appendix_section_summary)) expect_true(is.data.frame(fit_bundle_summary$reporting_map)) expect_true("AnyNumericTable" %in% names(fit_bundle_summary$overview)) expect_true(all(c("RecommendedAppendixTables", "CompactAppendixTables") %in% names(fit_bundle_summary$overview))) expect_true(all(c("Table", "ExportReady", "ApaTableReady", "RecommendedBridge") %in% names(fit_bundle_summary$table_catalog))) expect_true(all(c("AppendixSection", "RecommendedAppendix", "CompactAppendix", "PreferredAppendixOrder", "AppendixRationale") %in% names(fit_bundle_summary$table_catalog))) expect_identical( as.character(fit_bundle_summary$appendix_presets$Preset), c("all", "recommended", "compact", "methods", "results", "diagnostics", "reporting") ) expect_true(all(c("Role", "Tables", "RecommendedTables", "CompactTables") %in% names(fit_bundle_summary$appendix_role_summary))) expect_true(all(c("AppendixSection", "Tables", "RolesCovered") %in% names(fit_bundle_summary$appendix_section_summary))) expect_true(all(c("Area", "CoveredHere", "CompanionOutput") %in% names(fit_bundle_summary$reporting_map))) diag_bundle <- build_summary_table_bundle(diag, which = c("overview", "flags")) expect_identical(names(diag_bundle$tables), c("overview", "flags")) expect_identical(diag_bundle$source_class, "mfrm_diagnostics") ds_bundle <- build_summary_table_bundle(summary(ds)) expect_identical(ds_bundle$source_class, "summary.mfrm_data_description") expect_true(all(c("overview", "missing", "score_distribution") %in% names(ds_bundle$tables))) chk_bundle <- build_summary_table_bundle(chk) expect_true(all(c("overview", "section_summary", "action_items") %in% names(chk_bundle$tables))) apa_bundle <- build_summary_table_bundle(apa, which = c("overview", "components", "preview")) expect_identical(names(apa_bundle$tables), c("overview", "components", "preview")) }) test_that("build_summary_table_bundle supports workflow, bias, anchor, linking, and prediction summaries", { run_bundle <- build_summary_table_bundle(summary_table_bundle_workflow_fixture$run) expect_identical(run_bundle$source_class, "mfrm_facets_run") expect_identical(run_bundle$summary_class, "summary.mfrm_facets_run") expect_true(all(c( "overview", "mapping", "run_info", "fit_overview", "diagnostic_flags" ) %in% names(run_bundle$tables))) bias_bundle <- build_summary_table_bundle(summary(summary_table_bundle_workflow_fixture$bias)) expect_identical(bias_bundle$source_class, "summary.mfrm_bias") expect_identical(bias_bundle$summary_class, "summary.mfrm_bias") expect_true(all(c("overview", "chi_sq", "top_rows", "notes") %in% names(bias_bundle$tables))) audit_bundle <- build_summary_table_bundle(summary_table_bundle_workflow_fixture$audit) expect_identical(audit_bundle$source_class, "mfrm_anchor_audit") expect_identical(audit_bundle$summary_class, "summary.mfrm_anchor_audit") expect_true(all(c( "overview", "issue_counts", "facet_summary", "recommendations" ) %in% names(audit_bundle$tables))) linking_bundle <- build_summary_table_bundle(summary_table_bundle_workflow_fixture$linking_review) expect_identical(linking_bundle$source_class, "mfrm_linking_review") expect_identical(linking_bundle$summary_class, "summary.mfrm_linking_review") expect_true(all(c( "overview", "status", "top_linking_risks", "plot_map", "reporting_map" ) %in% names(linking_bundle$tables))) unit_bundle <- build_summary_table_bundle(summary_table_bundle_prediction_fixture$unit_prediction) expect_identical(unit_bundle$source_class, "mfrm_unit_prediction") expect_identical(unit_bundle$summary_class, "summary.mfrm_unit_prediction") expect_true(all(c("overview", "estimates", "settings", "notes") %in% names(unit_bundle$tables))) pv_bundle <- build_summary_table_bundle(summary(summary_table_bundle_prediction_fixture$plausible_values)) expect_identical(pv_bundle$source_class, "summary.mfrm_plausible_values") expect_identical(pv_bundle$summary_class, "summary.mfrm_plausible_values") expect_true(all(c( "overview", "draw_summary", "estimates", "settings", "notes" ) %in% names(pv_bundle$tables))) }) test_that("build_summary_table_bundle keeps explicitly requested empty tables and rejects unknown names", { toy <- load_mfrmr_data("example_core") fit <- suppressWarnings(fit_mfrm( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 25 )) empty_bundle <- build_summary_table_bundle(fit, which = "population_coefficients") expect_identical(names(empty_bundle$tables), "population_coefficients") expect_true(is.data.frame(empty_bundle$tables$population_coefficients)) expect_equal(nrow(empty_bundle$table_index), 1L) expect_error( build_summary_table_bundle(fit, which = "not_a_table"), "received unknown `which` table name" ) expect_error( build_summary_table_bundle(fit, which = "overview", appendix_preset = "recommended"), "requires `appendix_preset` and `which` to be used separately" ) }) test_that("build_summary_table_bundle validates front-door inputs before bundle conversion", { toy <- load_mfrmr_data("example_core") fit <- suppressWarnings(fit_mfrm( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 25 )) expect_error( build_summary_table_bundle(NULL), "requires `x` to be a supported package object" ) expect_error( build_summary_table_bundle(fit, which = 1), "requires `which` to be `NULL` or a non-empty character vector" ) expect_error( build_summary_table_bundle(fit, include_empty = NA), "requires `include_empty` to be either `TRUE` or `FALSE`" ) expect_error( build_summary_table_bundle(fit, digits = -1), "requires `digits` to be a single non-negative number" ) broken_fit_summary <- structure( list( overview = data.frame( Model = "RSM", Method = "JML", stringsAsFactors = FALSE ) ), class = "summary.mfrm_fit" ) expect_error( build_summary_table_bundle(broken_fit_summary), "Missing required component\\(s\\): reporting_map" ) broken_apa_summary <- structure( list( overview = data.frame(Components = 1, stringsAsFactors = FALSE), components = data.frame(Component = "report_text", stringsAsFactors = FALSE) ), class = "summary.mfrm_apa_outputs" ) expect_error( build_summary_table_bundle(broken_apa_summary), "Missing required component\\(s\\): preview" ) }) test_that("build_summary_table_bundle supports planning and forecast summaries with future-branch tables", { spec <- build_mfrm_sim_spec( n_person = 10, n_rater = 3, n_criterion = 2, raters_per_person = 2, assignment = "rotating", facet_names = c("Judge", "Task") ) sim_eval <- suppressWarnings(evaluate_mfrm_design( sim_spec = spec, n_person = c(10, 12), reps = 1, maxit = 5, seed = 901 )) sig_eval <- suppressWarnings(evaluate_mfrm_signal_detection( sim_spec = spec, n_person = 10, reps = 1, maxit = 5, bias_max_iter = 1, seed = 902 )) pred <- suppressWarnings(predict_mfrm_population( sim_spec = spec, design = list(person = c(10, 12)), reps = 1, maxit = 5, seed = 903 )) design_bundle <- build_summary_table_bundle(sim_eval) expect_identical(design_bundle$source_class, "mfrm_design_evaluation") expect_true(all(c("overview", "design_summary", "future_branch_overview", "future_branch_recommendation") %in% names(design_bundle$tables))) signal_bundle <- build_summary_table_bundle(summary(sig_eval)) expect_identical(signal_bundle$source_class, "summary.mfrm_signal_detection") expect_true(all(c("overview", "detection_summary", "future_branch_readiness") %in% names(signal_bundle$tables))) pred_bundle <- build_summary_table_bundle(pred) expect_identical(pred_bundle$source_class, "mfrm_population_prediction") expect_true(all(c("design", "forecast", "future_branch_profile", "future_branch_load_balance", "future_branch_coverage") %in% names(pred_bundle$tables))) }) test_that("build_summary_table_bundle supports future arbitrary-facet active-branch inputs", { spec <- build_mfrm_sim_spec( n_person = 12, n_rater = 3, n_criterion = 4, raters_per_person = 2, assignment = "rotating", facet_names = c("Judge", "Task") ) active <- spec$planning_schema$future_branch_active_branch active_bundle <- build_summary_table_bundle(active) expect_s3_class(active_bundle, "mfrm_summary_table_bundle") expect_identical(active_bundle$source_class, "mfrm_future_branch_active_branch") expect_identical(active_bundle$summary_class, "summary.mfrm_future_branch_active_branch") expect_true(all(c( "future_branch_overview", "future_branch_profile", "future_branch_load_balance", "future_branch_coverage", "future_branch_guardrails", "future_branch_readiness", "future_branch_recommendation", "future_branch_appendix_presets", "future_branch_appendix_roles", "future_branch_appendix_sections", "future_branch_selection_table_presets", "future_branch_selection_handoff_tables", "future_branch_selection_handoff_presets", "future_branch_selection_handoff", "future_branch_selection_handoff_bundles", "future_branch_selection_handoff_roles", "future_branch_selection_handoff_role_sections", "future_branch_selection_tables", "future_branch_selection_summary", "future_branch_selection_roles", "future_branch_selection_sections", "future_branch_selection_catalog", "future_branch_reporting_map" ) %in% names(active_bundle$tables))) summary_bundle <- build_summary_table_bundle(summary(active)) expect_identical(summary_bundle$source_class, "summary.mfrm_future_branch_active_branch") expect_identical(summary_bundle$summary_class, "summary.mfrm_future_branch_active_branch") expect_true(all(c( "future_branch_overview", "future_branch_profile", "future_branch_selection_table_presets", "future_branch_selection_handoff_tables", "future_branch_selection_handoff_presets", "future_branch_selection_handoff", "future_branch_selection_handoff_bundles", "future_branch_selection_handoff_roles", "future_branch_selection_handoff_role_sections", "future_branch_selection_tables", "future_branch_recommendation", "future_branch_selection_summary", "future_branch_reporting_map" ) %in% names(summary_bundle$tables))) active_bundle_summary <- summary(active_bundle) expect_s3_class(active_bundle_summary, "summary.mfrm_summary_table_bundle") expect_true(is.data.frame(active_bundle_summary$selection_handoff_table_summary)) expect_true(is.data.frame(active_bundle_summary$selection_handoff_preset_summary)) expect_true(is.data.frame(active_bundle_summary$selection_handoff_summary)) expect_true(is.data.frame(active_bundle_summary$selection_handoff_bundle_summary)) expect_true(is.data.frame(active_bundle_summary$selection_handoff_role_summary)) expect_true(is.data.frame(active_bundle_summary$selection_handoff_role_section_summary)) expect_true(is.data.frame(active_bundle_summary$selection_table_summary)) expect_true(is.data.frame(active_bundle_summary$selection_role_summary)) expect_true(is.data.frame(active_bundle_summary$selection_section_summary)) expect_true(all(c("Preset", "SectionsCovered", "PlotReadyTables", "PlotReadyFraction", "NumericFraction") %in% names(active_bundle_summary$selection_handoff_preset_summary))) expect_true(all(c("Preset", "AppendixSection", "PlotReadyTables", "PlotReadyFraction", "NumericFraction") %in% names(active_bundle_summary$selection_handoff_summary))) expect_true(all(c("Preset", "AppendixSection", "Bundle", "PlotReadyTables", "PlotReadyFraction", "NumericFraction") %in% names(active_bundle_summary$selection_handoff_bundle_summary))) expect_true(all(c("Preset", "Role", "PlotReadyTables", "PlotReadyFraction", "NumericFraction") %in% names(active_bundle_summary$selection_handoff_role_summary))) expect_true(all(c("Preset", "AppendixSection", "Role", "PlotReadyTables", "PlotReadyFraction", "NumericFraction") %in% names(active_bundle_summary$selection_handoff_role_section_summary))) expect_true(all(c("Preset", "AppendixSection", "Role", "Bundle", "Table", "Rows", "NumericColumns", "PlotReady", "ExportReady", "ApaTableReady") %in% names(active_bundle_summary$selection_handoff_table_summary))) expect_true(all(c("Preset", "Bundle", "TablesAvailable", "SelectionFraction", "PlotReadyFraction", "NumericFraction") %in% names(active_bundle_summary$selection_summary))) expect_true(all(c("Preset", "Role", "PlotReadyFraction", "NumericFraction") %in% names(active_bundle_summary$selection_role_summary))) expect_true(all(c("Preset", "AppendixSection", "PlotReadyFraction", "NumericFraction") %in% names(active_bundle_summary$selection_section_summary))) }) test_that("future arbitrary-facet active-branch bundles support appendix presets", { spec <- build_mfrm_sim_spec( n_person = 12, n_rater = 3, n_criterion = 4, raters_per_person = 2, assignment = "rotating", facet_names = c("Judge", "Task") ) active <- spec$planning_schema$future_branch_active_branch full_bundle <- build_summary_table_bundle(active) rec_bundle <- build_summary_table_bundle(active, appendix_preset = "recommended") compact_bundle <- build_summary_table_bundle(active, appendix_preset = "compact") methods_bundle <- build_summary_table_bundle(active, appendix_preset = "methods") diagnostics_bundle <- build_summary_table_bundle(active, appendix_preset = "diagnostics") expect_true(all(c( "future_branch_overview", "future_branch_profile", "future_branch_readiness", "future_branch_recommendation" ) %in% names(rec_bundle$tables))) expect_false("future_branch_selection_table_presets" %in% names(rec_bundle$tables)) expect_false("future_branch_selection_handoff" %in% names(rec_bundle$tables)) expect_false("future_branch_selection_summary" %in% names(rec_bundle$tables)) expect_false("future_branch_load_balance" %in% names(rec_bundle$tables)) expect_false("future_branch_coverage" %in% names(rec_bundle$tables)) expect_false("future_branch_guardrails" %in% names(rec_bundle$tables)) expect_true(all(c( "future_branch_overview", "future_branch_readiness", "future_branch_recommendation" ) %in% names(compact_bundle$tables))) expect_false("future_branch_selection_table_presets" %in% names(compact_bundle$tables)) expect_false("future_branch_selection_handoff" %in% names(compact_bundle$tables)) expect_false("future_branch_appendix_presets" %in% names(compact_bundle$tables)) expect_false("future_branch_profile" %in% names(compact_bundle$tables)) expect_true(all(methods_bundle$table_index$AppendixSection %in% "methods")) expect_true(all(diagnostics_bundle$table_index$AppendixSection %in% "diagnostics")) expect_true(nrow(compact_bundle$table_index) <= nrow(rec_bundle$table_index)) expect_true(nrow(rec_bundle$table_index) <= nrow(full_bundle$table_index)) }) test_that("build_summary_table_bundle applies appendix presets at bundle-construction time", { toy <- load_mfrmr_data("example_core") fit <- suppressWarnings(fit_mfrm( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 25 )) full_bundle <- build_summary_table_bundle(fit) rec_bundle <- build_summary_table_bundle(fit, appendix_preset = "recommended") compact_bundle <- build_summary_table_bundle(fit, appendix_preset = "compact") methods_bundle <- build_summary_table_bundle(fit, appendix_preset = "methods") results_bundle <- build_summary_table_bundle(fit, appendix_preset = "results") expect_identical(rec_bundle$appendix_preset, "recommended") expect_identical(compact_bundle$appendix_preset, "compact") expect_identical(methods_bundle$appendix_preset, "methods") expect_identical(results_bundle$appendix_preset, "results") expect_true("AppendixPreset" %in% names(rec_bundle$overview)) expect_identical(as.character(rec_bundle$overview$AppendixPreset[1]), "recommended") expect_identical(as.character(summary(rec_bundle)$overview$AppendixPreset[1]), "recommended") expect_true(nrow(rec_bundle$table_index) <= nrow(full_bundle$table_index)) expect_true(nrow(compact_bundle$table_index) <= nrow(rec_bundle$table_index)) expect_true(all(rec_bundle$table_index$Table %in% full_bundle$table_index$Table)) expect_true(all(compact_bundle$table_index$Table %in% rec_bundle$table_index$Table)) expect_true(all(methods_bundle$table_index$AppendixSection %in% "methods")) expect_true(all(results_bundle$table_index$AppendixSection %in% "results")) expect_false("reporting_map" %in% names(rec_bundle$tables)) }) test_that("apa_table consumes summary outputs and summary table bundles directly", { toy <- load_mfrmr_data("example_core") fit <- suppressWarnings(fit_mfrm( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 25 )) diag <- suppressWarnings(diagnose_mfrm(fit, residual_pca = "none")) chk <- reporting_checklist(fit, diagnostics = diag) tbl_from_summary <- apa_table(summary(fit), which = "facet_overview") expect_s3_class(tbl_from_summary, "apa_table") expect_identical(tbl_from_summary$which, "facet_overview") expect_true(nrow(tbl_from_summary$table) > 0) expect_true(nzchar(tbl_from_summary$caption)) bundle <- build_summary_table_bundle(chk) tbl_from_bundle <- apa_table(bundle, which = "section_summary") expect_s3_class(tbl_from_bundle, "apa_table") expect_identical(tbl_from_bundle$which, "section_summary") expect_true(nrow(tbl_from_bundle$table) > 0) expect_true(nzchar(tbl_from_bundle$note)) expect_error( apa_table(bundle, which = "not_present"), "Requested `which` not found in summary table bundle" ) }) test_that("apa_table consumes workflow, bias, anchor, and prediction summaries directly", { workflow_tbl <- apa_table(summary(summary_table_bundle_workflow_fixture$run), which = "mapping") expect_s3_class(workflow_tbl, "apa_table") expect_identical(workflow_tbl$which, "mapping") expect_true(nrow(workflow_tbl$table) > 0L) bias_tbl <- apa_table(summary(summary_table_bundle_workflow_fixture$bias), which = "top_rows") expect_s3_class(bias_tbl, "apa_table") expect_identical(bias_tbl$which, "top_rows") expect_true(nrow(bias_tbl$table) > 0L) anchor_tbl <- apa_table(summary(summary_table_bundle_workflow_fixture$audit), which = "facet_summary") expect_s3_class(anchor_tbl, "apa_table") expect_identical(anchor_tbl$which, "facet_summary") expect_true(nrow(anchor_tbl$table) > 0L) unit_tbl <- apa_table(summary(summary_table_bundle_prediction_fixture$unit_prediction), which = "estimates") expect_s3_class(unit_tbl, "apa_table") expect_identical(unit_tbl$which, "estimates") expect_true(nrow(unit_tbl$table) > 0L) pv_tbl <- apa_table(summary(summary_table_bundle_prediction_fixture$plausible_values), which = "draw_summary") expect_s3_class(pv_tbl, "apa_table") expect_identical(pv_tbl$which, "draw_summary") expect_true(nrow(pv_tbl$table) > 0L) }) test_that("apa_table consumes future arbitrary-facet active-branch summaries directly", { spec <- build_mfrm_sim_spec( n_person = 12, n_rater = 3, n_criterion = 4, raters_per_person = 2, assignment = "rotating", facet_names = c("Judge", "Task") ) active <- spec$planning_schema$future_branch_active_branch tbl <- apa_table(summary(active), which = "future_branch_readiness") expect_s3_class(tbl, "apa_table") expect_identical(tbl$which, "future_branch_readiness") expect_true(nrow(tbl$table) > 0L) expect_true(nzchar(tbl$caption)) }) test_that("plot methods consume summary table bundles directly", { toy <- load_mfrmr_data("example_core") fit <- suppressWarnings(fit_mfrm( toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score", method = "JML", maxit = 25 )) bundle <- build_summary_table_bundle(fit) rows_plot <- plot(bundle, type = "table_rows", draw = FALSE) expect_s3_class(rows_plot, "mfrm_plot_data") expect_identical(rows_plot$name, "summary_table_bundle") expect_identical(rows_plot$data$plot, "table_rows") roles_plot <- plot(bundle, type = "role_tables", draw = FALSE) expect_s3_class(roles_plot, "mfrm_plot_data") expect_identical(roles_plot$data$plot, "role_tables") appendix_roles_plot <- plot(bundle, type = "appendix_roles", draw = FALSE) expect_s3_class(appendix_roles_plot, "mfrm_plot_data") expect_identical(appendix_roles_plot$data$plot, "appendix_roles") sections_plot <- plot(bundle, type = "appendix_sections", draw = FALSE) expect_s3_class(sections_plot, "mfrm_plot_data") expect_identical(sections_plot$data$plot, "appendix_sections") presets_plot <- plot(bundle, type = "appendix_presets", draw = FALSE) expect_s3_class(presets_plot, "mfrm_plot_data") expect_identical(presets_plot$data$plot, "appendix_presets") numeric_plot <- plot(bundle, type = "numeric_profile", which = "facet_overview", draw = FALSE) expect_s3_class(numeric_plot, "mfrm_plot_data") expect_identical(numeric_plot$name, "summary_table_bundle") expect_identical(numeric_plot$data$source_table, "facet_overview") first_numeric_plot <- plot(bundle, type = "first_numeric", which = "facet_overview", draw = FALSE) expect_s3_class(first_numeric_plot, "mfrm_plot_data") expect_identical(first_numeric_plot$data$source_table, "facet_overview") }) test_that("future-branch summary table bundles expose selection plot surfaces", { spec <- build_mfrm_sim_spec( n_person = 12, n_rater = 3, n_criterion = 4, raters_per_person = 2, assignment = "rotating", facet_names = c("Judge", "Task") ) active_bundle <- build_summary_table_bundle(spec$planning_schema$future_branch_active_branch) handoff_preset_plot <- plot(active_bundle, type = "selection_handoff_presets", appendix_preset = "all", draw = FALSE) expect_s3_class(handoff_preset_plot, "mfrm_plot_data") expect_identical(handoff_preset_plot$name, "summary_table_bundle") expect_identical(handoff_preset_plot$data$plot, "selection_handoff_presets") expect_identical(handoff_preset_plot$data$appendix_preset, "all") handoff_plot <- plot(active_bundle, type = "selection_handoff", appendix_preset = "recommended", draw = FALSE) expect_s3_class(handoff_plot, "mfrm_plot_data") expect_identical(handoff_plot$name, "summary_table_bundle") expect_identical(handoff_plot$data$plot, "selection_handoff") expect_identical(handoff_plot$data$appendix_preset, "recommended") handoff_fraction_plot <- plot(active_bundle, type = "selection_handoff", appendix_preset = "recommended", selection_value = "fraction", draw = FALSE) expect_s3_class(handoff_fraction_plot, "mfrm_plot_data") expect_identical(handoff_fraction_plot$data$plot, "selection_handoff") expect_identical(handoff_fraction_plot$data$selection_value, "fraction") handoff_bundle_plot <- plot(active_bundle, type = "selection_handoff_bundles", appendix_preset = "recommended", draw = FALSE) expect_s3_class(handoff_bundle_plot, "mfrm_plot_data") expect_identical(handoff_bundle_plot$name, "summary_table_bundle") expect_identical(handoff_bundle_plot$data$plot, "selection_handoff_bundles") expect_identical(handoff_bundle_plot$data$appendix_preset, "recommended") handoff_role_plot <- plot(active_bundle, type = "selection_handoff_roles", appendix_preset = "recommended", draw = FALSE) expect_s3_class(handoff_role_plot, "mfrm_plot_data") expect_identical(handoff_role_plot$name, "summary_table_bundle") expect_identical(handoff_role_plot$data$plot, "selection_handoff_roles") expect_identical(handoff_role_plot$data$appendix_preset, "recommended") handoff_role_section_plot <- plot(active_bundle, type = "selection_handoff_role_sections", appendix_preset = "recommended", draw = FALSE) expect_s3_class(handoff_role_section_plot, "mfrm_plot_data") expect_identical(handoff_role_section_plot$name, "summary_table_bundle") expect_identical(handoff_role_section_plot$data$plot, "selection_handoff_role_sections") expect_identical(handoff_role_section_plot$data$appendix_preset, "recommended") section_plot <- plot(active_bundle, type = "selection_sections", appendix_preset = "compact", draw = FALSE) expect_s3_class(section_plot, "mfrm_plot_data") expect_identical(section_plot$data$plot, "selection_sections") expect_identical(section_plot$data$appendix_preset, "compact") expect_error( plot(active_bundle, type = "selection_tables", appendix_preset = "recommended", selection_value = "fraction", draw = FALSE), "not available for `type = \"selection_tables\"`", fixed = TRUE ) })