fix(factanal): retry polychoric with correct=0 before Pearson fallback

Same sparse-table psych failure as Cronbach's Alpha: keep the requested
polychoric/tetrachoric/mixed estimate when continuity correction 0 works,
instead of degrading straight to Pearson.

Co-authored-by: Cursor <cursoragent@cursor.com>

Author: hidekoji

R/factanal_correlation.R

@@ -432,23 +432,44 @@ build_factor_correlation <- function(data, correlation_type = c("pearson", "poly
                 type = "pearson", smoothed = FALSE, warnings = character(), failed = FALSE))
   }
 
+  # psych::polychoric / tetrachoric / mixedCor can fail on sparse contingency tables when the
+  # continuity correction (default correct=0.5) produces empty pairwise results. psych itself
+  # suggests retrying with correct=0; without that retry we used to degrade straight to Pearson
+  # even though the polychoric-family estimate was recoverable (same root cause as the
+  # Cronbach's Alpha fix).
   captured <- character()
-  result <- withCallingHandlers(
-    tryCatch({
-      switch(correlation_type,
-        polychoric = psych::polychoric(data, correct = correct),
-        tetrachoric = psych::tetrachoric(data, correct = correct),
-        mixed = psych::mixedCor(data))
-    }, error = function(e) {
-      captured <<- c(captured, conditionMessage(e))
-      NULL
-    }),
-    warning = function(w) {
-      captured <<- c(captured, conditionMessage(w))
-      invokeRestart("muffleWarning")
-    })
-
-  if (is.null(result) || is.null(result$rho) || anyNA(result$rho)) {
+  run_psych_correlation <- function(corr) {
+    withCallingHandlers(
+      tryCatch({
+        switch(correlation_type,
+          polychoric = psych::polychoric(data, correct = corr),
+          tetrachoric = psych::tetrachoric(data, correct = corr),
+          mixed = psych::mixedCor(data, correct = corr))
+      }, error = function(e) {
+        captured <<- c(captured, conditionMessage(e))
+        NULL
+      }),
+      warning = function(w) {
+        captured <<- c(captured, conditionMessage(w))
+        invokeRestart("muffleWarning")
+      })
+  }
+  correlation_ok <- function(obj) {
+    !is.null(obj) && !is.null(obj$rho) && !anyNA(obj$rho)
+  }
+
+  result <- run_psych_correlation(correct)
+  if (!correlation_ok(result) && correct != 0) {
+    result <- run_psych_correlation(0)
+    if (correlation_ok(result)) {
+      captured <- c(
+        captured,
+        sprintf("%s used continuity correction of 0 because the default correction failed.",
+                factanal_correlation_label(correlation_type)))
+    }
+  }
+
+  if (!correlation_ok(result)) {
     # Degrade to Pearson rather than aborting the whole analysis. A partially-NA matrix counts as a
     # failure too: psych::fa() refuses to run on one ("missing values (NAs) in the correlation
     # matrix do not allow me to continue"), so keeping it would abort with a raw psych error.

tests/testthat/test_factanal_correlation.R

@@ -507,6 +507,33 @@ test_that("verification pass 4 findings (issue #26623)", {
   expect_equal(zero_diagnostics$Judgement[[2]], "Detected in 1 variable")
 })
 
+test_that("build_factor_correlation retries with correct=0 before degrading", {
+  # Same sparse contingency pattern that makes psych::polychoric(correct=0.5) throw
+  # "attempt to set 'rownames' on an object with no dimensions", while correct=0 succeeds.
+  set.seed(1)
+  df <- data.frame(lapply(1:8, function(i) as.integer(sample(1:5, 12, replace = TRUE))))
+  names(df) <- paste0("q", 1:8)
+
+  expect_true(inherits(
+    suppressWarnings(tryCatch(psych::polychoric(df, correct = 0.5), error = function(e) e)),
+    "error"))
+  expect_false(inherits(
+    suppressWarnings(tryCatch(psych::polychoric(df, correct = 0), error = function(e) e)),
+    "error"))
+
+  result <- build_factor_correlation(df, "polychoric")
+  expect_equal(result$type, "polychoric")
+  expect_false(result$failed)
+  expect_equal(dim(result$correlation), c(8L, 8L))
+  expect_true(any(grepl("continuity correction of 0", result$warnings)))
+
+  # End-to-end: exp_factanal must keep polychoric rather than degrade to Pearson.
+  fit <- exp_factanal(df, q1, q2, q3, q4, q5, q6, q7, q8, nfactors = 2, rotate = "varimax",
+                      cor_type = "polychoric", parallel_n_iter = 3)$model[[1]]
+  expect_equal(fit$correlation_type, "polychoric")
+  expect_equal(fit$correlation_degraded_from, "")
+})
+
 test_that("a failed estimation degrades to Pearson end to end (issue #26623)", {
   # The degrade path mutates `resolved` after construction and re-points the diagnostics and the
   # parallel analysis; exercise it through exp_factanal, not just the helper.