test_that("set_factor_labels / factor_labels round-trip and validate", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) # No labels by default expect_null(factor_labels(x)) # Set some labels; getter round-trips x2 <- set_factor_labels(x, c(m4f1 = "Alpha", m4f2 = "Beta")) expect_identical(factor_labels(x2), c(m4f1 = "Alpha", m4f2 = "Beta")) expect_s3_class(x2, "ackwards") # Original object is untouched (functional API, copy-on-modify) expect_null(factor_labels(x)) # Repeated calls merge/update x3 <- set_factor_labels(x2, c(m4f1 = "Alpha2", m1f1 = "General")) expect_identical( factor_labels(x3), c(m4f1 = "Alpha2", m4f2 = "Beta", m1f1 = "General") ) # NA / "" removes just that one x4 <- set_factor_labels(x3, c(m4f2 = NA)) expect_false("m4f2" %in% names(factor_labels(x4))) expect_true("m4f1" %in% names(factor_labels(x4))) x5 <- set_factor_labels(x4, c(m4f1 = "")) expect_false("m4f1" %in% names(factor_labels(x5))) # NULL clears all x6 <- set_factor_labels(x3, NULL) expect_null(factor_labels(x6)) }) test_that("set_factor_labels errors on unknown IDs and bad input", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) expect_error(set_factor_labels(x, c(m9f9 = "Nope")), "no factor ID") expect_error(set_factor_labels(x, c("Unnamed")), "named") expect_error(set_factor_labels(x, 1:3), "character") expect_error(set_factor_labels(42, c(m1f1 = "x")), "ackwards") expect_error(factor_labels(42), "ackwards") }) test_that("labels survive prune() and ride in meta", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) x <- set_factor_labels(x, c(m4f1 = "Alpha")) xp <- prune(x, rules = "redundant") expect_identical(factor_labels(xp), c(m4f1 = "Alpha")) }) test_that("tidy() adds label columns only when labels are set", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) # Unlabeled: no label columns at all expect_false("factor_label" %in% names(tidy(x, what = "loadings"))) expect_false("factor_label" %in% names(tidy(x, what = "variance"))) expect_false("from_label" %in% names(tidy(x, what = "edges"))) x <- set_factor_labels(x, c(m4f1 = "Alpha", m2f1 = "Broad")) ld <- tidy(x, what = "loadings") expect_true("factor_label" %in% names(ld)) expect_equal(unique(ld$factor_label[ld$factor == "m4f1"]), "Alpha") expect_true(all(is.na(ld$factor_label[ld$factor == "m4f2"]))) vr <- tidy(x, what = "variance") expect_true("factor_label" %in% names(vr)) expect_equal(vr$factor_label[vr$factor == "m2f1"], "Broad") ed <- tidy(x, what = "edges") expect_true(all(c("from_label", "to_label") %in% names(ed))) # m2f1 labeled -> appears as a label on whichever endpoint it is expect_true(any(ed$from_label == "Broad", na.rm = TRUE) || any(ed$to_label == "Broad", na.rm = TRUE)) }) test_that("tidy(scores) gets a factor_label column when set", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca", keep_scores = TRUE)) x <- set_factor_labels(x, c(m4f1 = "Alpha")) sc <- tidy(x, what = "scores") expect_true("factor_label" %in% names(sc)) expect_equal(unique(sc$factor_label[sc$factor == "m4f1"]), "Alpha") }) test_that("print / summary show label (id) when set", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) x <- set_factor_labels(x, c(m4f1 = "Alpha")) print_out <- cli::cli_fmt(print(x)) expect_true(any(grepl("Factor labels", print_out))) sum_out <- cli::cli_fmt(print(summary(x))) expect_true(any(grepl("Alpha \\(m4f1\\)", sum_out))) }) test_that("top_items(by = 'factor') headers show label (id)", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) x <- set_factor_labels(x, c(m4f1 = "Alpha")) out <- cli::cli_fmt(print(top_items(x, level = 4))) expect_true(any(grepl("Alpha \\(m4f1\\)", out))) }) test_that("autoplot uses stored labels as baseline, call-time overrides", { skip_if_not_installed("ggplot2") x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) x <- set_factor_labels(x, c(m4f1 = "Alpha", m4f2 = "Beta")) p <- ggplot2::autoplot(x) lab_layer <- p$layers[[which(vapply( p$layers, function(l) inherits(l$geom, "GeomText"), logical(1) ))[[1]]]] # Build the node label data the plot draws from lay <- ba_layout(x)$nodes # Stored labels appear in the layout-derived text via autoplot's baseline built <- ggplot2::ggplot_build(p) txt <- unlist(lapply(built$data, function(d) if ("label" %in% names(d)) d$label)) expect_true("Alpha" %in% txt) expect_true("Beta" %in% txt) # Call-time node_labels override wins for that node p2 <- ggplot2::autoplot(x, node_labels = c(m4f1 = "Override")) built2 <- ggplot2::ggplot_build(p2) txt2 <- unlist(lapply(built2$data, function(d) if ("label" %in% names(d)) d$label)) expect_true("Override" %in% txt2) expect_false("Alpha" %in% txt2) expect_true("Beta" %in% txt2) # untouched node keeps stored label }) test_that("stored labels survive the drop_pruned autoplot path", { skip_if_not_installed("ggplot2") x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) xp <- prune(x, rules = "redundant") # Label a factor that is NOT pruned, so it survives into the pruned view. kept <- xp$prune$nodes$id[!xp$prune$nodes$pruned] xp <- set_factor_labels(xp, stats::setNames("Kept", kept[[length(kept)]])) p <- ggplot2::autoplot(xp, drop_pruned = TRUE) built <- ggplot2::ggplot_build(p) txt <- unlist(lapply(built$data, function(d) if ("label" %in% names(d)) d$label)) expect_true("Kept" %in% txt) }) test_that("top_items(by = 'item') body shows factor label (id)", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) x <- set_factor_labels(x, c(m4f1 = "Alpha")) out <- cli::cli_fmt(print(top_items(x, level = 4, by = "item"))) # m4f1 appears in the body (as a factor an item loads on); it should carry # the label. Unlabelled factors on the same listing stay bare. expect_true(any(grepl("Alpha \\(m4f1\\)", out))) }) test_that("factor labels do not change augment()/predict() column names", { x <- cached(ackwards(sim16, k_max = 4, engine = "pca")) xl <- set_factor_labels(x, c(m4f1 = "Alpha", m2f1 = "Broad")) aug_bare <- augment(x, data = sim16, append = FALSE) aug_lab <- augment(xl, data = sim16, append = FALSE) expect_identical(names(aug_bare), names(aug_lab)) expect_true(all(grepl("^\\.m[0-9]+f[0-9]+$", names(aug_lab)))) pred_bare <- predict(x, newdata = sim16) pred_lab <- predict(xl, newdata = sim16) expect_identical(names(pred_bare), names(pred_lab)) })