tests/testthat/test-factorability.R

In ackwards: Bass-Ackwards Hierarchical Structural Analysis

# factorability(): pre-analysis KMO / Bartlett / N:p / Ledermann screen, plus
# the shared internal screen ackwards() runs (Ledermann + adequacy warnings).

test_that("factorability() on raw data returns the expected shape", {
  f <- factorability(sim16)
  expect_s3_class(f, "factorability")
  expect_named(
    f,
    c(
      "cor", "n_obs", "n_vars", "np_ratio", "kmo_overall",
      "kmo_items", "bartlett", "ledermann"
    ),
    ignore.order = TRUE
  )
  expect_identical(f$cor, "pearson")
  expect_identical(f$n_obs, nrow(sim16))
  expect_identical(f$n_vars, ncol(sim16))
  expect_equal(f$np_ratio, nrow(sim16) / ncol(sim16))
  expect_identical(f$ledermann, 10L) # p = 16
  expect_equal(nrow(f$kmo_items), ncol(sim16))
  expect_named(f$kmo_items, c("item", "msa"))
})

test_that("factorability() KMO and Bartlett match psych on a fixed matrix", {
  R <- cor(sim16)
  n <- nrow(sim16)
  f <- factorability(R, n_obs = n)

  k <- psych::KMO(R)
  expect_equal(f$kmo_overall, unname(k$MSA))
  expect_equal(f$kmo_items$msa, unname(k$MSAi))

  b <- psych::cortest.bartlett(R, n = n)
  expect_equal(f$bartlett$chisq, unname(b$chisq))
  expect_equal(f$bartlett$df, unname(b$df))
  expect_equal(f$bartlett$p_value, unname(b$p.value))
})

test_that("N-based diagnostics are NA/NULL for a matrix without n_obs", {
  R <- cor(sim16)
  f <- factorability(R)
  expect_true(is.na(f$n_obs))
  expect_true(is.na(f$np_ratio))
  expect_null(f$bartlett)
  # KMO and Ledermann do not need N and are still reported
  expect_false(is.na(f$kmo_overall))
  expect_identical(f$ledermann, 10L)
})

test_that("factorability() honours the correlation basis", {
  f_p <- factorability(sim16, cor = "pearson")
  f_s <- factorability(sim16, cor = "spearman")
  expect_identical(f_s$cor, "spearman")
  # Spearman and Pearson KMO differ (different R)
  expect_false(isTRUE(all.equal(f_p$kmo_overall, f_s$kmo_overall)))
})

test_that("factorability() errors on a constant item and warns on ignored n_obs", {
  d <- sim16
  d$dead <- 3
  expect_error(factorability(d), "no variance")

  expect_warning(factorability(sim16, n_obs = 999), "ignored for raw data")
})

test_that("factorability() validates n_obs and rejects too-few columns", {
  R <- cor(sim16)
  expect_error(factorability(R, n_obs = -5), "positive integer")
  expect_error(factorability(R, n_obs = 2.5), "positive integer")
  expect_error(factorability(sim16[, 1, drop = FALSE]), "at least two columns")
})

test_that("print.factorability() renders without error and returns invisibly", {
  f <- factorability(cor(sim16), n_obs = nrow(sim16))
  expect_no_error(print(f))
  expect_invisible(print(f))
  # cli output is captured on the message connection (see test-print.R)
  txt <- cli::ansi_strip(capture.output(print(f), type = "message"))
  expect_true(any(grepl("Factorability screen", txt)))
  expect_true(any(grepl("Ledermann bound", txt)))
  expect_true(any(grepl("Bartlett", txt)))
  # No-N variant prints the 'not supplied' path
  txt2 <- cli::ansi_strip(capture.output(print(factorability(cor(sim16))), type = "message"))
  expect_true(any(grepl("not supplied", txt2)))
})

test_that(".kmo_band() maps values to Kaiser bands", {
  band <- ackwards:::.kmo_band
  expect_identical(band(0.95), "marvellous")
  expect_identical(band(0.85), "meritorious")
  expect_identical(band(0.75), "middling")
  expect_identical(band(0.65), "mediocre")
  expect_identical(band(0.55), "miserable")
  expect_identical(band(0.45), "unacceptable")
  expect_identical(band(NA_real_), "uncomputable")
})

# --- Internal screen wired into ackwards() -----------------------------------

test_that("ackwards() warns when k_max exceeds the Ledermann bound (EFA only, not PCA)", {
  R <- cor(sim16) # p = 16, Ledermann bound = 10

  rlang::reset_warning_verbosity("ackwards_ledermann")
  w <- suppressMessages(testthat::capture_warnings(
    ackwards(R, k_max = 13L, engine = "efa", n_obs = 1000L)
  ))
  expect_true(any(grepl("Ledermann bound", w)))
  expect_true(any(grepl("at most 10 common factor", w)))

  # PCA at the same k_max: components have no identification limit -> no warning
  rlang::reset_warning_verbosity("ackwards_ledermann")
  w_pca <- suppressMessages(testthat::capture_warnings(
    ackwards(R, k_max = 13L, engine = "pca", n_obs = 1000L)
  ))
  expect_false(any(grepl("Ledermann", w_pca)))
})

test_that("ackwards() does not warn about Ledermann when k_max is within the bound", {
  R <- cor(sim16)
  rlang::reset_warning_verbosity("ackwards_ledermann")
  w <- suppressMessages(testthat::capture_warnings(
    ackwards(R, k_max = 5L, engine = "efa", n_obs = 1000L)
  ))
  expect_false(any(grepl("Ledermann", w)))
})

test_that("ackwards() emits a consolidated adequacy warning below thresholds, silent when adequate", {
  set.seed(42)
  d <- as.data.frame(matrix(stats::rnorm(40 * 10), 40, 10)) # N:p = 4, N < 100
  names(d) <- paste0("v", seq_len(10))

  rlang::reset_warning_verbosity("ackwards_factorability")
  w <- suppressMessages(testthat::capture_warnings(
    ackwards(d, k_max = 3L, engine = "pca")
  ))
  expect_true(any(grepl("poorly suited to factor analysis", w)))
  expect_true(any(grepl("N:p", w)))

  # Well-powered, well-structured data: no adequacy warning
  rlang::reset_warning_verbosity("ackwards_factorability")
  w_ok <- suppressMessages(testthat::capture_warnings(
    ackwards(sim16, k_max = 4L, engine = "pca")
  ))
  expect_false(any(grepl("poorly suited", w_ok)))
})

test_that("the internal screen skips N-based checks for a correlation matrix without n_obs", {
  R <- cor(sim16)
  rlang::reset_warning_verbosity("ackwards_factorability")
  # PCA cor-matrix input, no n_obs -> n_obs_eff is NA; N:p / Bartlett skipped,
  # no error from the screen.
  expect_no_error(suppressMessages(ackwards(R, k_max = 3L, engine = "pca")))
})

# --- Coverage of input variants and print branches ---------------------------

test_that("factorability() accepts a raw numeric matrix and rejects bad input", {
  expect_s3_class(factorability(as.matrix(sim16)), "factorability")
  expect_error(factorability("not data"), "data frame or numeric matrix")
  d <- sim16
  d$chr <- "a" # character column -> non-numeric matrix
  expect_error(factorability(d), "only numeric columns")
})

test_that("factorability() computes on the polychoric basis", {
  skip_if_not_installed("psych")
  f <- factorability(bfi25[, 1:6], cor = "polychoric")
  expect_identical(f$cor, "polychoric")
  expect_false(is.na(f$kmo_overall))
  # matches a direct polychoric KMO
  R <- suppressWarnings(psych::polychoric(bfi25[, 1:6])$rho)
  expect_equal(f$kmo_overall, unname(psych::KMO(R)$MSA))
})

test_that("print.factorability() shows low-MSA items and a non-significant Bartlett", {
  set.seed(7)
  R <- cor(matrix(stats::rnorm(45 * 6), 45, 6)) # weak, small N
  colnames(R) <- rownames(R) <- paste0("v", 1:6)
  f <- factorability(R, n_obs = 45)
  # collapse to one string: cli may wrap a phrase across output lines
  txt <- paste(cli::ansi_strip(capture.output(print(f), type = "message")), collapse = " ")
  expect_match(txt, "MSA < .50", fixed = TRUE)
  expect_match(txt, "NOT significant", fixed = TRUE)
})

# --- Review follow-up: ESEM contract, polychoric screen, noise hygiene -------

test_that("ackwards() warns about the Ledermann bound for the ESEM engine too", {
  skip_if_not_installed("lavaan")
  # p = 6 -> Ledermann bound = 3; k_max = 4 requests an under-identified level.
  rlang::reset_warning_verbosity("ackwards_ledermann")
  w <- suppressMessages(testthat::capture_warnings(
    ackwards(sim16[, 1:6], k_max = 4L, engine = "esem")
  ))
  expect_true(any(grepl("Ledermann bound", w)))
  expect_true(any(grepl("engine = \"esem\"", w)))
})

test_that("the internal screen runs on a polychoric fit without error", {
  skip_if_not_installed("psych")
  rlang::reset_warning_verbosity("ackwards_factorability")
  # Exercises .factorability_screen() on the polychoric correlation matrix.
  expect_no_error(suppressMessages(suppressWarnings(
    ackwards(bfi25[, 1:6], k_max = 3L, engine = "efa", cor = "polychoric")
  )))
})

test_that("the internal screen does not leak psych's near-singular message", {
  R <- diag(4)
  R[1, 2] <- R[2, 1] <- 1 # singular
  rownames(R) <- colnames(R) <- paste0("V", 1:4)
  rlang::reset_warning_verbosity("ackwards_factorability")
  msgs <- suppressWarnings(
    capture.output(
      ackwards:::.factorability_screen(R, n_obs = 200L, p = 4L, k_max = 2L, engine = "pca"),
      type = "message"
    )
  )
  expect_false(any(grepl("not invertible", msgs)))
})