test_that("top_items returns correct S3 class and structure", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) out <- top_items(x) expect_s3_class(out, "top_items") expect_named(out, c( "data", "levels_shown", "cut", "n", "sort", "by", "item_labels", "factor_labels", "engine", "k_max" )) expect_true(is.data.frame(out$data)) # No labels on this fixture -> no label column, default grouping is by factor expect_named(out$data, c("level", "factor", "item", "loading")) expect_identical(out$by, "factor") expect_null(out$item_labels) expect_null(out$factor_labels) }) test_that("top_items cut filters correctly", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) out <- top_items(x, cut = 0.3) expect_true(all(abs(out$data$loading) >= 0.3)) out_high <- top_items(x, cut = 0.99) expect_equal(nrow(out_high$data), 0L) out_zero <- top_items(x, cut = 0.0) # With cut = 0 we should get all items across all factors (may duplicate items # that load on multiple factors) expect_true(nrow(out_zero$data) > 0L) }) test_that("top_items level argument subsets levels", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) out1 <- top_items(x, level = 1) expect_equal(unique(out1$data$level), 1L) expect_equal(out1$levels_shown, 1L) out23 <- top_items(x, level = c(2, 3)) expect_setequal(unique(out23$data$level), c(2L, 3L)) }) test_that("top_items errors on invalid level", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) expect_error(top_items(x, level = 99), class = "rlang_error") }) test_that("top_items n caps items per factor", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) out <- top_items(x, cut = 0, n = 2) counts <- tapply(out$data$item, out$data$factor, length) expect_true(all(counts <= 2L)) }) test_that("top_items sort = FALSE preserves item order", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 2, engine = "pca")) out_unsorted <- top_items(x, cut = 0, sort = FALSE) full_loadings <- tidy(x, what = "loadings") for (lev in unique(out_unsorted$data$level)) { for (fac in unique(out_unsorted$data$factor[out_unsorted$data$level == lev])) { items_unsorted <- out_unsorted$data$item[ out_unsorted$data$level == lev & out_unsorted$data$factor == fac ] # tidy() preserves loading-matrix row order; unsorted must match that order items_tidy_order <- full_loadings$item[ full_loadings$level == lev & full_loadings$factor == fac ] expected_order <- items_tidy_order[items_tidy_order %in% items_unsorted] expect_identical(items_unsorted, expected_order) } } }) test_that("top_items works with engine = 'efa'", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "efa")) out <- top_items(x) expect_s3_class(out, "top_items") expect_identical(out$engine, "efa") # Filtering and structure work identically to PCA expect_true(all(abs(out$data$loading) >= 0.3)) expect_named(out$data, c("level", "factor", "item", "loading")) }) test_that("top_items data matches tidy(what = 'loadings')", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) full_loadings <- tidy(x, what = "loadings") out <- top_items(x, cut = 0, sort = FALSE) # Every row in top_items$data should match a row in tidy loadings for (i in seq_len(nrow(out$data))) { row <- out$data[i, ] match_row <- full_loadings[ full_loadings$level == row$level & full_loadings$factor == row$factor & full_loadings$item == row$item, , drop = FALSE ] expect_equal(nrow(match_row), 1L) expect_equal(row$loading, match_row$loading, tolerance = 1e-10) } }) test_that("top_items errors on non-ackwards input", { expect_error(top_items(list()), class = "rlang_error") expect_error(top_items("string"), class = "rlang_error") }) test_that("top_items errors on bad cut/n/sort", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 2, engine = "pca")) expect_error(top_items(x, cut = -0.1), class = "rlang_error") expect_error(top_items(x, cut = 1.5), class = "rlang_error") expect_error(top_items(x, n = 0), class = "rlang_error") expect_error(top_items(x, sort = "yes"), class = "rlang_error") }) # ── by = "item" grouping + variable labels (M36) ────────────────────────────── test_that("top_items(by = 'item') keeps the same rows but inverts grouping", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) by_fac <- top_items(x, level = 3, cut = 0.25) by_item <- top_items(x, level = 3, cut = 0.25, by = "item") expect_identical(by_item$by, "item") # Same underlying (level, factor, item, loading) set, just reordered key <- function(d) { paste(d$level, d$factor, d$item, round(d$loading, 8)) } expect_setequal(key(by_fac$data), key(by_item$data)) }) test_that("top_items(by = 'item', n = ) caps factors per item", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) out <- top_items(x, cut = 0, n = 2, by = "item") counts <- tapply(out$data$factor, list(out$data$level, out$data$item), length) expect_true(all(counts[!is.na(counts)] <= 2L)) }) test_that("top_items exposes captured variable labels", { skip_if_not_installed("psych") set.seed(1) d <- .make_esem_data() attr(d$x1, "label") <- "First indicator" attr(d$x4, "label") <- "Fourth indicator" x <- cached(ackwards(d, k_max = 3, engine = "pca")) out <- top_items(x, cut = 0) expect_true("label" %in% names(out$data)) expect_identical(out$item_labels, c(x1 = "First indicator", x4 = "Fourth indicator")) # Labelled items carry their text; unlabelled ones are NA in the column expect_identical(out$data$label[out$data$item == "x1"][1L], "First indicator") expect_true(all(is.na(out$data$label[out$data$item == "x2"]))) }) test_that("top_items(show_labels = FALSE) drops the label column and text", { skip_if_not_installed("psych") set.seed(1) d <- .make_esem_data() attr(d$x1, "label") <- "First indicator" x <- cached(ackwards(d, k_max = 3, engine = "pca")) out <- top_items(x, cut = 0, show_labels = FALSE) expect_false("label" %in% names(out$data)) expect_null(out$item_labels) }) test_that(".format_item_label formats 'id: label' with bare-id fallback", { fmt <- ackwards:::.format_item_label labs <- c(x1 = "First indicator") expect_identical(fmt("x1", labs), "x1: First indicator") expect_identical(fmt("x2", labs), "x2") # no label -> bare id expect_identical(fmt("x1", NULL), "x1") # no labels at all -> bare id }) test_that("top_items errors on bad by/show_labels", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 2, engine = "pca")) expect_error(top_items(x, by = "column"), class = "rlang_error") expect_error(top_items(x, show_labels = "yes"), class = "rlang_error") }) test_that("print.top_items(by = 'item') and label display run without error", { skip_if_not_installed("psych") set.seed(1) d <- .make_esem_data() attr(d$x1, "label") <- "First indicator" x <- cached(ackwards(d, k_max = 3, engine = "pca")) expect_no_error(print(top_items(x, level = 3, cut = 0.25, by = "item"))) expect_no_error(print(top_items(x, level = 3, cut = 0.25))) # id: label path }) test_that("print.top_items renders 'code: label' in header (by=item) and body (by=factor)", { skip_if_not_installed("psych") set.seed(1) d <- .make_esem_data() attr(d$x1, "label") <- "First indicator" x <- cached(ackwards(d, k_max = 3, engine = "pca")) # by = "item": the item is the group HEADER, so the label appears there. by_item <- cli::cli_fmt(print(top_items(x, level = 2, cut = 0, by = "item"))) expect_true(any(grepl("x1: First indicator", by_item, fixed = TRUE))) # by = "factor": the item is a BODY entry under each factor. by_factor <- cli::cli_fmt(print(top_items(x, level = 2, cut = 0))) expect_true(any(grepl("x1: First indicator", by_factor, fixed = TRUE))) # show_labels = FALSE prints the bare code, never the label text. bare <- cli::cli_fmt(print(top_items(x, level = 2, cut = 0, show_labels = FALSE))) expect_false(any(grepl("First indicator", bare, fixed = TRUE))) expect_true(any(grepl("x1", bare, fixed = TRUE))) }) test_that("print.top_items runs without error", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) out <- top_items(x) expect_no_error(print(out)) # returns invisibly expect_identical(print(out), out) }) test_that("print.top_items handles zero-row result gracefully", { skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 2, engine = "pca")) out <- top_items(x, cut = 0.99) expect_no_error(print(out)) }) test_that("interpret vignette edges idiom: adjacent primary filter and column select", { # Guards the pattern used in ackwards-interpret.Rmd (edges-weak chunk): # edges[edges$is_primary & edges$level_to == edges$level_from + 1, c("from","to","r")] skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) edges <- tidy(x, what = "edges") primary <- edges[edges$is_primary & edges$level_to == edges$level_from + 1, ] expect_true(nrow(primary) > 0L) expect_true(all(primary$level_to == primary$level_from + 1L)) expect_true(all(primary$is_primary)) # Column-select exactly as the vignette does sub <- primary[order(abs(primary$r)), c("from", "to", "r")] expect_named(sub, c("from", "to", "r")) expect_true(nrow(sub) > 0L) }) test_that("interpret vignette top_items idioms run", { # Guards the top_items() signatures shown in ackwards-interpret.Rmd. skip_if_not_installed("psych") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) expect_no_error(top_items(x, level = 3)) expect_no_error(top_items(x, level = 3, cut = 0.45)) expect_no_error(top_items(x, level = 3, cut = 0.3, n = 4)) expect_no_error(top_items(x, level = 2, cut = 0.25)) # cross-loadings idiom ti <- top_items(x, level = 3, cut = 0.3) expect_true(is.data.frame(ti$data)) # $data access shown in vignette }) test_that("print.top_items skips levels with no items (nrow(df_k) == 0)", { # Covers the `if (nrow(df_k) == 0L) next` branch. Rather than rely on a cut # that may or may not empty a level on a given dataset (the old version # skipped on bfi25), build a real top_items object and deterministically # drop one shown level's rows: df stays non-empty (level 3 remains), so the # early return doesn't fire, but k = 1 hits `next`. skip_if_not_installed("psych") x <- cached(ackwards(bfi25[, 1:6], k_max = 3)) ti <- top_items(x, level = c(1L, 3L), cut = 0.3) ti$data <- ti$data[ti$data$level != 1L, , drop = FALSE] # Preconditions for the target branch: expect_true(1L %in% ti$levels_shown) # level 1 still requested... expect_false(any(ti$data$level == 1L)) # ...but has no rows -> `next` expect_gt(nrow(ti$data), 0L) # df non-empty -> early return skipped expect_no_error(print(ti)) expect_invisible(print(ti)) }) test_that("interpret/visualization vignette idiom: label_template feeds autoplot cleanly", { # Guards the round-trip autoplot(x, node_labels = label_template(x, style)). # Every ID label_template emits must resolve to a real factor, so no # "match no factor ID" warning should fire for any style. skip_if_not_installed("psych") skip_if_not_installed("ggplot2") set.seed(1) x <- cached(ackwards(.make_esem_data(), k_max = 3, engine = "pca")) for (style in c("id", "forbes", "blank")) { labs <- suppressMessages(label_template(x, style = style)) p <- expect_no_warning(ggplot2::autoplot(x, node_labels = labs)) expect_s3_class(p, "ggplot") } # Blank-slate idiom: fill specific IDs, pass back (vignette label-blank chunk) labs <- suppressMessages(label_template(x, style = "blank")) labs["m3f1"] <- "Alpha" p <- expect_no_warning(ggplot2::autoplot(x, node_labels = labs)) expect_s3_class(p, "ggplot") })