tests/testthat/test-expanded-summary-plot.R

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

test_that("expanded bundle classes dispatch through plot.mfrm_bundle", {
  toy <- expand.grid(
    Person = paste0("P", 1:4),
    Rater = paste0("R", 1:2),
    Criterion = c("Content", "Organization", "Language"),
    stringsAsFactors = FALSE
  )
  toy$Score <- (
    as.integer(factor(toy$Person)) +
      2 * as.integer(factor(toy$Rater)) +
      as.integer(factor(toy$Criterion))
  ) %% 3

  fit <- mfrmr::fit_mfrm(
    data = toy,
    person = "Person",
    facets = c("Rater", "Criterion"),
    score = "Score",
    method = "JML",
    maxit = 25
  )
  diag <- mfrmr::diagnose_mfrm(fit, residual_pca = "both")
  bias <- mfrmr::estimate_bias(fit, diag, facet_a = "Rater", facet_b = "Criterion", max_iter = 2)

  targets <- list(
    list(obj = mfrmr::measurable_summary_table(fit, diag), type = "facet_coverage"),
    list(obj = mfrmr::unexpected_after_bias_table(fit, bias, diagnostics = diag, top_n = 20), type = "comparison"),
    list(obj = mfrmr::facets_output_file_bundle(fit, diagnostics = diag, include = c("graph", "score")), type = "graph_expected"),
    list(obj = mfrmr::analyze_residual_pca(diag, mode = "both"), type = "overall_scree"),
    list(obj = mfrmr::specifications_report(fit), type = "facet_elements"),
    list(obj = mfrmr::data_quality_report(fit, data = toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score"), type = "row_audit"),
    list(obj = mfrmr::estimation_iteration_report(fit, max_iter = 5), type = "residual"),
    list(obj = mfrmr::subset_connectivity_report(fit), type = "subset_observations"),
    list(obj = mfrmr::facet_statistics_report(fit), type = "means")
  )

  for (tr in targets) {
    plt <- plot(tr$obj, type = tr$type, draw = FALSE)
    expect_s3_class(plt, "mfrm_plot_data")
  }
})

test_that("expanded bundle classes provide class-aware summary output", {
  toy <- expand.grid(
    Person = paste0("P", 1:4),
    Rater = paste0("R", 1:2),
    Criterion = c("Content", "Organization", "Language"),
    stringsAsFactors = FALSE
  )
  toy$Score <- (
    as.integer(factor(toy$Person)) +
      2 * as.integer(factor(toy$Rater)) +
      as.integer(factor(toy$Criterion))
  ) %% 3

  fit <- mfrmr::fit_mfrm(
    data = toy,
    person = "Person",
    facets = c("Rater", "Criterion"),
    score = "Score",
    method = "JML",
    maxit = 25
  )
  diag <- mfrmr::diagnose_mfrm(fit, residual_pca = "both")
  bias <- mfrmr::estimate_bias(fit, diag, facet_a = "Rater", facet_b = "Criterion", max_iter = 2)

  targets <- list(
    list(obj = mfrmr::measurable_summary_table(fit, diag), kind = "mfrm_measurable"),
    list(obj = mfrmr::unexpected_after_bias_table(fit, bias, diagnostics = diag, top_n = 20), kind = "mfrm_unexpected_after_bias"),
    list(obj = mfrmr::facets_output_file_bundle(fit, diagnostics = diag, include = c("graph", "score")), kind = "mfrm_output_bundle"),
    list(obj = mfrmr::analyze_residual_pca(diag, mode = "both"), kind = "mfrm_residual_pca"),
    list(obj = mfrmr::specifications_report(fit), kind = "mfrm_specifications"),
    list(obj = mfrmr::data_quality_report(fit, data = toy, person = "Person", facets = c("Rater", "Criterion"), score = "Score"), kind = "mfrm_data_quality"),
    list(obj = mfrmr::estimation_iteration_report(fit, max_iter = 5), kind = "mfrm_iteration_report"),
    list(obj = mfrmr::subset_connectivity_report(fit), kind = "mfrm_subset_connectivity"),
    list(obj = mfrmr::facet_statistics_report(fit), kind = "mfrm_facet_statistics")
  )

  for (tr in targets) {
    out <- summary(tr$obj)
    expect_s3_class(out, "summary.mfrm_bundle")
    expect_identical(out$summary_kind, tr$kind)
    expect_true(is.data.frame(out$overview))
    expect_true(nrow(out$overview) == 1)
  }
})

test_that("core bundle classes now return class-aware summary_kind", {
  toy <- expand.grid(
    Person = paste0("P", 1:4),
    Rater = paste0("R", 1:2),
    Criterion = c("Content", "Organization", "Language"),
    stringsAsFactors = FALSE
  )
  toy$Score <- (
    as.integer(factor(toy$Person)) +
      2 * as.integer(factor(toy$Rater)) +
      as.integer(factor(toy$Criterion))
  ) %% 3

  fit <- mfrmr::fit_mfrm(
    data = toy,
    person = "Person",
    facets = c("Rater", "Criterion"),
    score = "Score",
    method = "JML",
    maxit = 25
  )
  diag <- mfrmr::diagnose_mfrm(fit, residual_pca = "none")
  bias <- mfrmr::estimate_bias(fit, diag, facet_a = "Rater", facet_b = "Criterion", max_iter = 2)

  targets <- list(
    list(obj = mfrmr::unexpected_response_table(fit, diagnostics = diag, top_n = 10), kind = "mfrm_unexpected"),
    list(obj = mfrmr::fair_average_table(fit, diagnostics = diag), kind = "mfrm_fair_average"),
    list(obj = mfrmr::displacement_table(fit, diagnostics = diag), kind = "mfrm_displacement"),
    list(obj = mfrmr::interrater_agreement_table(fit, diagnostics = diag), kind = "mfrm_interrater"),
    list(obj = mfrmr::facets_chisq_table(fit, diagnostics = diag), kind = "mfrm_facets_chisq"),
    list(obj = mfrmr::bias_interaction_report(bias), kind = "mfrm_bias_interaction"),
    list(obj = mfrmr::rating_scale_table(fit, diagnostics = diag), kind = "mfrm_rating_scale"),
    list(obj = mfrmr::category_structure_report(fit, diagnostics = diag), kind = "mfrm_category_structure"),
    list(obj = mfrmr::category_curves_report(fit, theta_points = 101), kind = "mfrm_category_curves")
  )

  for (tr in targets) {
    out <- summary(tr$obj)
    expect_s3_class(out, "summary.mfrm_bundle")
    expect_identical(out$summary_kind, tr$kind)
    expect_true(is.data.frame(out$overview))
    expect_true(nrow(out$overview) == 1)
  }
})

test_that("print.summary.mfrm_bundle uses class-aware titles", {
  toy <- expand.grid(
    Person = paste0("P", 1:4),
    Rater = paste0("R", 1:2),
    Criterion = c("Content", "Organization", "Language"),
    stringsAsFactors = FALSE
  )
  toy$Score <- (
    as.integer(factor(toy$Person)) +
      2 * as.integer(factor(toy$Rater)) +
      as.integer(factor(toy$Criterion))
  ) %% 3

  fit <- mfrmr::fit_mfrm(
    data = toy,
    person = "Person",
    facets = c("Rater", "Criterion"),
    score = "Score",
    method = "JML",
    maxit = 25
  )
  diag <- mfrmr::diagnose_mfrm(fit, residual_pca = "none")

  t4 <- mfrmr::unexpected_response_table(fit, diagnostics = diag, top_n = 10)
  t4_sum <- summary(t4)
  out_t4 <- paste(capture.output(print(t4_sum)), collapse = "\n")
  expect_match(out_t4, "mfrmr Unexpected Response Summary", fixed = TRUE)
  expect_match(out_t4, "Threshold summary", fixed = TRUE)

  rs <- mfrmr::rating_scale_table(fit, diagnostics = diag)
  rs_sum <- summary(rs)
  out_rs <- paste(capture.output(print(rs_sum)), collapse = "\n")
  expect_match(out_rs, "mfrmr Rating Scale Summary", fixed = TRUE)
  expect_match(out_rs, "Category/threshold summary", fixed = TRUE)
})

test_that("data description and anchor audit support summary and plot", {
  toy <- expand.grid(
    Person = paste0("P", 1:4),
    Rater = paste0("R", 1:2),
    Criterion = c("Content", "Organization", "Language"),
    stringsAsFactors = FALSE
  )
  toy$Score <- (
    as.integer(factor(toy$Person)) +
      2 * as.integer(factor(toy$Rater)) +
      as.integer(factor(toy$Criterion))
  ) %% 3

  ds <- mfrmr::describe_mfrm_data(
    data = toy,
    person = "Person",
    facets = c("Rater", "Criterion"),
    score = "Score"
  )
  ds_sum <- summary(ds)
  expect_s3_class(ds_sum, "summary.mfrm_data_description")
  ds_plot <- plot(ds, type = "score_distribution", draw = FALSE)
  expect_s3_class(ds_plot, "mfrm_plot_data")

  aud <- mfrmr::audit_mfrm_anchors(
    data = toy,
    person = "Person",
    facets = c("Rater", "Criterion"),
    score = "Score"
  )
  aud_sum <- summary(aud)
  expect_s3_class(aud_sum, "summary.mfrm_anchor_audit")
  aud_plot <- plot(aud, type = "issue_counts", draw = FALSE)
  expect_s3_class(aud_plot, "mfrm_plot_data")
})