tests/testthat/test-reporting-gaps.R

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

# test-reporting-gaps.R
# Targeted tests for uncovered branches in reporting.R and facets_mode files.

# ---- py_style_format fallback (line 20) ----

test_that("py_style_format returns character for non-matching format", {
  pf <- mfrmr:::py_style_format
  # No {:.Xf} match -> fallback to as.character()
  expect_equal(pf("{}", 42), "42")
  expect_equal(pf("plain", 3.14), "3.14")
})

# ---- format_fixed_width_table edge cases (lines 109-111) ----

test_that("format_fixed_width_table handles non-data.frame sections", {
  ffw <- mfrmr:::format_fixed_width_table
  # Empty data.frame returns "No data"
  expect_equal(ffw(data.frame(), columns = "X"), "No data")
  # NULL returns "No data"
  expect_equal(ffw(NULL, columns = "X"), "No data")
})

# ---- fmt_pvalue NA path (line 225) ----

test_that("fmt_pvalue returns NA for non-finite input", {
  fp <- mfrmr:::fmt_pvalue
  expect_equal(fp(NA), "NA")
  expect_equal(fp(Inf), "NA")
  expect_equal(fp(NaN), "NA")
})

# ---- safe_residual_pca with NULL (line 244) ----

test_that("safe_residual_pca returns NULL for NULL diagnostics", {
  srp <- mfrmr:::safe_residual_pca
  expect_null(srp(NULL))
})

# ---- resolve_warning_thresholds edge cases (line 317) ----

test_that("resolve_warning_thresholds falls back to standard for invalid profile", {
  rwt <- mfrmr:::resolve_warning_thresholds
  result <- rwt(threshold_profile = "nonexistent_profile")
  expect_equal(result$profile_name, "standard")
})

test_that("resolve_warning_thresholds applies custom threshold overrides", {
  rwt <- mfrmr:::resolve_warning_thresholds
  custom <- list(infit_lo = 0.3)
  result <- rwt(thresholds = custom, threshold_profile = "standard")
  expect_equal(result$thresholds$infit_lo, 0.3)
})

# ---- extract_pca functions edge cases (lines 362-397) ----

test_that("extract_overall_pca_first returns NULL for empty table", {
  ef <- mfrmr:::extract_overall_pca_first
  expect_null(ef(NULL))
  expect_null(ef(list(overall_table = NULL)))
  expect_null(ef(list(overall_table = data.frame())))
})

test_that("extract_overall_pca_second returns NULL for empty or single-row table", {
  es <- mfrmr:::extract_overall_pca_second
  expect_null(es(NULL))
  expect_null(es(list(overall_table = data.frame())))
  # Single component (no PC2)
  tbl <- data.frame(Component = 1, Eigenvalue = 2.5, Proportion = 0.5)
  expect_null(es(list(overall_table = tbl)))
})

test_that("extract_facet_pca_first returns empty data.frame for NULL input", {
  efp <- mfrmr:::extract_facet_pca_first
  expect_equal(nrow(efp(NULL)), 0)
  expect_equal(nrow(efp(list(by_facet_table = NULL))), 0)
  expect_equal(nrow(efp(list(by_facet_table = data.frame()))), 0)
  # Missing required columns
  expect_equal(nrow(efp(list(by_facet_table = data.frame(X = 1)))), 0)
})

# ---- collapse_apa_paragraph edge cases (lines 400-406) ----

test_that("collapse_apa_paragraph handles empty input and small width", {
  cap <- mfrmr:::collapse_apa_paragraph
  expect_equal(cap(character(0)), "")
  expect_equal(cap(NULL), "")
  expect_equal(cap(c("", " ")), "")
  # Width below minimum gets reset to 92
  result <- cap("A short sentence.", width = 10)
  expect_true(nchar(result) > 0)
})

# ---- summarize_anchor_constraints edge cases (lines 435, 440, 445) ----

test_that("summarize_anchor_constraints handles missing columns", {
  sac <- mfrmr:::summarize_anchor_constraints
  # Minimal config with no anchors
  config <- list(
    noncenter_facet = "none",
    facet_names = c("Rater"),
    facet_levels = list(Rater = c("R1", "R2")),
    dummy_facets = character(0)
  )
  result <- sac(config)
  expect_true(grepl("noncenter facet", result))
  expect_true(grepl("none", result))
})

# ---- summarize_step_estimates edge cases (lines 487-536) ----

test_that("summarize_step_estimates handles NULL step table", {
  sse <- mfrmr:::summarize_step_estimates
  expect_equal(sse(NULL), "Step/threshold estimates were not available.")
  expect_equal(sse(data.frame()), "Step/threshold estimates were not available.")
})

# ---- summarize_top_misfit_levels edge cases (lines 539-559) ----

test_that("summarize_top_misfit_levels handles NULL table", {
  stm <- mfrmr:::summarize_top_misfit_levels
  expect_equal(stm(NULL), "Top misfit levels were not available.")
  expect_equal(stm(data.frame()), "Top misfit levels were not available.")
})

# ---- build_apa_text with context options (lines 610-658) ----

test_that("build_apa_text respects context parameters", {
  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)

  # With context options that trigger the assessment/setting branches
  apa <- build_apa_outputs(fit, diagnostics = diag, context = list(
    assessment = "essay writing",
    setting = "a university course",
    rater_training = "two-hour calibration",
    raters_per_response = "2",
    scale_desc = "holistic 0-3"
  ))
  expect_true(grepl("essay writing", apa$report_text))
  expect_true(grepl("university course", apa$report_text))
  expect_true(grepl("calibration", apa$report_text))
  expect_true(grepl("holistic", apa$report_text))
})

# ---- build_apa_table_figure_note_map edge cases (lines 859-943) ----

test_that("build_apa_table_figure_note_map produces note map", {
  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)

  note_map <- mfrmr:::build_apa_table_figure_note_map(
    res = fit, diagnostics = diag, bias_results = NULL
  )
  expect_true(is.list(note_map))
  expect_true("table1" %in% names(note_map))
  expect_true("table2" %in% names(note_map))
  expect_true(grepl("Facet summary", note_map$table1))
})

# ---- build_visual_warning_map measures not available (lines 1079-1083) ----

test_that("build_visual_warning_map handles missing measures", {
  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)
  # Null out measures to hit the missing measures branch
  diag$measures <- NULL

  wm <- mfrmr:::build_visual_warning_map(fit, diag)
  expect_true(is.list(wm))
  expect_true(any(grepl("not available", unlist(wm))))
})

# ---- build_visual_summary_map pathway/PCA unavailable (lines 1275, 1395, 1426) ----

test_that("build_visual_summary_map handles missing step and PCA data", {
  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)

  sm <- mfrmr:::build_visual_summary_map(fit, diag)
  expect_true(is.list(sm))
})

# ---- facets_mode_api.R: normalize_spec_input (line 20) ----

test_that("normalize_spec_input converts valid data.frame", {
  nsi <- mfrmr:::normalize_spec_input
  result <- nsi(data.frame(Facet = "R", Level = "R1", Anchor = 0.5), "anchors")
  expect_true(is.data.frame(result))
})

# ---- facets_mode_api.R: weight not found (lines 47-48) ----

test_that("infer_facets_mode_mapping rejects missing weight column", {
  toy <- data.frame(Person = 1:3, Score = 1:3, Rater = c("A", "B", "C"))
  expect_error(
    mfrmr:::infer_facets_mode_mapping(toy, person = "Person",
                                       score = "Score", weight = "NoSuch"),
    "Weight column not found"
  )
})

# ---- facets_mode_api.R: auto-detect facet columns (lines 53-56) ----

test_that("infer_facets_mode_mapping auto-detects facet columns", {
  toy <- data.frame(Person = 1:5, Score = 1:5, Rater = paste0("R", 1:5),
                    Task = paste0("T", 1:5))
  result <- mfrmr:::infer_facets_mode_mapping(toy, person = "Person", score = "Score")
  expect_true("Rater" %in% result$facets)
  expect_true("Task" %in% result$facets)
})

# ---- facets_mode_api.R: no facets detected (line 60) ----

test_that("infer_facets_mode_mapping errors when no facet columns found", {
  # 3 columns but person and score take up 2, leaving only 1 for facets
  # Actually, we need a case where all remaining columns are blocked
  toy <- data.frame(Person = 1:3, Score = 1:3, Weight = c(1, 1, 1))
  expect_error(
    mfrmr:::infer_facets_mode_mapping(toy, person = "Person",
                                       score = "Score", weight = "Weight"),
    "No facet columns"
  )
})

# ---- facets_mode_methods.R: round_numeric_frame edge (line 4) ----

test_that("round_numeric_frame handles empty data.frame", {
  rnf <- mfrmr:::round_numeric_frame
  result <- rnf(data.frame())
  expect_true(is.data.frame(result))
  expect_equal(nrow(result), 0)
})

# ---- facets_mode_methods.R: summary error path (line 54) ----

test_that("summary.mfrm_facets_run rejects non-mfrm_facets_run input", {
  expect_error(
    summary.mfrm_facets_run(list()),
    "mfrm_facets_run"
  )
})

# ---- facets_mode_methods.R: plot error path (line 157) ----

test_that("plot.mfrm_facets_run rejects non-mfrm_facets_run input", {
  expect_error(
    plot.mfrm_facets_run(list()),
    "mfrm_facets_run"
  )
})

# ---- build_apa_text with bias (line 876) ----

test_that("build_apa_table_figure_note_map includes bias note when provided", {
  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)
  bias <- estimate_bias(fit, diag, facet_a = "Rater", facet_b = "Task")

  note_map <- mfrmr:::build_apa_table_figure_note_map(
    res = fit, diagnostics = diag, bias_results = bias
  )
  expect_true(grepl("Bias", note_map$table4))
})

# ---- build_bias_fixed_text with facet_a only (line 159) ----

test_that("build_bias_fixed_text handles single facet label", {
  bfrt <- mfrmr:::build_bias_fixed_text
  result <- bfrt(
    table_df = data.frame(A = 1:2, B = 3:4),
    summary_df = NULL,
    chi_df = NULL,
    facet_a = "Rater",
    facet_b = NULL,
    interaction_label = NULL,
    columns = c("A", "B"),
    formats = list()
  )
  expect_true(grepl("Rater", result))
  expect_true(is.character(result))
})

# ---- PCM model APA text (line 653) ----

test_that("build_apa_text includes PCM step structure text", {
  d <- mfrmr:::sample_mfrm_data(seed = 42)
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", c("Rater", "Task", "Criterion"), "Score",
             model = "PCM", method = "JML", step_facet = "Criterion", maxit = 20)
  )
  diag <- diagnose_mfrm(fit)
  apa <- build_apa_outputs(fit, diagnostics = diag)
  # Should mention PCM and step structure
  expect_true(grepl("PCM", apa$report_text))
})

# ---- Weighted model APA text (line 658) ----

test_that("build_apa_text includes weight text", {
  set.seed(42)
  d <- data.frame(
    Person = rep(paste0("P", 1:8), each = 3),
    Rater = rep(paste0("R", 1:3), 8),
    Score = sample(0:2, 24, replace = TRUE),
    W = rep(c(1, 2, 0.5), 8)
  )
  fit <- suppressWarnings(
    fit_mfrm(d, "Person", "Rater", "Score", weight = "W",
             method = "JML", maxit = 20)
  )
  diag <- diagnose_mfrm(fit)
  apa <- build_apa_outputs(fit, diagnostics = diag)
  expect_true(grepl("[Ww]eight", apa$report_text))
})

# ---- build_pca_reference_text (line 329) ----

test_that("build_pca_reference_text produces formatted reference text", {
  refs <- mfrmr:::warning_threshold_profiles()
  bprt <- mfrmr:::build_pca_reference_text
  result <- bprt(refs$pca_reference_bands)
  expect_true(grepl("Heuristic reference bands", result))
  expect_true(grepl("EV >=", result))
})