# Fast fixtures. `EFAtools::CD()` dominates suggest_k() cost (~8 s on the full # 2800x25 psych::bfi vs ~0.1 s for fa.parallel + vss combined) and scales hard # with both n_obs and n_vars. So the structural/logic/print/autoplot tests run # on a small subset of the bundled bfi25 (CD ~0.8 s), computed once and cached. # Nothing is mocked or skipped: PA, MAP, VSS, and CD all run for real on the # small fixture — only the data is smaller, which is sufficient to exercise the # wiring and table/print/plot logic. A single integration smoke (the # "expected fields" test) still runs the full 25-item psych::bfi instrument so # the realistic-scale path (incl. CD at 25 vars, n_obs = 2800) stays covered. .sk_small <- bfi25[, 1:8] # 1000 x 8; complete cases = 946 .get_sk <- local({ cache <- list() function(k_max, seed = 1L, n_iter = 5L) { key <- paste0("k", k_max, "s", seed) if (is.null(cache[[key]])) { cache[[key]] <<- suggest_k( .sk_small, k_max = k_max, n_iter = n_iter, seed = seed ) } cache[[key]] } }) test_that("suggest_k() returns a suggest_k object with expected fields", { skip_if_not_installed("psych") # Integration smoke on the full 25-item instrument: this is the one test that # asserts the realistic n_obs / n_vars and pays the full-data CD cost (~5 s). # The Likert items raise the (expected) ordinal-detection warning; it is # asserted in its own test below, so silence it here. sk <- suppressWarnings( suggest_k(psych::bfi[, 1:25], k_max = 3L, n_iter = 5L, seed = 1L) ) expect_s3_class(sk, "suggest_k") expect_named( sk, c( "k_parallel_pc", "k_parallel_fa", "k_map", "k_vss1", "k_vss2", "k_cd", "cd_available", "cd_rmse", "criteria", "criteria_requested", "k_max", "n_obs", "n_vars", "cor", "input_type" ) ) expect_equal(sk$k_max, 3L) expect_equal(sk$n_obs, 2800L) expect_equal(sk$n_vars, 25L) expect_equal(sk$cor, "pearson") expect_type(sk$cd_available, "logical") }) test_that("the six per-criterion k_* fields the suggest-k vignette reads stay available", { # The "When the criteria agree — and when they don't" section of # vignette("ackwards-suggest-k") computes a consensus range *inline* from these # six fields (sim16 vs bfi25). Renaming any of them would silently break the # vignette build rather than fail a test, so pin the contract here and mirror # the vignette's own range computation. skip_if_not_installed("psych") sk <- .get_sk(4L) ks <- c( sk$k_parallel_pc, sk$k_parallel_fa, sk$k_map, sk$k_vss1, sk$k_vss2, sk$k_cd ) expect_length(ks, 6L) # all six fields resolved (NULL would drop entries) finite_ks <- ks[!is.na(ks)] expect_gte(length(finite_ks), 1L) # at least the non-CD criteria yield a value expect_true(all(finite_ks >= 1L)) expect_true(is.finite(min(finite_ks)) && is.finite(max(finite_ks))) }) test_that("suggest_k() criteria table has correct structure and row count", { skip_if_not_installed("psych") sk <- .get_sk(4L) cr <- sk$criteria expect_s3_class(cr, "data.frame") expect_equal(nrow(cr), 4L) expect_named( cr, c( "k", "ev_obs", "ev_obs_fa", "pa_pc_quant", "pa_pc_suggested", "pa_fa_quant", "pa_fa_suggested", "map", "vss1", "vss2" ) ) expect_equal(cr$k, 1:4) expect_type(cr$ev_obs, "double") expect_type(cr$ev_obs_fa, "double") expect_type(cr$pa_pc_quant, "double") expect_type(cr$pa_fa_quant, "double") expect_type(cr$pa_pc_suggested, "logical") expect_type(cr$pa_fa_suggested, "logical") expect_type(cr$map, "double") expect_type(cr$vss1, "double") expect_type(cr$vss2, "double") }) test_that("suggest_k() FA eigenvalues are smaller than PC eigenvalues", { # Factor-analysis eigenvalues (communalities removed) are always < PC eigs. skip_if_not_installed("psych") sk <- .get_sk(4L) expect_true(all(sk$criteria$ev_obs_fa <= sk$criteria$ev_obs)) }) test_that("suggest_k() MAP optimal is the row minimising map", { skip_if_not_installed("psych") sk <- .get_sk(4L) expect_gte(sk$k_map, 1L) expect_lte(sk$k_map, 4L) expect_equal(sk$k_map, which.min(sk$criteria$map)) }) test_that("suggest_k() VSS optima match which.max of vss columns", { skip_if_not_installed("psych") sk <- .get_sk(4L) expect_equal(sk$k_vss1, which.max(sk$criteria$vss1)) expect_equal(sk$k_vss2, which.max(sk$criteria$vss2)) }) test_that("suggest_k() PA-PC is capped at k_max; k_parallel_fa is integer or NA", { skip_if_not_installed("psych") # The clamp `min(raw_pa, k_max)` is only exercised when raw PA exceeds k_max. # On bfi25[, 1:15] PA-PC suggests ~3 components, so k_max = 2 forces the clamp. sk <- suggest_k(bfi25[, 1:15], k_max = 2L, n_iter = 5L, seed = 1L) expect_lte(sk$k_parallel_pc, 2L) expect_gte(sk$k_parallel_pc, 1L) # PA-FA is either NA (undetermined) or a valid integer in [1, k_max] if (!is.na(sk$k_parallel_fa)) { expect_gte(sk$k_parallel_fa, 1L) expect_lte(sk$k_parallel_fa, 2L) } }) test_that("suggest_k() pa_pc_suggested matches k_parallel_pc boundary", { skip_if_not_installed("psych") sk <- .get_sk(4L) cr <- sk$criteria expect_equal(cr$pa_pc_suggested, cr$k <= sk$k_parallel_pc) }) test_that("suggest_k() pa_fa_suggested is all FALSE when k_parallel_fa is NA", { skip_if_not_installed("psych") # Construct a minimal suggest_k object with k_parallel_fa = NA to verify # the criteria table logic — build one real call and then patch the field. sk <- .get_sk(4L) sk_na <- sk sk_na$k_parallel_fa <- NA_integer_ sk_na$criteria$pa_fa_suggested <- rep(FALSE, 4L) expect_true(all(!sk_na$criteria$pa_fa_suggested)) }) test_that("suggest_k() deterministic criteria are identical across calls", { skip_if_not_installed("psych") # Two independent calls with the same seed — intentionally NOT cached so # reproducibility is actually exercised (not just comparing an object to itself). sk1 <- suggest_k(.sk_small, k_max = 4, n_iter = 3, seed = 99L) sk2 <- suggest_k(.sk_small, k_max = 4, n_iter = 3, seed = 99L) # MAP, VSS, and observed eigenvalues are computed from the correlation # matrix and are fully deterministic regardless of seed. expect_equal(sk1$criteria$ev_obs, sk2$criteria$ev_obs) expect_equal(sk1$criteria$ev_obs_fa, sk2$criteria$ev_obs_fa) expect_equal(sk1$criteria$map, sk2$criteria$map) expect_equal(sk1$criteria$vss1, sk2$criteria$vss1) expect_equal(sk1$criteria$vss2, sk2$criteria$vss2) }) test_that("suggest_k() errors on bad inputs", { skip_if_not_installed("psych") expect_error(suggest_k(list()), "data frame") expect_error(suggest_k(bfi25[, 1:5], k_max = 100), "k_max") expect_error(suggest_k(bfi25[, 1:5], k_max = 0), "k_max") # n_iter drives the PA simulation; 0/fractional/vector values fail deep # inside psych without this guard (M42/m8) expect_error(suggest_k(bfi25[, 1:5], n_iter = 0), "positive integer") expect_error(suggest_k(bfi25[, 1:5], n_iter = 2.5), "positive integer") expect_error(suggest_k(bfi25[, 1:5], n_iter = c(5, 10)), "positive integer") }) test_that("print.suggest_k() reports an undetermined consensus without Inf (M42/m1)", { # Constructed object: the only requested criterion (PA-FA) is NA, so the # consensus pool is empty. Pre-M42 this warned ("no non-missing arguments # to min") and printed an Inf range. sk <- structure( list( k_parallel_pc = NA_integer_, k_parallel_fa = NA_integer_, k_map = NA_integer_, k_vss1 = NA_integer_, k_vss2 = NA_integer_, k_cd = NA_integer_, cd_available = FALSE, cd_rmse = NULL, criteria = data.frame( k = 1:3, ev_obs = NA_real_, ev_obs_fa = NA_real_, pa_pc_quant = NA_real_, pa_pc_suggested = NA, pa_fa_quant = NA_real_, pa_fa_suggested = FALSE, map = NA_real_, vss1 = NA_real_, vss2 = NA_real_ ), criteria_requested = "pa_fa", k_max = 3L, n_obs = 100L, n_vars = 10L, cor = "pearson", input_type = "data" ), class = "suggest_k" ) # cli output lands on the message stream under testthat; capture both. expect_no_warning( out <- capture.output(print(sk), type = "message") ) expect_true(any(grepl("undetermined", out))) expect_false(any(grepl("Inf", out))) }) test_that("suggest_k() warns on ordinal raw data, pointing at ackwards() (M50)", { skip_if_not_installed("psych") # Invariant-6 symmetry with ackwards()/comparability(): Likert items are # flagged, but the advice points at the final ackwards() fit because # suggest_k() screens on the Pearson/Spearman basis by design. rlang::reset_warning_verbosity("suggest_k_ordinal_warning") expect_warning(suggest_k(.sk_small, criteria = "map"), "ordinal") rlang::reset_warning_verbosity("suggest_k_ordinal_warning") w <- tryCatch( suggest_k(.sk_small, criteria = "map"), warning = conditionMessage ) expect_match(w, "polychoric") expect_match(w, "ackwards") # The warning fires on the Spearman basis too, naming the active basis (the # wording interpolates {cor}), since Spearman is likewise a screening basis. rlang::reset_warning_verbosity("suggest_k_ordinal_warning") w_sp <- tryCatch( suggest_k(.sk_small, cor = "spearman", criteria = "map"), warning = conditionMessage ) expect_match(w_sp, "ordinal") expect_match(w_sp, "spearman") }) test_that("suggest_k() does not raise the ordinal warning on continuous or matrix input (M50)", { skip_if_not_installed("psych") rlang::reset_warning_verbosity("suggest_k_ordinal_warning") expect_no_warning( suggest_k(sim16[, 1:8], criteria = "map"), message = "ordinal" ) # A correlation matrix carries no items to inspect -> detection never runs. rlang::reset_warning_verbosity("suggest_k_ordinal_warning") R <- stats::cor(sim16[, 1:8]) expect_no_warning( suggest_k(R, n_obs = 1000L, criteria = "map"), message = "ordinal" ) }) test_that("suggest_k() announces PA suggestions capped at k_max (M42/m2)", { skip_if_not_installed("psych") # sim16 has 4 planted factors; PA reliably suggests ~4, above k_max = 2. expect_message( suppressWarnings(sk <- suggest_k( sim16, k_max = 2, criteria = c("pa_pc", "pa_fa"), n_iter = 5L, seed = 1L )), "above the evaluated ceiling" ) # Stored recommendation stays capped (stable criteria-table schema). expect_lte(sk$k_parallel_pc, 2L) }) test_that("suggest_k() defaults k_max to min(p - 1, 8) for raw data", { skip_if_not_installed("psych") # No k_max supplied: the raw-data path sets k_max <- min(p - 1, 8). With p = 6 # vars that is 5. suppressWarnings swallows the incidental CD n_factors_max # notice (CD caps at 2 factors for 6 vars). sk <- suppressWarnings(suggest_k(bfi25[, 1:6], n_iter = 3L, seed = 1L)) expect_equal(sk$k_max, 5L) }) test_that("suggest_k() k_cd is NA and cd_rmse is NULL when EFAtools is unavailable", { skip_if_not_installed("psych") # Force the EFAtools availability check to report it missing, so this absence # branch runs regardless of whether EFAtools is actually installed (mirrors the # future.apply pattern in test-esem.R). Call suggest_k() directly rather than # via the memoised .get_sk() so the mocked-absence result never shares a cache # key with the EFAtools-present tests. testthat::local_mocked_bindings( is_installed = function(pkg, ...) if (identical(pkg, "EFAtools")) FALSE else TRUE, .package = "rlang" ) sk <- suggest_k(.sk_small, k_max = 4L, n_iter = 3L, seed = 1L) expect_false(sk$cd_available) expect_identical(sk$k_cd, NA_integer_) expect_null(sk$cd_rmse) }) test_that("suggest_k() k_cd and cd_rmse populated when EFAtools is installed", { skip_if_not_installed("psych") skip_if_not_installed("EFAtools") sk <- .get_sk(4L) expect_true(sk$cd_available) expect_false(is.na(sk$k_cd)) expect_gte(sk$k_cd, 1L) expect_lte(sk$k_cd, 4L) # cd_rmse: length-k_max numeric vector of mean RMSE values expect_false(is.null(sk$cd_rmse)) expect_length(sk$cd_rmse, 4L) expect_true(is.numeric(sk$cd_rmse)) }) test_that("suggest_k() CD degrades gracefully on EFAtools error", { skip_if_not_installed("psych") skip_if_not_installed("EFAtools") # Trigger a CD error by passing a corrupt matrix that EFAtools::CD rejects. # The function should not propagate an unhandled error; it returns # cd_available = FALSE with k_cd = NA (degraded gracefully). bad_mat <- matrix(1:4, nrow = 2) storage.mode(bad_mat) <- "double" sk <- suppressWarnings(tryCatch( suggest_k(bad_mat, k_max = 1L, n_iter = 3, seed = 1L), error = function(e) NULL )) # Result is either NULL (PA/VSS also failed on degenerate input) or a # suggest_k with cd_available = FALSE (CD degraded, rest succeeded). # Either way the function must not propagate an unhandled error. if (is.null(sk)) { expect_null(sk) # degenerate input caused full failure — acceptable } else { expect_false(sk$cd_available) expect_identical(sk$k_cd, NA_integer_) } }) test_that("suggest_k() handles data with missing values for PA/MAP/VSS", { skip_if_not_installed("psych") # bfi25 has NA values; pairwise deletion should allow PA/MAP/VSS to run. sk <- suggest_k(bfi25[, 1:10], k_max = 3, n_iter = 3, seed = 1L) expect_s3_class(sk, "suggest_k") expect_equal(sk$n_vars, 10L) }) test_that("print.suggest_k() runs without error and returns x invisibly", { skip_if_not_installed("psych") sk <- .get_sk(4L) expect_no_error(print(sk)) expect_invisible(print(sk)) }) test_that("print.suggest_k() draws the tick in text (width-1) presentation", { # The retention tick is cli's U+2714, which many terminals render as a # width-2 emoji while every width metric counts it as 1 -- so the aligned # criteria table drifts one cell right after each tick. The fix appends # U+FE0E (VARIATION SELECTOR-15) to request the narrow text glyph. Guard the # output: every tick carries the selector, none stands bare. old_opts <- options(cli.unicode = TRUE, cli.num_colors = 1L) on.exit(options(old_opts), add = TRUE) sk <- structure( list( k_parallel_pc = 2L, k_parallel_fa = NA_integer_, k_map = NA_integer_, k_vss1 = NA_integer_, k_vss2 = NA_integer_, k_cd = NA_integer_, cd_available = FALSE, cd_rmse = NULL, criteria = data.frame( k = 1:3, pa_pc_suggested = c(TRUE, TRUE, FALSE) ), criteria_requested = "pa_pc", k_max = 3L, n_obs = 100L, n_vars = 10L, cor = "pearson", input_type = "data" ), class = "suggest_k" ) out <- paste(capture.output(print(sk), type = "message"), collapse = "\n") skip_if_not(grepl("✔", out), "terminal has no unicode tick to test") # A tick immediately followed by the text-presentation selector appears... expect_match(out, "✔︎") # ...and no tick appears without it. expect_no_match(out, "✔(?!︎)", perl = TRUE) }) test_that("print.suggest_k() does not error when k_parallel_fa is NA", { skip_if_not_installed("psych") sk <- .get_sk(4L) # Patch to simulate the NA PA-FA case (no FA factor exceeded random threshold). sk$k_parallel_fa <- NA_integer_ sk$criteria$pa_fa_suggested <- rep(FALSE, 4L) # Must run without error and return invisibly; no "k <= 0" / "k <= NA" trap. expect_no_error(print(sk)) expect_invisible(print(sk)) }) test_that("suggest_k() consensus excludes NA k_parallel_fa", { skip_if_not_installed("psych") # When k_parallel_fa = NA the consensus range uses only the remaining criteria. sk <- .get_sk(4L) sk$k_parallel_fa <- NA_integer_ all_k <- stats::na.omit( c(sk$k_parallel_pc, sk$k_parallel_fa, sk$k_map, sk$k_vss1, sk$k_vss2) ) expect_gte(min(all_k), 1L) }) test_that("autoplot.suggest_k() renders 3 panels in single column when CD absent", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") sk <- .get_sk(4L) sk$cd_available <- FALSE sk$cd_rmse <- NULL p <- autoplot(sk) expect_s3_class(p, "gg") panel_vals <- levels(p$data$panel) expect_equal( panel_vals, c("Scree / Parallel Analysis", "MAP (minimize)", "VSS (maximize)") ) }) test_that("autoplot.suggest_k() renders 4-panel 2x2 grid when CD available", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") skip_if_not_installed("EFAtools") sk <- .get_sk(4L) # Ensure cd_rmse is populated (real CD run) expect_true(sk$cd_available) expect_false(is.null(sk$cd_rmse)) expect_length(sk$cd_rmse, 4L) p <- autoplot(sk) expect_s3_class(p, "gg") panel_vals <- levels(p$data$panel) expect_equal( panel_vals, c( "Scree / Parallel Analysis", "MAP (minimize)", "VSS (maximize)", "CD (RMSE; sequential test)" ) ) # CD star marked at k_cd cd_rows <- p$data[p$data$series == "CD (RMSE)" & p$data$is_opt, ] expect_equal(nrow(cd_rows), 1L) expect_equal(cd_rows$k, sk$k_cd) # No NA rows in plot data (NAs filtered before building frame) cd_plot_rows <- p$data[p$data$series == "CD (RMSE)", ] expect_false(anyNA(cd_plot_rows$value)) }) test_that("cd_rmse has no spurious zeros: trailing columns masked to NA", { skip_if_not_installed("psych") skip_if_not_installed("EFAtools") # Use k_max large enough to guarantee unfilled columns exist when k_cd < k_max sk <- suggest_k(bfi25, k_max = 8L, seed = 1L) skip_if(!sk$cd_available) expect_length(sk$cd_rmse, 8L) # No zeros beyond the computed range (k_cd + 1) expect_false(any(sk$cd_rmse == 0, na.rm = TRUE)) # Tail beyond k_cd + 1 is NA (when k_cd < k_max - 1) n_computed <- min(sk$k_cd + 1L, 8L) if (n_computed < 8L) { expect_true(all(is.na(sk$cd_rmse[(n_computed + 1L):8L]))) } # which.min over non-NA values is at a genuinely computed level expect_lte(which.min(sk$cd_rmse), n_computed) }) test_that("autoplot.suggest_k() stars k_cd even when the RMSE minimum is elsewhere", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") skip_if_not_installed("EFAtools") sk <- .get_sk(4L) skip_if(!sk$cd_available) # CD's sequential test can stop before the curve's visible minimum (RMSE keeps # falling, but not *significantly*). Force that divergence: pick k_cd = 2 while # the smallest RMSE sits at k = 3. The star must follow k_cd, not which.min. sk$k_cd <- 2L sk$cd_rmse <- c(0.4, 0.3, 0.1, NA_real_) expect_equal(which.min(sk$cd_rmse), 3L) # guard the fixture's premise p <- autoplot(sk) cd_opt <- p$data[p$data$series == "CD (RMSE)" & p$data$is_opt, ] expect_equal(nrow(cd_opt), 1L) expect_equal(cd_opt$k, 2L) # star at k_cd, not the minimum (k = 3) cd_min_row <- p$data[p$data$series == "CD (RMSE)" & p$data$k == 3L, ] expect_false(cd_min_row$is_opt) }) test_that("autoplot.suggest_k() scree panel has four series", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") sk <- .get_sk(4L) p <- autoplot(sk) scree_series <- unique( as.character(p$data$series[p$data$panel == "Scree / Parallel Analysis"]) ) expect_setequal( scree_series, c("Observed (PC)", "PA-PC (95th pct)", "Observed (FA)", "PA-FA (95th pct)") ) }) test_that("autoplot.suggest_k() marks optimal k with star points", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") sk <- .get_sk(4L) p <- autoplot(sk) opt_rows <- p$data[p$data$is_opt, ] # At minimum: one PC scree + one MAP + at least one VSS expect_gte(nrow(opt_rows), 3L) }) test_that("autoplot.suggest_k() handles k_parallel_fa = NA without error", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") sk <- .get_sk(4L) sk$k_parallel_fa <- NA_integer_ sk$criteria$pa_fa_suggested <- rep(FALSE, 4L) sk$cd_available <- FALSE sk$cd_rmse <- NULL # FA star must be omitted; the plot must still build with 3 panels (CD absent). expect_no_error({ p <- autoplot(sk) }) expect_s3_class(p, "gg") expect_equal( levels(p$data$panel), c("Scree / Parallel Analysis", "MAP (minimize)", "VSS (maximize)") ) }) test_that("autoplot.suggest_k() handles cd_available = FALSE without error", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") sk <- .get_sk(4L) sk$cd_available <- FALSE sk$cd_rmse <- NULL sk$k_cd <- NA_integer_ # CD panel must be absent; plot must still build with 3 panels. expect_no_error({ p <- autoplot(sk) }) expect_s3_class(p, "gg") expect_false("CD (RMSE, minimize)" %in% levels(p$data$panel)) }) test_that("print.suggest_k() runs without error when cd_available = FALSE", { skip_if_not_installed("psych") sk <- .get_sk(4L) sk$cd_available <- FALSE sk$k_cd <- NA_integer_ # Must print the "CD requires EFAtools" note, not error, and return invisibly. expect_no_error(print(sk)) expect_invisible(print(sk)) }) # ---- Branches added for M23 coverage hardening ------------------------------- test_that("suggest_k() R-matrix + explicit cor warns it is ignored", { skip_if_not_installed("psych") R <- cor(bfi25[, 1:6], use = "pairwise.complete.obs") # 'cor' arg is explicitly set (not "pearson") alongside an R-matrix: warn expect_warning( suppressMessages(suggest_k(R, n_obs = 875L, n_iter = 3L, cor = "spearman")), "cor.*ignored" ) }) test_that("suggest_k() R-matrix: k_max >= p errors with helpful message", { skip_if_not_installed("psych") R <- cor(bfi25[, 1:6], use = "pairwise.complete.obs") # p = 6 expect_error( suppressMessages(suggest_k(R, n_obs = 875L, k_max = 6L, n_iter = 3L)), "k_max" ) }) test_that("suggest_k() errors on non-numeric (character) data", { d <- data.frame(x = c("a", "b", "c"), y = c("d", "e", "f")) expect_error(suggest_k(d, k_max = 1L), "numeric") }) test_that("suggest_k() warns when cor = 'spearman' and CD is available", { skip_if_not_installed("psych") skip_if_not_installed("EFAtools") # k_max = 2 stays within CD's extractable-factor limit for 6 vars, so the # only warning raised is the spearman -> Pearson one under test. expect_warning( suggest_k(bfi25[, 1:6], k_max = 2L, cor = "spearman", n_iter = 3L, seed = 1L), "Pearson" ) }) test_that("print.suggest_k() renders CD dash symbol when i > k_cd", { skip_if_not_installed("psych") sk <- .get_sk(4L) # Force k_cd to 1 so that the later rows hit the 'else' (dash) branch sk$cd_available <- TRUE sk$k_cd <- 1L # Must print without error (rows 2+ produce the dash branch at print.R line 418) expect_no_error(print(sk)) expect_invisible(print(sk)) }) test_that("print.suggest_k() shows single-value consensus when all criteria agree", { skip_if_not_installed("psych") sk <- .get_sk(4L) # Patch every criterion to the same k so lo == hi: this hits the degenerate # "Consensus: k = {lo}" branch (rather than the usual "Consensus range"). sk$k_parallel_pc <- 2L sk$k_parallel_fa <- 2L sk$k_map <- 2L sk$k_vss1 <- 2L sk$k_vss2 <- 2L sk$cd_available <- FALSE sk$k_cd <- NA_integer_ # cli output is not reliably captured by expect_output (see other print tests); # the patched lo == hi still drives the single-value consensus branch. expect_no_error(print(sk)) expect_invisible(print(sk)) }) # ---- Tests for the criteria= argument (Wave 1 / M25) ------------------------- test_that("suggest_k() criteria='map' skips PA and CD, populates only MAP", { skip_if_not_installed("psych") sk <- suggest_k(.sk_small, k_max = 4L, criteria = "map", n_iter = 5L) expect_equal(sk$criteria_requested, "map") # PA fields must be NA (not run) expect_identical(sk$k_parallel_pc, NA_integer_) expect_identical(sk$k_parallel_fa, NA_integer_) expect_true(all(is.na(sk$criteria$ev_obs))) expect_true(all(is.na(sk$criteria$pa_pc_quant))) # MAP must be populated expect_false(is.na(sk$k_map)) expect_equal(sk$k_map, which.min(sk$criteria$map)) # VSS must be NA expect_identical(sk$k_vss1, NA_integer_) expect_identical(sk$k_vss2, NA_integer_) expect_true(all(is.na(sk$criteria$vss1))) # CD must be NA expect_false(sk$cd_available) expect_identical(sk$k_cd, NA_integer_) }) test_that("suggest_k() criteria=c('pa_pc','pa_fa') skips vss() and CD", { skip_if_not_installed("psych") sk <- suggest_k(.sk_small, k_max = 4L, criteria = c("pa_pc", "pa_fa"), n_iter = 5L ) expect_equal(sk$criteria_requested, c("pa_pc", "pa_fa")) # PA fields must be populated expect_false(is.na(sk$k_parallel_pc)) expect_true(all(!is.na(sk$criteria$ev_obs))) # MAP and VSS must be NA (not run) expect_identical(sk$k_map, NA_integer_) expect_true(all(is.na(sk$criteria$map))) expect_identical(sk$k_vss1, NA_integer_) expect_true(all(is.na(sk$criteria$vss1))) # CD must be NA expect_false(sk$cd_available) }) test_that("suggest_k() default criteria matches all-five structure", { skip_if_not_installed("psych") sk <- .get_sk(4L) # Default should request all five criteria expect_setequal(sk$criteria_requested, c("pa_pc", "pa_fa", "map", "vss", "cd")) # All standard k_* fields non-NA (except k_parallel_fa and k_cd which may be NA) expect_false(is.na(sk$k_parallel_pc)) expect_false(is.na(sk$k_map)) expect_false(is.na(sk$k_vss1)) expect_false(is.na(sk$k_vss2)) }) test_that("suggest_k() criteria='cd' with EFAtools unavailable emits info and returns NA", { skip_if_not_installed("psych") # Mock EFAtools as missing (see the note on the first absence test above) so the # graceful-degradation branch runs even when EFAtools is installed. testthat::local_mocked_bindings( is_installed = function(pkg, ...) if (identical(pkg, "EFAtools")) FALSE else TRUE, .package = "rlang" ) # When 'cd' requested but EFAtools absent, should inform (not error) and return NA expect_message( sk <- suggest_k(.sk_small, k_max = 3L, criteria = "cd", n_iter = 3L), "EFAtools" ) expect_false(sk$cd_available) expect_identical(sk$k_cd, NA_integer_) # All non-CD k_* fields are NA (only CD was requested) expect_identical(sk$k_parallel_pc, NA_integer_) expect_identical(sk$k_map, NA_integer_) }) test_that("suggest_k() criteria='cd' with EFAtools available runs CD only", { skip_if_not_installed("psych") skip_if_not_installed("EFAtools") sk <- suggest_k(.sk_small, k_max = 4L, criteria = "cd", n_iter = 3L, seed = 1L) expect_equal(sk$criteria_requested, "cd") expect_true(sk$cd_available) expect_false(is.na(sk$k_cd)) # All non-CD k_* fields are NA expect_identical(sk$k_parallel_pc, NA_integer_) expect_identical(sk$k_map, NA_integer_) expect_identical(sk$k_vss1, NA_integer_) }) test_that("suggest_k() invalid criterion name errors via arg_match", { skip_if_not_installed("psych") expect_error( suggest_k(.sk_small, k_max = 3L, criteria = "bad_criterion"), "must be one of" ) }) test_that("suggest_k() criteria='vss' consensus reflects VSS-1 and VSS-2 only", { skip_if_not_installed("psych") sk <- suggest_k(.sk_small, k_max = 4L, criteria = "vss", n_iter = 3L) expect_equal(sk$criteria_requested, "vss") expect_false(is.na(sk$k_vss1)) expect_false(is.na(sk$k_vss2)) # Consensus range must be within VSS-1/VSS-2 bounds lo <- min(sk$k_vss1, sk$k_vss2) hi <- max(sk$k_vss1, sk$k_vss2) expect_gte(lo, 1L) expect_lte(hi, 4L) # print must run without error and consensus must reflect VSS only expect_no_error(print(sk)) }) test_that("autoplot.suggest_k() shows only MAP panel when criteria='map'", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") sk <- suggest_k(.sk_small, k_max = 4L, criteria = "map", n_iter = 3L) p <- autoplot(sk) expect_s3_class(p, "gg") expect_equal(levels(p$data$panel), "MAP (minimize)") }) test_that("autoplot.suggest_k() shows only PA panel when criteria=c('pa_pc','pa_fa')", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") sk <- suggest_k(.sk_small, k_max = 4L, criteria = c("pa_pc", "pa_fa"), n_iter = 3L ) p <- autoplot(sk) expect_s3_class(p, "gg") expect_equal(levels(p$data$panel), "Scree / Parallel Analysis") # Both PC and FA series present series_vals <- unique(as.character(p$data$series)) expect_true("Observed (PC)" %in% series_vals) expect_true("Observed (FA)" %in% series_vals) }) test_that("autoplot.suggest_k() shows only PA-PC series when criteria='pa_pc'", { skip_if_not_installed("psych") skip_if_not_installed("ggplot2") sk <- suggest_k(.sk_small, k_max = 4L, criteria = "pa_pc", n_iter = 3L) p <- autoplot(sk) expect_s3_class(p, "gg") series_vals <- unique(as.character(p$data$series)) expect_true("Observed (PC)" %in% series_vals) expect_false("Observed (FA)" %in% series_vals) })