tests/testthat/test-reporting-coverage.R

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

# test-reporting-coverage.R
# Exercises uncovered paths in reporting.R:
# - build_visual_warning_map (all warning stages)
# - build_visual_summary_map (all summary stages, including detail="detailed")
# - build_apa_report_text (with and without context/bias)
# - build_apa_table_figure_notes / captions
# - build_sectioned_fixed_report edge cases
# - format_fixed_width_table edge cases
# - resolve_warning_thresholds with different profiles
# - build_pca_reference_text / build_pca_check_text
# - summarize_anchor_constraints / summarize_convergence_metrics / summarize_step_estimates
# - summarize_bias_counts / summarize_top_misfit_levels

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

# ============================================================================
# build_visual_warning_map
# ============================================================================

test_that("build_visual_warning_map returns all expected visual keys", {
  wmap <- mfrmr:::build_visual_warning_map(.fit, .diag)
  expected_keys <- c(
    "wright_map", "pathway_map", "facet_distribution", "step_thresholds",
    "category_curves", "observed_expected", "fit_diagnostics",
    "fit_zstd_distribution", "misfit_levels",
    "residual_pca_overall", "residual_pca_by_facet"
  )
  expect_true(all(expected_keys %in% names(wmap)))
})

test_that("build_visual_warning_map with strict profile produces more warnings", {
  wmap_strict <- mfrmr:::build_visual_warning_map(.fit, .diag, threshold_profile = "strict")
  expect_true(is.list(wmap_strict))
  expect_true(length(wmap_strict$residual_pca_overall) > 0)
})

test_that("build_visual_warning_map with lenient profile", {
  wmap_lenient <- mfrmr:::build_visual_warning_map(.fit, .diag, threshold_profile = "lenient")
  expect_true(is.list(wmap_lenient))
})

test_that("build_visual_warning_map with NULL inputs returns empty map", {
  wmap_null <- mfrmr:::build_visual_warning_map(NULL, NULL)
  expect_true(is.list(wmap_null))
  expect_true(all(lengths(wmap_null) == 0))
})

test_that("build_visual_warning_map with custom threshold overrides", {
  custom_thr <- list(n_obs_min = 999999, n_person_min = 999999)
  wmap <- mfrmr:::build_visual_warning_map(.fit, .diag, thresholds = custom_thr)
  expect_true(any(grepl("Small", unlist(wmap))))
})

# ============================================================================
# build_visual_summary_map
# ============================================================================

test_that("build_visual_summary_map returns summary text for all keys", {
  smap <- mfrmr:::build_visual_summary_map(.fit, .diag)
  expected_keys <- c(
    "wright_map", "pathway_map", "facet_distribution", "step_thresholds",
    "category_curves", "observed_expected", "fit_diagnostics",
    "fit_zstd_distribution", "misfit_levels",
    "residual_pca_overall", "residual_pca_by_facet"
  )
  expect_true(all(expected_keys %in% names(smap)))
  # wright_map should always have some text
  expect_true(length(smap$wright_map) > 0)
})

test_that("build_visual_summary_map with detail='detailed' adds extra summaries", {
  smap_detailed <- mfrmr:::build_visual_summary_map(
    .fit, .diag,
    options = list(detail = "detailed", max_facet_ranges = 2, top_misfit_n = 5)
  )
  expect_true(is.list(smap_detailed))
  expect_true(length(smap_detailed$wright_map) > 0)
})

test_that("build_visual_summary_map with NULL inputs returns empty map", {
  smap_null <- mfrmr:::build_visual_summary_map(NULL, NULL)
  expect_true(is.list(smap_null))
  expect_true(all(lengths(smap_null) == 0))
})

# ============================================================================
# build_apa_report_text
# ============================================================================

test_that("build_apa_report_text produces Method and Results sections", {
  text <- mfrmr:::build_apa_report_text(.fit, .diag)
  expect_true(grepl("Method", text))
  expect_true(grepl("Results", text))
  expect_true(grepl("many-facet Rasch", text, ignore.case = TRUE))
})

test_that("build_apa_report_text with context supplies assessment/setting text", {
  ctx <- list(
    assessment = "writing proficiency",
    setting = "a university setting",
    rater_training = "two hours of calibration training",
    raters_per_response = "two",
    scale_desc = "a 5-point holistic rubric",
    line_width = 80L
  )
  text <- mfrmr:::build_apa_report_text(.fit, .diag, context = ctx)
  expect_true(grepl("writing proficiency", text))
  expect_true(grepl("university", text))
  expect_true(grepl("calibration", text))
  expect_true(grepl("holistic rubric", text))
})

test_that("build_apa_report_text with bias_results includes bias summary", {
  text <- mfrmr:::build_apa_report_text(.fit, .diag, bias_results = .bias)
  expect_true(grepl("Bias", text, ignore.case = TRUE) || grepl("bias", text))
})

test_that("build_apa_report_text without bias mentions no bias data", {
  text <- mfrmr:::build_apa_report_text(.fit, .diag, bias_results = NULL)
  expect_true(nchar(text) > 0)
})

# ============================================================================
# build_apa_table_figure_notes / captions
# ============================================================================

test_that("build_apa_table_figure_notes produces note text", {
  notes <- mfrmr:::build_apa_table_figure_notes(.fit, .diag)
  expect_true(is.character(notes))
  expect_true(nchar(notes) > 0)
})

test_that("build_apa_table_figure_notes with bias_results includes bias notes", {
  notes <- mfrmr:::build_apa_table_figure_notes(.fit, .diag, bias_results = .bias)
  expect_true(nchar(notes) > 0)
})

test_that("build_apa_table_figure_captions produces caption text", {
  captions <- mfrmr:::build_apa_table_figure_captions(.fit, .diag)
  expect_true(is.character(captions))
  expect_true(grepl("Table 1", captions))
})

test_that("build_apa_table_figure_captions with context adds assessment phrase", {
  ctx <- list(assessment = "oral proficiency")
  captions <- mfrmr:::build_apa_table_figure_captions(.fit, .diag, context = ctx)
  expect_true(grepl("oral proficiency", captions))
})

test_that("build_apa_table_figure_captions with bias includes interaction label", {
  captions <- mfrmr:::build_apa_table_figure_captions(.fit, .diag, bias_results = .bias)
  expect_true(grepl("Table 4", captions))
})

# ============================================================================
# resolve_warning_thresholds
# ============================================================================

test_that("resolve_warning_thresholds returns all profiles", {
  for (profile in c("strict", "standard", "lenient")) {
    resolved <- mfrmr:::resolve_warning_thresholds(threshold_profile = profile)
    expect_equal(resolved$profile_name, profile)
    expect_true("thresholds" %in% names(resolved))
    expect_true("pca_reference_bands" %in% names(resolved))
    expect_true(resolved$thresholds$n_obs_min > 0)
  }
})

test_that("resolve_warning_thresholds applies custom overrides", {
  resolved <- mfrmr:::resolve_warning_thresholds(
    thresholds = list(n_obs_min = 42),
    threshold_profile = "standard"
  )
  expect_equal(resolved$thresholds$n_obs_min, 42)
})

# ============================================================================
# build_pca_reference_text / build_pca_check_text
# ============================================================================

test_that("build_pca_reference_text returns reference band text", {
  bands <- mfrmr:::warning_threshold_profiles()$pca_reference_bands
  text <- mfrmr:::build_pca_reference_text(bands)
  expect_true(is.character(text))
  expect_true(nchar(text) > 0)
})

test_that("build_pca_check_text returns interpretive text for a given eigenvalue/proportion", {
  bands <- mfrmr:::warning_threshold_profiles()$pca_reference_bands
  text <- mfrmr:::build_pca_check_text(eigenvalue = 1.5, proportion = 0.08, reference_bands = bands)
  expect_true(is.character(text))
  expect_true(nchar(text) > 0)
})

test_that("build_pca_check_text with high eigenvalue flags concern", {
  bands <- mfrmr:::warning_threshold_profiles()$pca_reference_bands
  text <- mfrmr:::build_pca_check_text(eigenvalue = 5.0, proportion = 0.25, reference_bands = bands)
  expect_true(nchar(text) > 0)
})

# ============================================================================
# Format helpers: format_fixed_width_table edge cases
# ============================================================================

test_that("format_fixed_width_table handles empty data frame", {
  result <- mfrmr:::format_fixed_width_table(data.frame(), columns = character(0))
  expect_equal(result, "No data")
})

test_that("format_fixed_width_table handles missing columns gracefully", {
  df <- data.frame(A = 1:3, B = c("x", "y", "z"), stringsAsFactors = FALSE)
  result <- mfrmr:::format_fixed_width_table(df, columns = c("A", "B", "C"))
  expect_true(is.character(result))
  expect_true(grepl("A", result))
})

# ============================================================================
# build_sectioned_fixed_report
# ============================================================================

test_that("build_sectioned_fixed_report handles various section types", {
  report <- mfrmr:::build_sectioned_fixed_report(
    title = "Test Report",
    sections = list(
      list(title = "Empty Section", data = NULL),
      list(title = "String Section", data = "Some text here"),
      list(title = "Data Section", data = data.frame(X = 1:3, Y = c("a", "b", "c"), stringsAsFactors = FALSE)),
      list(title = "Empty DF", data = data.frame()),
      list(title = "Truncated Section", data = data.frame(X = 1:10), max_rows = 3)
    )
  )
  expect_true(grepl("Test Report", report))
  expect_true(grepl("Some text here", report))
  expect_true(grepl("Empty Section", report))
  expect_true(grepl("Showing first 3 rows of 10", report))
})

# ============================================================================
# summarize_anchor_constraints
# ============================================================================

test_that("summarize_anchor_constraints produces text about anchor status", {
  text <- mfrmr:::summarize_anchor_constraints(.fit$config)
  expect_true(is.character(text))
})

# ============================================================================
# summarize_convergence_metrics
# ============================================================================

test_that("summarize_convergence_metrics produces text from summary row", {
  summary_row <- .fit$summary
  if (!is.null(summary_row) && nrow(summary_row) > 0) {
    text <- mfrmr:::summarize_convergence_metrics(summary_row[1, , drop = FALSE])
    expect_true(is.character(text))
  }
})

# ============================================================================
# summarize_step_estimates
# ============================================================================

test_that("summarize_step_estimates produces text from step table", {
  text <- mfrmr:::summarize_step_estimates(.fit$steps)
  expect_true(is.character(text))
  expect_true(nchar(paste(text, collapse = "")) > 0)
})

# ============================================================================
# summarize_bias_counts
# ============================================================================

test_that("summarize_bias_counts with bias results", {
  text <- mfrmr:::summarize_bias_counts(.bias)
  expect_true(is.character(text))
  expect_true(nchar(paste(text, collapse = "")) > 0)
})

test_that("summarize_bias_counts with NULL returns text", {
  text <- mfrmr:::summarize_bias_counts(NULL)
  expect_true(is.character(text))
})

# ============================================================================
# summarize_top_misfit_levels
# ============================================================================

test_that("summarize_top_misfit_levels produces text", {
  fit_tbl <- .diag$fit
  if (!is.null(fit_tbl) && nrow(fit_tbl) > 0) {
    text <- mfrmr:::summarize_top_misfit_levels(fit_tbl, top_n = 3)
    expect_true(is.character(text))
  }
})

# ============================================================================
# collapse_apa_paragraph
# ============================================================================

test_that("collapse_apa_paragraph wraps text at specified width", {
  sentences <- c(
    "This is a first sentence.",
    "This is a second sentence that is somewhat longer than the first.",
    "And a third one."
  )
  result <- mfrmr:::collapse_apa_paragraph(sentences, width = 40L)
  expect_true(is.character(result))
  expect_true(nchar(result) > 0)
})

# ============================================================================
# py_style_format edge cases
# ============================================================================

test_that("py_style_format handles edge cases", {
  fmt <- mfrmr:::py_style_format
  expect_equal(fmt(NULL, 42), "42")
  expect_equal(fmt("{}", 42), "42")
  expect_equal(fmt("{:.0f}", NA), "")
  expect_equal(fmt(function(x) paste0("$", x), 100), "$100")
  expect_equal(fmt(c("a", "b"), 42), "42")
})

# ============================================================================
# describe_series edge cases
# ============================================================================

test_that("describe_series handles NULL and empty inputs", {
  expect_null(mfrmr:::describe_series(NULL))
  expect_null(mfrmr:::describe_series(c(NA, NaN)))
  s <- mfrmr:::describe_series(c(1, 2, 3))
  expect_equal(s$min, 1)
  expect_equal(s$max, 3)
  expect_equal(s$mean, 2)
})

test_that("describe_series handles single element", {
  s <- mfrmr:::describe_series(5)
  expect_equal(s$min, 5)
  expect_equal(s$max, 5)
  expect_true(is.na(s$sd))
})

# ============================================================================
# build_bias_fixed_text / build_pairwise_fixed_text
# ============================================================================

test_that("build_bias_fixed_text with valid data produces text", {
  if (!is.null(.bias$table) && nrow(.bias$table) > 0) {
    tbl <- as.data.frame(.bias$table, stringsAsFactors = FALSE)
    cols <- intersect(
      c("Bias Size", "Obs-Exp Average", "S.E.", "t", "Prob."),
      names(tbl)
    )
    text <- mfrmr:::build_bias_fixed_text(
      table_df = tbl,
      summary_df = .bias$summary %||% data.frame(),
      chi_df = .bias$chi_sq %||% data.frame(),
      facet_a = "Rater",
      facet_b = "Task",
      columns = cols,
      formats = list()
    )
    expect_true(is.character(text))
    expect_true(grepl("Bias", text))
  }
})

test_that("build_bias_fixed_text with empty table returns 'No bias data'", {
  text <- mfrmr:::build_bias_fixed_text(
    table_df = data.frame(),
    summary_df = data.frame(),
    chi_df = data.frame(),
    facet_a = "Rater",
    facet_b = "Task",
    columns = character(0),
    formats = list()
  )
  expect_equal(text, "No bias data")
})

test_that("build_pairwise_fixed_text with empty data returns 'No pairwise data'", {
  text <- mfrmr:::build_pairwise_fixed_text(
    pair_df = data.frame(),
    target_facet = "Rater",
    context_facet = "Task",
    columns = character(0),
    formats = list()
  )
  expect_equal(text, "No pairwise data")
})

# ============================================================================
# extract_overall_pca_first / extract_overall_pca_second / extract_facet_pca_first
# ============================================================================

test_that("PCA extraction functions return correct data", {
  pca <- mfrmr:::safe_residual_pca(.diag, mode = "both")
  if (!is.null(pca)) {
    first <- mfrmr:::extract_overall_pca_first(pca)
    expect_true(!is.null(first))
    expect_true("Eigenvalue" %in% names(first))

    second <- mfrmr:::extract_overall_pca_second(pca)
    # second may be NULL if only 1 component
    expect_true(is.null(second) || "Eigenvalue" %in% names(second))

    facet <- mfrmr:::extract_facet_pca_first(pca)
    expect_true(is.data.frame(facet))
  }
})

test_that("PCA extraction functions handle NULL input", {
  expect_null(mfrmr:::extract_overall_pca_first(NULL))
  expect_null(mfrmr:::extract_overall_pca_second(NULL))
  facet <- mfrmr:::extract_facet_pca_first(NULL)
  expect_true(is.data.frame(facet))
  expect_equal(nrow(facet), 0)
})

# ============================================================================
# build_apa_table_figure_note_map (internal)
# ============================================================================

test_that("build_apa_table_figure_note_map returns a named list", {
  note_map <- mfrmr:::build_apa_table_figure_note_map(.fit, .diag)
  expect_true(is.list(note_map))
  expect_true(length(note_map) > 0)
})

test_that("build_apa_table_figure_note_map with bias_results includes table4", {
  note_map <- mfrmr:::build_apa_table_figure_note_map(.fit, .diag, bias_results = .bias)
  expect_true("table4" %in% names(note_map))
})