Nothing
test_that("ba_layout() returns a list with nodes and edges data frames", {
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4))
lay <- ba_layout(x)
expect_type(lay, "list")
expect_named(lay, c("nodes", "edges"))
expect_s3_class(lay$nodes, "data.frame")
expect_s3_class(lay$edges, "data.frame")
})
test_that("ba_layout() nodes have correct structure and counts", {
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4))
lay <- ba_layout(x)
nodes <- lay$nodes
# Columns
expect_true(all(c("id", "level", "x", "y", "label") %in% names(nodes)))
# Total nodes: 1+2+3+4 = 10
expect_equal(nrow(nodes), 10L)
# One node per level per factor
for (k in 1:4) {
expect_equal(sum(nodes$level == k), k,
info = paste("level", k, "has", k, "nodes")
)
}
})
test_that("ba_layout() y positions equal -level", {
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
lay <- ba_layout(x)
nodes <- lay$nodes
expect_equal(nodes$y, -nodes$level)
})
test_that("ba_layout() level-1 node is at x = 0", {
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
lay <- ba_layout(x)
nodes <- lay$nodes
expect_equal(nodes$x[nodes$level == 1], 0)
})
test_that("ba_layout() respects min_sep between nodes at same level", {
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 5))
for (sep in c(0.5, 1.0, 1.5)) {
lay <- ba_layout(x, min_sep = sep)
nodes <- lay$nodes
for (k in 2:5) {
xs <- sort(nodes$x[nodes$level == k])
diffs <- diff(xs)
expect_true(
all(diffs >= sep - 1e-9),
info = paste("min_sep", sep, "at level", k)
)
}
}
})
test_that("ba_layout() node IDs and labels match level labels", {
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
lay <- ba_layout(x)
nodes <- lay$nodes
expect_equal(nodes$id, nodes$label)
# IDs follow m{k}f{j} scheme
expect_true(all(grepl("^m[0-9]+f[0-9]+$", nodes$id)))
})
test_that("ba_layout() errors on non-ackwards input", {
expect_error(ba_layout(list()), "ackwards")
})
test_that("ba_layout() places each parent at mean x of its primary children", {
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 5))
lay <- ba_layout(x)
nodes <- lay$nodes
edges <- lay$edges
nx <- stats::setNames(nodes$x, nodes$id)
# For every adjacent level pair, compute the ideal parent position as the
# simple mean of its primary children's x coordinates, and assert it agrees
# with the actual parent x within tolerance (spreading can shift by up to
# min_sep when siblings collide, but in the typical case they agree exactly).
primary_edges <- edges[!is.na(edges$is_primary) & edges$is_primary, ]
for (parent_id in unique(primary_edges$from)) {
child_ids <- primary_edges$to[primary_edges$from == parent_id]
ideal_x <- mean(nx[child_ids])
actual_x <- nx[[parent_id]]
# Alignment is exact when no spreading is needed; after spreading it may
# differ, so assert within 1 * min_sep (default).
expect_lte(
abs(actual_x - ideal_x), 1.0 + 1e-9,
label = paste(parent_id, "aligned to primary children")
)
}
# Specifically verify single-child parents are directly above their child
# (before any spreading, diff should be 0; after spreading can be up to min_sep).
single_child <- names(which(table(primary_edges$from) == 1))
for (parent_id in single_child) {
child_id <- primary_edges$to[primary_edges$from == parent_id]
expect_equal(
nx[[parent_id]], nx[[child_id]],
tolerance = 1.0 + 1e-9,
label = paste(parent_id, "directly above sole primary child", child_id)
)
}
})
test_that(".spread_positions() enforces min_sep, preserves order, and recentres", {
# Access internal function from the package namespace
spread <- ackwards:::.spread_positions
# Colliding input: three positions bunched at 0
bary <- c(0, 0, 0)
out <- spread(bary, min_sep = 1.0)
expect_equal(length(out), 3L)
# All gaps should be >= min_sep
expect_true(all(diff(sort(out)) >= 1.0 - 1e-9))
# Group should be re-centred around original mean (0)
expect_equal(mean(out), 0, tolerance = 1e-9)
# Already-separated input: should be unchanged (no spreading needed)
bary2 <- c(-2, 0, 2)
out2 <- spread(bary2, min_sep = 1.0)
expect_equal(out2, bary2, tolerance = 1e-9)
# Order preservation: largest bary stays largest
bary3 <- c(1, 3, 2)
out3 <- spread(bary3, min_sep = 0.5)
expect_equal(order(out3), order(bary3))
# Single element: returned as-is
expect_equal(spread(5, min_sep = 1.0), 5)
})
test_that("autoplot.ackwards() returns a ggplot object", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x)
expect_s3_class(p, "ggplot")
})
test_that("autoplot(x) dispatches correctly without library(ggplot2)", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
# The package defines its own autoplot generic so this works without ggplot2 attached
p <- autoplot(x)
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() respects cut_show", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_no_error(ggplot2::autoplot(x, cut_show = 0.1))
expect_no_error(ggplot2::autoplot(x, cut_show = 0.5))
})
test_that("autoplot.ackwards() deprecates cut_strong (warns, no effect)", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_warning(ggplot2::autoplot(x, cut_strong = 0.4), "deprecated")
})
test_that("autoplot.ackwards() validates cut_show (M42/m8)", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_error(ggplot2::autoplot(x, cut_show = 5), "\\[0, 1\\]")
expect_error(ggplot2::autoplot(x, cut_show = c(0.3, 0.5)), "\\[0, 1\\]")
expect_error(ggplot2::autoplot(x, cut_show = NA), "\\[0, 1\\]")
})
test_that("autoplot.ackwards() warns when cut_show hides all edges", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
# cut_show = 1 (the legal maximum since M42/m8 validation) hides every edge
# here: no between-level correlation in these data reaches exactly 1.0
expect_warning(ggplot2::autoplot(x, cut_show = 1), "No edges")
})
test_that("autoplot.ackwards() warns when min_sep < node_width", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_warning(ggplot2::autoplot(x, min_sep = 0.3, node_width = 0.8), "overlap")
})
test_that("plot.ackwards() runs without error and returns x invisibly", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_no_error(plot(x))
expect_invisible(plot(x))
})
test_that("autoplot.ackwards() renders skip-level edges with pairs='all'", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4, pairs = "all"))
p <- expect_no_error(ggplot2::autoplot(x))
expect_s3_class(p, "ggplot")
# show_skip defaults to TRUE when meta$pairs == "all"
expect_no_error(ggplot2::autoplot(x, show_skip = FALSE))
expect_no_error(ggplot2::autoplot(x, show_skip = TRUE, curvature = 0.3))
})
test_that("autoplot.ackwards() fades pruned nodes", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
set.seed(42)
n <- 500
g <- rnorm(n)
s1 <- rnorm(n)
s2 <- rnorm(n)
data <- data.frame(
x1 = 0.9 * g + 0.2 * s1 + rnorm(n, sd = 0.05),
x2 = 0.9 * g + 0.2 * s1 + rnorm(n, sd = 0.05),
x3 = 0.9 * g + 0.2 * s1 + rnorm(n, sd = 0.05),
x4 = 0.9 * g + 0.2 * s2 + rnorm(n, sd = 0.05),
x5 = 0.9 * g + 0.2 * s2 + rnorm(n, sd = 0.05),
x6 = 0.9 * g + 0.2 * s2 + rnorm(n, sd = 0.05)
)
x <- suppressWarnings(suppressMessages(
ackwards(data, k_max = 4) |> prune("redundant", redundancy_r = 0.9)
))
p <- expect_no_error(ggplot2::autoplot(x))
expect_s3_class(p, "ggplot")
# Custom prune colour
expect_no_error(ggplot2::autoplot(x, color_pruned = "pink"))
})
test_that(".drop_pruned_nodes() bridges fully-pruned levels on pairs='adjacent' objects (M42/M1)", {
skip_if_not_installed("psych")
d <- na.omit(ackwards::bfi25)
# Default pairs = "adjacent": the stored tidy edges hold no skip-level rows.
x <- cached(ackwards(d, k_max = 4))
xp <- prune(x, manual = c("m2f1", "m2f2")) # level 2 fully pruned
lay <- ba_layout(xp)
dp <- ackwards:::.drop_pruned_nodes(xp, lay$nodes)
# Pre-M42 regression: kept level-3 nodes had no candidate ancestor edges
# (their only stored parents were the pruned level-2 nodes; no 1:3 skip
# edges existed in the adjacent-only tidy table). Every kept node below the
# apex must now have exactly one incoming edge, bridging the pruned level.
kept_below_apex <- dp$nodes$id[dp$nodes$level > 1L]
expect_setequal(dp$edges$to, kept_below_apex)
# The level-3 bridges must come from level 1 (level 2 is gone).
lvl3_edges <- dp$edges[dp$edges$level_to == 3L, , drop = FALSE]
expect_true(nrow(lvl3_edges) == 3L && all(lvl3_edges$level_from == 1L))
# And the reduced edge set must be identical whether the object was fit
# with pairs = "adjacent" or pairs = "all" (edges are recomputed fresh).
x_all <- cached(ackwards(d, k_max = 4, pairs = "all"))
xp_all <- prune(x_all, manual = c("m2f1", "m2f2"))
dp_all <- ackwards:::.drop_pruned_nodes(xp_all, ba_layout(xp_all)$nodes)
cols <- c("from", "to", "level_from", "level_to", "r")
expect_equal(dp$edges[, cols], dp_all$edges[, cols], tolerance = 1e-12)
})
test_that("autoplot.ackwards() handles objects with prune=NULL (no pruning)", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_null(x$prune)
p <- expect_no_error(ggplot2::autoplot(x))
expect_s3_class(p, "ggplot")
})
# --- Wave 1 (M8): show_r, mono, show_level_labels, node_labels, primary_only ---
test_that("autoplot.ackwards() show_r=TRUE labels edges without error", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, show_r = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() show_r=TRUE respects r_digits", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, show_r = TRUE, r_digits = 3L))
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() show_r=TRUE works with pairs='all'", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4, pairs = "all"))
p <- expect_no_error(ggplot2::autoplot(x, show_r = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() mono=TRUE returns a ggplot", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, mono = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() mono=TRUE + show_r=TRUE composes without error", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, mono = TRUE, show_r = TRUE))
expect_s3_class(p, "ggplot")
})
# --- M35: configurable encodings (sign_by / magnitude_by / colour aliases) ------
.ba_has_scale <- function(p, aesthetic) {
any(vapply(
p$scales$scales,
function(s) aesthetic %in% s$aesthetics,
logical(1)
))
}
.ba_get_scale <- function(p, aesthetic) {
for (s in p$scales$scales) {
if (aesthetic %in% s$aesthetics) {
return(s)
}
}
NULL
}
test_that("sign_by selects which aesthetic encodes edge sign", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
# default "color": colour encodes sign, linetype does not
p <- ggplot2::autoplot(x)
expect_true(.ba_has_scale(p, "colour"))
expect_false(.ba_has_scale(p, "linetype"))
# "linetype": linetype encodes sign, colour does not
p <- ggplot2::autoplot(x, sign_by = "linetype")
expect_true(.ba_has_scale(p, "linetype"))
expect_false(.ba_has_scale(p, "colour"))
# "both": colour AND linetype, merged into one legend. ggplot2 merges guides
# that share a scale name, so both scales must be titled "Direction".
p <- ggplot2::autoplot(x, sign_by = "both")
expect_true(.ba_has_scale(p, "colour"))
expect_true(.ba_has_scale(p, "linetype"))
expect_identical(.ba_get_scale(p, "colour")$name, "Direction")
expect_identical(.ba_get_scale(p, "linetype")$name, "Direction")
# "none": neither encodes sign
p <- ggplot2::autoplot(x, sign_by = "none")
expect_false(.ba_has_scale(p, "colour"))
expect_false(.ba_has_scale(p, "linetype"))
})
test_that("magnitude_by / edge_linewidth control the |r| linewidth scale", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_true(.ba_has_scale(ggplot2::autoplot(x), "linewidth"))
expect_false(.ba_has_scale(ggplot2::autoplot(x, magnitude_by = "none"), "linewidth"))
# a numeric edge_linewidth also forces constant width (no scale)
expect_false(.ba_has_scale(ggplot2::autoplot(x, edge_linewidth = 0.6), "linewidth"))
})
test_that("colour_* aliases override the color_* arguments", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4, pairs = "all"))
# colour_pos / colour_neg feed the Direction colour scale (break order
# positive, negative) -- readable even when no negative edge is drawn.
p <- ggplot2::autoplot(x, colour_pos = "darkgreen", colour_neg = "darkorange")
expect_equal(
unname(.ba_get_scale(p, "colour")$palette(2L)),
c("darkgreen", "darkorange")
)
# colour_edge sets the single edge colour when sign is not colour-encoded.
pe <- ggplot2::autoplot(x, sign_by = "linetype", colour_edge = "darkgreen")
expect_true(all(ggplot2::ggplot_build(pe)$data[[1]]$colour == "darkgreen"))
# colour_pruned sets the pruned-node fill (use manual pruning for determinism).
xp <- prune(x, manual = "m4f4")
pp <- ggplot2::autoplot(xp, colour_pruned = "pink")
tile_fill <- unlist(lapply(
ggplot2::ggplot_build(pp)$data,
function(l) if ("fill" %in% names(l)) l$fill
))
expect_true("pink" %in% tile_fill)
})
test_that("sign_by='none' + magnitude_by='none' renders with no encoding scales", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, sign_by = "none", magnitude_by = "none")
expect_s3_class(p, "ggplot")
expect_false(.ba_has_scale(p, "colour"))
expect_false(.ba_has_scale(p, "linetype"))
expect_false(.ba_has_scale(p, "linewidth"))
expect_s3_class(ggplot2::ggplot_build(p), "ggplot_built")
})
test_that("mono=TRUE is equivalent to sign_by='linetype' with black edges", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, mono = TRUE)
expect_true(.ba_has_scale(p, "linetype"))
expect_false(.ba_has_scale(p, "colour"))
edge_colours <- ggplot2::ggplot_build(p)$data[[1]]$colour
expect_true(all(edge_colours == "black"))
})
test_that("direction='horizontal' transposes the level axis to x", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4))
tile_layer <- function(p) {
d <- ggplot2::ggplot_build(p)$data
idx <- which(vapply(
d,
function(l) all(c("fill", "width") %in% names(l)),
logical(1)
))[[1L]]
d[[idx]]
}
v <- tile_layer(ggplot2::autoplot(x, direction = "vertical"))
h <- tile_layer(ggplot2::autoplot(x, direction = "horizontal"))
# Vertical: levels run down the y-axis (level 1 at top, y = -1 is the max).
expect_equal(max(v$y), -1)
# Horizontal: levels run along the x-axis (level 1 at left, x = 1 is the min).
expect_equal(min(h$x), 1)
# The two layouts are transposes of one another.
expect_equal(sort(range(v$x)), sort(range(h$y)))
})
test_that("direction='horizontal' composes with skip, mono, and drop_pruned", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
xa <- cached(ackwards(psych::bfi[, 1:25], k_max = 4, pairs = "all"))
expect_s3_class(ggplot2::autoplot(xa, direction = "horizontal", show_skip = TRUE), "ggplot")
expect_s3_class(ggplot2::autoplot(xa, direction = "horizontal", mono = TRUE), "ggplot")
# show_r places perpendicular-offset labels; the offset math is orientation-
# agnostic, so it must compose with the transposed layout.
expect_s3_class(ggplot2::autoplot(xa, direction = "horizontal", show_r = TRUE), "ggplot")
xp <- prune(xa, "redundant")
expect_s3_class(
suppressWarnings(ggplot2::autoplot(xp, direction = "horizontal", drop_pruned = TRUE)),
"ggplot"
)
})
test_that("autoplot.ackwards() show_level_labels=TRUE (default) returns a ggplot", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, show_level_labels = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() show_level_labels=FALSE omits labels without error", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, show_level_labels = FALSE))
expect_s3_class(p, "ggplot")
})
# --- M40: fully-pruned level axis labels rendered in italic -------------------
# Locate the level-axis-label GeomText layer (labels like "3 factors"), as
# opposed to the node-label GeomText layer (labels like "m3f1").
.level_label_data <- function(p) {
gt_idx <- which(vapply(
p$layers, function(l) inherits(l$geom, "GeomText"), logical(1L)
))
for (i in gt_idx) {
ld <- ggplot2::layer_data(p, i)
if (any(grepl("factor", ld$label))) {
return(ld)
}
}
NULL
}
test_that(".fully_pruned_levels() detects a wholly-pruned level, not partial ones", {
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4))
# No pruning annotations -> integer(0)
expect_identical(.fully_pruned_levels(x), integer(0))
# Prune every factor at level 4 -> level 4 fully pruned
xp <- prune(x, manual = c("m4f1", "m4f2", "m4f3", "m4f4"))
expect_identical(.fully_pruned_levels(xp), 4L)
# Prune only some of level 4 -> not fully pruned
xpart <- prune(x, manual = c("m4f1", "m4f2"))
expect_identical(.fully_pruned_levels(xpart), integer(0))
})
test_that("autoplot() italicises a fully-pruned level's axis label (both directions)", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4))
xp <- prune(x, manual = c("m4f1", "m4f2", "m4f3", "m4f4"))
for (dir in c("vertical", "horizontal")) {
p <- ggplot2::autoplot(xp, direction = dir)
ld <- .level_label_data(p)
expect_false(is.null(ld))
italic <- ld$label[ld$fontface == "italic"]
plain <- ld$label[ld$fontface == "plain"]
expect_identical(italic, "4 factors")
expect_true(all(c("1 factor", "2 factors", "3 factors") %in% plain))
}
})
test_that("autoplot() renders all level labels plain when nothing is fully pruned", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
# Un-pruned object
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4))
ld <- .level_label_data(ggplot2::autoplot(x))
expect_false(is.null(ld))
expect_true(all(ld$fontface == "plain"))
# Partially-pruned level stays plain
xpart <- prune(x, manual = c("m4f1", "m4f2"))
ld2 <- .level_label_data(ggplot2::autoplot(xpart))
expect_true(all(ld2$fontface == "plain"))
})
test_that("autoplot() italicises levels fully pruned by the auto 'redundant' rule", {
skip_if_not_installed("ggplot2")
# sim16's built-in redundant chains (M33) fully prune levels 3 and 4 at
# k_max = 5 with the |r| >= 0.9 threshold -- an *auto*-rule full prune (not
# manual), and two fully-pruned levels at once. Deterministic for this dataset.
suppressWarnings(suppressMessages(
xr <- cached(ackwards(sim16, k_max = 5) |> prune("redundant", redundancy_r = 0.9))
))
expect_identical(.fully_pruned_levels(xr), c(3L, 4L))
ld <- .level_label_data(ggplot2::autoplot(xr))
expect_false(is.null(ld))
expect_setequal(ld$label[ld$fontface == "italic"], c("3 factors", "4 factors"))
expect_setequal(ld$label[ld$fontface == "plain"], c("1 factor", "2 factors", "5 factors"))
})
test_that("autoplot.ackwards() node_labels applies custom labels", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, node_labels = c(m3f1 = "Alpha")))
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() node_labels warns for unknown factor IDs", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_warning(
ggplot2::autoplot(x, node_labels = c(m99f1 = "Ghost")),
"match no factor ID"
)
})
test_that("autoplot.ackwards() primary_only=TRUE returns a ggplot", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, primary_only = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() primary_only=TRUE hides skip arcs", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4, pairs = "all"))
# primary_only filters to is_primary==TRUE; skip edges are never primary
p <- expect_no_error(ggplot2::autoplot(x, primary_only = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("autoplot.ackwards() all Wave-1 args compose without error", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4, pairs = "all"))
p <- expect_no_error(ggplot2::autoplot(
x,
show_r = TRUE,
r_digits = 2L,
mono = TRUE,
show_level_labels = TRUE,
level_label_size = 3,
node_labels = c(m4f1 = "General"),
primary_only = FALSE
))
expect_s3_class(p, "ggplot")
})
# --- Wave 2 (M8): drop_pruned + compress_levels + .drop_pruned_nodes() ------
test_that("drop_pruned=TRUE errors without pruning annotations", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_null(x$prune)
expect_error(ggplot2::autoplot(x, drop_pruned = TRUE), "prune")
})
test_that("drop_pruned=TRUE returns a ggplot for a pruned object", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
p <- expect_no_error(ggplot2::autoplot(x, drop_pruned = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("drop_pruned=TRUE: show_r defaults to FALSE (decoupled from drop_pruned)", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
# show_r defaults FALSE; no GeomLabel layers should appear
p <- expect_no_error(ggplot2::autoplot(x, drop_pruned = TRUE))
expect_s3_class(p, "ggplot")
label_layers <- Filter(function(l) inherits(l$geom, "GeomLabel"), p$layers)
expect_equal(length(label_layers), 0L)
})
test_that("show_r=TRUE produces GeomLabel layers", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, show_r = TRUE))
label_layers <- Filter(function(l) inherits(l$geom, "GeomLabel"), p$layers)
expect_true(length(label_layers) > 0L)
})
test_that("drop_pruned=TRUE + show_r=FALSE produces no GeomLabel layers", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
p <- expect_no_error(ggplot2::autoplot(x, drop_pruned = TRUE, show_r = FALSE))
expect_s3_class(p, "ggplot")
label_layers <- Filter(function(l) inherits(l$geom, "GeomLabel"), p$layers)
expect_equal(length(label_layers), 0L)
})
test_that("show_r=TRUE label text is APA-formatted (no leading zero, padded decimals)", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, show_r = TRUE, r_digits = 2L)
idx <- which(vapply(p$layers, function(l) inherits(l$geom, "GeomLabel"), logical(1L)))
ld <- ggplot2::layer_data(p, idx)
# APA convention: no label starts with "0." or "-0."
expect_false(any(grepl("^0\\.", ld$label)))
expect_false(any(grepl("^-0\\.", ld$label)))
# Labels that contain a decimal point have exactly r_digits digits after it
has_dot <- grepl("\\.", ld$label)
if (any(has_dot)) {
decimal_parts <- sub("^[^.]*\\.", "", ld$label[has_dot])
expect_true(all(nchar(decimal_parts) == 2L))
}
})
test_that("show_r=TRUE places labels offset from the edge midpoint", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, show_r = TRUE)
ld <- ggplot2::layer_data(p, which(vapply(p$layers, function(l) {
inherits(l$geom, "GeomLabel")
}, logical(1L))))
# Recover the segment layers for midpoint comparison
seg_layers <- which(vapply(p$layers, function(l) inherits(l$geom, "GeomSegment"), logical(1L)))
sd <- ggplot2::layer_data(p, seg_layers[[1L]])
mid_x <- (sd$x + sd$xend) / 2
mid_y <- (sd$y + sd$yend) / 2
# Labels must not coincide with the raw midpoints — perpendicular nudge moved them
expect_false(all(abs(ld$x - mid_x) < 1e-9 & abs(ld$y - mid_y) < 1e-9))
})
test_that("r_label_size arg changes the geom_label size", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p_small <- ggplot2::autoplot(x, show_r = TRUE, r_label_size = 1.5)
p_large <- ggplot2::autoplot(x, show_r = TRUE, r_label_size = 4.0)
get_label_size <- function(p) {
idx <- which(vapply(p$layers, function(l) inherits(l$geom, "GeomLabel"), logical(1L)))
p$layers[[idx]]$aes_params$size
}
expect_equal(get_label_size(p_small), 1.5)
expect_equal(get_label_size(p_large), 4.0)
})
test_that("drop_pruned=TRUE + compress_levels=TRUE returns a ggplot", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
p <- expect_no_error(ggplot2::autoplot(x,
drop_pruned = TRUE,
compress_levels = TRUE
))
expect_s3_class(p, "ggplot")
})
test_that("drop_pruned=TRUE + mono=TRUE returns a ggplot", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
p <- expect_no_error(ggplot2::autoplot(x, drop_pruned = TRUE, mono = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("drop_pruned=TRUE + node_labels applies labels", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
p <- expect_no_error(ggplot2::autoplot(x,
drop_pruned = TRUE,
node_labels = c(m5f1 = "Neuroticism")
))
expect_s3_class(p, "ggplot")
})
test_that("drop_pruned degenerate case warns and returns node-only ggplot", {
skip_if_not_installed("ggplot2")
# k=2 with high-g data: m1f1 is redundant with m2f1 (chain reaches k=2),
# leaving only level-2 nodes — n_kept_levels = 1 -> degenerate
set.seed(42)
n <- 500
g <- rnorm(n)
d <- data.frame(
x1 = 0.9 * g + rnorm(n, sd = 0.05),
x2 = 0.9 * g + rnorm(n, sd = 0.05),
x3 = 0.9 * g + rnorm(n, sd = 0.05),
x4 = 0.9 * g + rnorm(n, sd = 0.05),
x5 = 0.9 * g + rnorm(n, sd = 0.05),
x6 = 0.9 * g + rnorm(n, sd = 0.05)
)
x <- suppressMessages(ackwards(d, k_max = 2) |> prune("redundant", redundancy_r = 0.7))
# Verify the test fixture: m1f1 should be pruned, only level 2 keeps nodes
expect_equal(
unique(x$prune$nodes$level[!x$prune$nodes$pruned]),
2L
)
expect_warning(ggplot2::autoplot(x, drop_pruned = TRUE), "node-only")
p <- suppressWarnings(ggplot2::autoplot(x, drop_pruned = TRUE))
expect_s3_class(p, "ggplot")
})
test_that(".drop_pruned_nodes() returns kept-only nodes and reduced edges", {
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
lay <- ba_layout(x)
dp <- ackwards:::.drop_pruned_nodes(x, lay$nodes)
kept <- x$prune$nodes$id[!x$prune$nodes$pruned]
# All returned nodes are kept
expect_true(all(dp$nodes$id %in% kept))
expect_equal(nrow(dp$nodes), length(kept))
# Each edge connects two kept nodes
if (nrow(dp$edges) > 0L) {
expect_true(all(dp$edges$from %in% kept))
expect_true(all(dp$edges$to %in% kept))
# Each "to" node appears at most once (one primary parent per node)
expect_equal(length(unique(dp$edges$to)), nrow(dp$edges))
# Parent is always shallower than child
expect_true(all(dp$edges$level_from < dp$edges$level_to))
}
})
test_that(".drop_pruned_nodes() compress_levels re-indexes y", {
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
lay <- ba_layout(x)
dp_gap <- ackwards:::.drop_pruned_nodes(x, lay$nodes, compress_levels = FALSE)
dp_comp <- ackwards:::.drop_pruned_nodes(x, lay$nodes, compress_levels = TRUE)
# Gap-preserved: y == -level for all kept nodes
expect_equal(dp_gap$nodes$y, -dp_gap$nodes$level)
# Compressed: y values are consecutive integers starting at -1
kept_levels <- sort(unique(dp_comp$nodes$level))
if (length(kept_levels) > 1L) {
expected_y <- -match(dp_comp$nodes$level, kept_levels)
expect_equal(dp_comp$nodes$y, expected_y)
}
})
test_that("drop_pruned=TRUE warns when no nodes are pruned (artifact-only)", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3) |> prune("artifact"))
))
expect_true(!any(x$prune$nodes$pruned))
expect_warning(
ggplot2::autoplot(x, drop_pruned = TRUE),
"no nodes are flagged"
)
})
test_that("drop_pruned=TRUE warns when cut_show removes all reduced edges", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
# cut_show = 1 is the legal maximum since M42/m8 validation; no reduced
# edge in these data reaches exactly 1.0, so all are hidden
expect_warning(
ggplot2::autoplot(x, drop_pruned = TRUE, cut_show = 1),
"No edges"
)
})
test_that("node_labels as unnamed vector silently does nothing", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
# Unnamed character: names() is NULL; no warning, no crash
p <- expect_no_error(ggplot2::autoplot(x, node_labels = c("Alpha", "Beta")))
expect_s3_class(p, "ggplot")
})
test_that("compress_levels=TRUE without drop_pruned is silently ignored", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, compress_levels = TRUE))
expect_s3_class(p, "ggplot")
})
test_that("drop_pruned=TRUE ignores primary_only and show_skip", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- ackwards(psych::bfi[, 1:25], k_max = 5) |>
prune("redundant", redundancy_r = 0.95)
))
# These flags should be silently ignored — no error
p <- expect_no_error(ggplot2::autoplot(
x,
drop_pruned = TRUE,
primary_only = TRUE,
show_skip = TRUE
))
expect_s3_class(p, "ggplot")
})
# --- Wave 1 (M9): show_arrows, edge_linewidth, legend -------------------------
test_that("show_arrows=FALSE returns a ggplot", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, show_arrows = FALSE))
expect_s3_class(p, "ggplot")
})
test_that("show_arrows=FALSE sets arrow=NULL on segment layers", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, show_arrows = FALSE)
seg_layers <- Filter(function(l) inherits(l$geom, "GeomSegment"), p$layers)
expect_true(length(seg_layers) > 0L)
for (l in seg_layers) expect_null(l$geom_params$arrow)
})
test_that("show_arrows=TRUE (default) retains arrowheads on segment layers", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, show_arrows = TRUE)
seg_layers <- Filter(function(l) inherits(l$geom, "GeomSegment"), p$layers)
for (l in seg_layers) expect_s3_class(l$geom_params$arrow, "arrow")
})
test_that("show_arrows=FALSE removes arrowheads from curved arcs too", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4, pairs = "all"))
p <- ggplot2::autoplot(x, show_arrows = FALSE)
expect_s3_class(p, "ggplot")
cur_layers <- Filter(function(l) inherits(l$geom, "GeomCurve"), p$layers)
for (l in cur_layers) expect_null(l$geom_params$arrow)
})
test_that("edge_linewidth numeric returns a ggplot", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, edge_linewidth = 0.6))
expect_s3_class(p, "ggplot")
})
test_that("edge_linewidth numeric drops the linewidth scale", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
has_lw_scale <- function(p) {
any(vapply(p$scales$scales, function(s) "linewidth" %in% s$aesthetics, logical(1L)))
}
expect_true(has_lw_scale(ggplot2::autoplot(x)))
expect_false(has_lw_scale(ggplot2::autoplot(x, edge_linewidth = 0.6)))
})
test_that("edge_linewidth=NULL (default) retains the linewidth scale", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
has_lw_scale <- function(p) {
any(vapply(p$scales$scales, function(s) "linewidth" %in% s$aesthetics, logical(1L)))
}
expect_true(has_lw_scale(ggplot2::autoplot(x, edge_linewidth = NULL)))
})
test_that("legend=FALSE returns a ggplot with legend.position='none'", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(x, legend = FALSE))
expect_s3_class(p, "ggplot")
expect_equal(p$theme$legend.position, "none")
})
test_that("legend=TRUE (default) does not suppress the legend", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, legend = TRUE)
expect_false(identical(p$theme$legend.position, "none"))
})
test_that("Forbes-style composition: drop_pruned+black+fixed lw+no arrows+no legend", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
suppressWarnings(suppressMessages(
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 5) |> prune("redundant", redundancy_r = 0.95))
))
p <- expect_no_error(ggplot2::autoplot(
x,
drop_pruned = TRUE,
color_pos = "black",
color_neg = "black",
edge_linewidth = 0.6,
show_arrows = FALSE,
legend = FALSE
))
expect_s3_class(p, "ggplot")
expect_equal(p$theme$legend.position, "none")
})
test_that("M9 args compose with mono=TRUE without error", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- expect_no_error(ggplot2::autoplot(
x,
mono = TRUE,
show_arrows = FALSE,
edge_linewidth = 0.5,
legend = FALSE
))
expect_s3_class(p, "ggplot")
})
test_that("all M9 args compose with all M8 args without error", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 4, pairs = "all"))
p <- expect_no_error(ggplot2::autoplot(
x,
show_r = TRUE,
r_digits = 2L,
show_level_labels = TRUE,
node_labels = c(m4f1 = "General"),
primary_only = FALSE,
show_arrows = FALSE,
edge_linewidth = 0.5,
legend = FALSE
))
expect_s3_class(p, "ggplot")
})
test_that("edge_linewidth numeric stores constant linewidth on segment layers", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, edge_linewidth = 0.6)
seg_layers <- Filter(function(l) inherits(l$geom, "GeomSegment"), p$layers)
expect_true(length(seg_layers) > 0L)
# linewidth is a ggplot2 aesthetic so constant values land in $aes_params
for (l in seg_layers) expect_equal(l$aes_params$linewidth, 0.6)
})
test_that("edge_linewidth invalid values error clearly", {
skip_if_not_installed("psych")
skip_if_not_installed("ggplot2")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
expect_error(ggplot2::autoplot(x, edge_linewidth = "thick"), "edge_linewidth")
expect_error(ggplot2::autoplot(x, edge_linewidth = -0.5), "edge_linewidth")
expect_error(ggplot2::autoplot(x, edge_linewidth = c(0.5, 0.6)), "edge_linewidth")
})
test_that("legend=FALSE is honoured on the degenerate drop_pruned plot", {
skip_if_not_installed("ggplot2")
set.seed(42)
n <- 500
g <- rnorm(n)
d <- data.frame(
x1 = 0.9 * g + rnorm(n, sd = 0.05),
x2 = 0.9 * g + rnorm(n, sd = 0.05),
x3 = 0.9 * g + rnorm(n, sd = 0.05),
x4 = 0.9 * g + rnorm(n, sd = 0.05),
x5 = 0.9 * g + rnorm(n, sd = 0.05),
x6 = 0.9 * g + rnorm(n, sd = 0.05)
)
x <- suppressMessages(ackwards(d, k_max = 2) |> prune("redundant", redundancy_r = 0.7))
p <- suppressWarnings(ggplot2::autoplot(x, drop_pruned = TRUE, legend = FALSE))
expect_s3_class(p, "ggplot")
expect_equal(p$theme$legend.position, "none")
})
# ── M27: autoplot(x, what = "fit") ────────────────────────────────────────────
test_that("autoplot(x, what='fit') returns ggplot for EFA object", {
skip_if_not_installed("ggplot2")
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3, engine = "efa"))
p <- ggplot2::autoplot(x, what = "fit")
expect_s3_class(p, "ggplot")
})
test_that("autoplot(x, what='fit') draws Hu & Bentler threshold reference lines", {
skip_if_not_installed("ggplot2")
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3, engine = "efa"))
p <- ggplot2::autoplot(x, what = "fit")
# The cutoff reference lines are a geom_hline layer (retained .fit_cutoffs()).
has_hline <- vapply(
p$layers,
function(l) inherits(l$geom, "GeomHline"),
logical(1L)
)
expect_true(any(has_hline))
# The reference y-intercepts are the EFA-charted thresholds (TLI .95, RMSEA .06).
hline_layer <- p$layers[[which(has_hline)[1L]]]
expect_setequal(hline_layer$data$yintercept, c(0.95, 0.06))
})
test_that("autoplot(x, what='fit') returns ggplot for ESEM object", {
skip_if_not_installed("ggplot2")
skip_if_not_installed("lavaan")
d <- data.frame(matrix(rnorm(300 * 6), 300, 6))
x <- cached(ackwards(d, k_max = 3, engine = "esem"))
p <- ggplot2::autoplot(x, what = "fit")
expect_s3_class(p, "ggplot")
})
test_that("fit-plot caption names only the plotted indices (M42/m10)", {
skip_if_not_installed("ggplot2")
skip_if_not_installed("psych")
# EFA panels show TLI/RMSEA only; the caption must not list CFI/SRMR cutoffs.
suppressWarnings(
x_efa <- cached(ackwards(psych::bfi[, 1:25], k_max = 3, engine = "efa"))
)
cap_efa <- ggplot2::autoplot(x_efa, what = "fit")$labels$caption
expect_true(grepl("TLI", cap_efa) && grepl("RMSEA", cap_efa))
expect_false(grepl("CFI", cap_efa) || grepl("SRMR", cap_efa))
})
test_that("autoplot(x, what='fit') returns ggplot with informative message for PCA", {
skip_if_not_installed("ggplot2")
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p <- ggplot2::autoplot(x, what = "fit")
expect_s3_class(p, "ggplot")
})
test_that("autoplot(x, what='hierarchy') is unchanged from default", {
skip_if_not_installed("ggplot2")
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3))
p_default <- ggplot2::autoplot(x)
p_explicit <- ggplot2::autoplot(x, what = "hierarchy")
# Both should be ggplots; data-level equality is already tested elsewhere
expect_s3_class(p_default, "ggplot")
expect_s3_class(p_explicit, "ggplot")
})
test_that("autoplot(what='fit') returns empty plot when no kept indices present", {
skip_if_not_installed("ggplot2")
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3, engine = "efa"))
# Strip the EFA fit down to indices the plot does not chart (chi/dof only),
# forcing the "No fit indices available" branch.
for (ki in names(x$levels)) {
x$levels[[ki]]$fit <- c(chi = 1, dof = 1)
}
p <- ggplot2::autoplot(x, what = "fit")
expect_s3_class(p, "ggplot")
})
test_that("autoplot(what='fit') panel titles are engine-aware (EFA: no CFI/SRMR)", {
skip_if_not_installed("ggplot2")
skip_if_not_installed("psych")
x <- cached(ackwards(psych::bfi[, 1:25], k_max = 3, engine = "efa"))
p <- ggplot2::autoplot(x, what = "fit")
panels <- as.character(unique(p$data$panel))
# EFA charts TLI and RMSEA only; titles must not advertise CFI or SRMR.
expect_false(any(grepl("CFI", panels)))
expect_false(any(grepl("SRMR", panels)))
expect_true(any(grepl("TLI", panels)))
expect_true(any(grepl("RMSEA", panels)))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.