Nothing
# test-coverage-layout-groups-41.R
# Comprehensive tests for R/layout-groups.R to improve coverage from 95%
# Targets uncovered branches and edge cases
# Series 41 - Complementary to existing series 42 tests
# ============================================
# SETUP: Access internal function
# ============================================
skip_on_cran()
layout_groups <- cograph:::layout_groups
# ============================================
# EMPTY NETWORK TESTS (n == 0 branch, lines 36-37)
# ============================================
test_that("layout_groups returns empty data frame for empty network", {
# Create empty R6 network
empty_net <- CographNetwork$new()
coords <- layout_groups(empty_net, groups = character(0))
expect_true(is.data.frame(coords))
expect_equal(nrow(coords), 0)
expect_equal(ncol(coords), 2)
expect_true("x" %in% names(coords))
expect_true("y" %in% names(coords))
})
test_that("layout_groups empty network returns numeric x and y columns", {
empty_net <- CographNetwork$new()
coords <- layout_groups(empty_net, groups = character(0))
expect_true(is.numeric(coords$x))
expect_true(is.numeric(coords$y))
expect_equal(length(coords$x), 0)
expect_equal(length(coords$y), 0)
})
test_that("layout_groups empty network ignores group_positions parameter", {
empty_net <- CographNetwork$new()
custom_pos <- data.frame(x = c(0.2, 0.8), y = c(0.3, 0.7))
coords <- layout_groups(empty_net, groups = character(0),
group_positions = custom_pos)
expect_equal(nrow(coords), 0)
})
test_that("layout_groups empty network ignores inner_radius parameter", {
empty_net <- CographNetwork$new()
coords <- layout_groups(empty_net, groups = character(0), inner_radius = 0.5)
expect_equal(nrow(coords), 0)
})
test_that("layout_groups empty network ignores outer_radius parameter", {
empty_net <- CographNetwork$new()
coords <- layout_groups(empty_net, groups = character(0), outer_radius = 0.9)
expect_equal(nrow(coords), 0)
})
# ============================================
# EMPTY GROUP IN FACTOR (n_in_group == 0, line 82)
# This is a key uncovered branch
# ============================================
test_that("layout_groups skips factor levels with no nodes", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
# Create factor with an unused level
groups <- factor(c("A", "A", "B", "B"), levels = c("A", "B", "C"))
# Level "C" exists but has no nodes
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
expect_true(all(is.finite(coords$x)))
expect_true(all(is.finite(coords$y)))
})
test_that("layout_groups handles factor with multiple unused levels", {
adj <- create_test_matrix(3)
net <- CographNetwork$new(adj)
# Factor with multiple unused levels
groups <- factor(c("B", "B", "B"), levels = c("A", "B", "C", "D"))
# Levels A, C, D are unused
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 3)
# All nodes should be in a single group, coordinates finite
expect_true(all(is.finite(coords$x)))
expect_true(all(is.finite(coords$y)))
})
test_that("layout_groups skips empty group at beginning of factor levels", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
# Factor where first level is unused
groups <- factor(c("B", "B", "C", "C"), levels = c("A", "B", "C"))
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups skips empty group at end of factor levels", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
# Factor where last level is unused
groups <- factor(c("A", "A", "B", "B"), levels = c("A", "B", "C"))
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups skips empty group in middle of factor levels", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
# Factor where middle level is unused
groups <- factor(c("A", "A", "C", "C"), levels = c("A", "B", "C"))
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups handles factor with all levels unused except one", {
adj <- create_test_matrix(5)
net <- CographNetwork$new(adj)
# Only one level used out of many
groups <- factor(rep("D", 5), levels = c("A", "B", "C", "D", "E"))
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 5)
# Single group, coordinates should be finite
expect_true(all(is.finite(coords$x)))
expect_true(all(is.finite(coords$y)))
})
test_that("layout_groups with factor having alternating used/unused levels", {
adj <- create_test_matrix(6)
net <- CographNetwork$new(adj)
# Alternating: A used, B unused, C used, D unused
groups <- factor(c("A", "A", "A", "C", "C", "C"),
levels = c("A", "B", "C", "D"))
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 6)
})
# ============================================
# FACTOR CONVERSION EDGE CASES (line 46)
# ============================================
test_that("layout_groups converts numeric to factor correctly", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups converts character to factor correctly", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("alpha", "alpha", "beta", "beta")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups preserves factor level order", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
# Factor with explicit level order
groups <- factor(c("Z", "Z", "A", "A"), levels = c("Z", "A"))
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups handles logical converted to factor", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(TRUE, TRUE, FALSE, FALSE)
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
# ============================================
# DATA FRAME GROUP_POSITIONS BRANCH (line 66-67)
# ============================================
test_that("layout_groups accepts data.frame group_positions with rownames", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("G1", "G1", "G2", "G2")
custom_pos <- data.frame(x = c(0.2, 0.8), y = c(0.5, 0.5))
rownames(custom_pos) <- c("G1", "G2")
coords <- layout_groups(net, groups, group_positions = custom_pos)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups accepts data.frame group_positions without rownames", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
custom_pos <- data.frame(x = c(0.3, 0.7), y = c(0.4, 0.6))
coords <- layout_groups(net, groups, group_positions = custom_pos)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups with data.frame group_positions", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
# Data frame with custom positions (also covers tibble which is a subclass)
custom_pos <- data.frame(x = c(0.3, 0.7), y = c(0.4, 0.6))
coords <- layout_groups(net, groups, group_positions = custom_pos)
expect_equal(nrow(coords), 4)
})
# ============================================
# LIST GROUP_POSITIONS CONVERSION (line 69)
# ============================================
test_that("layout_groups converts list to data.frame for group_positions", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
custom_list <- list(x = c(0.25, 0.75), y = c(0.5, 0.5))
coords <- layout_groups(net, groups, group_positions = custom_list)
expect_equal(nrow(coords), 4)
expect_true(is.data.frame(coords))
})
test_that("layout_groups converts named list to data.frame", {
adj <- create_test_matrix(6)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2, 3, 3)
custom_list <- list(
x = c(0.1, 0.5, 0.9),
y = c(0.5, 0.9, 0.5)
)
coords <- layout_groups(net, groups, group_positions = custom_list)
expect_equal(nrow(coords), 6)
})
test_that("layout_groups handles matrix as group_positions via as.data.frame", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
# Matrix will be converted via as.data.frame
custom_mat <- matrix(c(0.2, 0.8, 0.5, 0.5), ncol = 2)
colnames(custom_mat) <- c("x", "y")
coords <- layout_groups(net, groups, group_positions = custom_mat)
expect_equal(nrow(coords), 4)
})
# ============================================
# SINGLE NODE IN GROUP (line 89-92)
# ============================================
test_that("layout_groups places single node at exact group center", {
adj <- create_test_matrix(1)
net <- CographNetwork$new(adj)
groups <- c("solo")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 1)
# Single group centered at (0.5, 0.5)
expect_equal(coords$x[1], 0.5)
expect_equal(coords$y[1], 0.5)
})
test_that("layout_groups places singleton in each group at group centers", {
adj <- create_test_matrix(3)
net <- CographNetwork$new(adj)
groups <- c("A", "B", "C") # Each node is alone in its group
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 3)
# Each node should be exactly at its group center
})
test_that("layout_groups mixed groups with singletons", {
adj <- create_test_matrix(5)
net <- CographNetwork$new(adj)
groups <- c("big", "big", "big", "small", "tiny")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 5)
# Verify coordinates are reasonable
expect_true(all(is.finite(coords$x)))
expect_true(all(is.finite(coords$y)))
})
# ============================================
# MULTIPLE NODES IN GROUP (lines 94-98)
# ============================================
test_that("layout_groups arranges two nodes in group correctly", {
adj <- matrix(c(0, 1, 1, 0), 2, 2)
net <- CographNetwork$new(adj)
groups <- c("A", "A")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 2)
# Both should be around center with inner_radius spacing
center_x <- mean(coords$x)
center_y <- mean(coords$y)
expect_equal(center_x, 0.5, tolerance = 0.01)
expect_equal(center_y, 0.5, tolerance = 0.01)
})
test_that("layout_groups arranges three nodes in group as triangle", {
adj <- create_test_matrix(3)
net <- CographNetwork$new(adj)
groups <- c("only", "only", "only")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 3)
# All at equal distance from center
center_x <- mean(coords$x)
center_y <- mean(coords$y)
dists <- sqrt((coords$x - center_x)^2 + (coords$y - center_y)^2)
expect_equal(max(dists) - min(dists), 0, tolerance = 0.001)
})
test_that("layout_groups arranges large group circularly", {
adj <- create_test_matrix(20)
net <- CographNetwork$new(adj)
groups <- rep("large", 20)
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 20)
# All at equal distance from center
center_x <- mean(coords$x)
center_y <- mean(coords$y)
dists <- sqrt((coords$x - center_x)^2 + (coords$y - center_y)^2)
expect_equal(max(dists) - min(dists), 0, tolerance = 0.001)
})
# ============================================
# SINGLE GROUP (n_groups == 1, lines 52-54)
# ============================================
test_that("layout_groups single group centers at (0.5, 0.5)", {
adj <- create_test_matrix(5)
net <- CographNetwork$new(adj)
groups <- rep("only_group", 5)
coords <- layout_groups(net, groups)
expect_equal(mean(coords$x), 0.5, tolerance = 0.001)
expect_equal(mean(coords$y), 0.5, tolerance = 0.001)
})
test_that("layout_groups single group ignores outer_radius", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- rep(1, 4)
coords1 <- layout_groups(net, groups, outer_radius = 0.1)
coords2 <- layout_groups(net, groups, outer_radius = 0.9)
# Both should be centered at (0.5, 0.5) regardless of outer_radius
expect_equal(mean(coords1$x), mean(coords2$x))
expect_equal(mean(coords1$y), mean(coords2$y))
})
test_that("layout_groups single group uses inner_radius", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- rep(1, 4)
coords_small <- layout_groups(net, groups, inner_radius = 0.1)
coords_large <- layout_groups(net, groups, inner_radius = 0.3)
# Larger inner_radius should spread nodes more
spread_small <- max(coords_small$x) - min(coords_small$x)
spread_large <- max(coords_large$x) - min(coords_large$x)
expect_true(spread_large > spread_small)
})
# ============================================
# MULTIPLE GROUPS (n_groups > 1, lines 56-62)
# ============================================
test_that("layout_groups two groups positioned on circle", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords <- layout_groups(net, groups)
# Group centers should be equidistant from (0.5, 0.5)
g_a_center <- c(mean(coords$x[1:2]), mean(coords$y[1:2]))
g_b_center <- c(mean(coords$x[3:4]), mean(coords$y[3:4]))
dist_a <- sqrt((g_a_center[1] - 0.5)^2 + (g_a_center[2] - 0.5)^2)
dist_b <- sqrt((g_b_center[1] - 0.5)^2 + (g_b_center[2] - 0.5)^2)
expect_equal(dist_a, dist_b, tolerance = 0.01)
})
test_that("layout_groups three groups form triangle", {
adj <- create_test_matrix(6)
net <- CographNetwork$new(adj)
groups <- c("X", "X", "Y", "Y", "Z", "Z")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 6)
})
test_that("layout_groups five groups evenly distributed", {
adj <- create_test_matrix(10)
net <- CographNetwork$new(adj)
groups <- rep(1:5, each = 2)
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 10)
})
test_that("layout_groups many groups (10) still work", {
adj <- create_test_matrix(20)
net <- CographNetwork$new(adj)
groups <- rep(1:10, each = 2)
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 20)
})
# ============================================
# ANGLE CALCULATIONS (lines 57-58, 95-96)
# ============================================
test_that("layout_groups groups start at pi/2 (top)", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords <- layout_groups(net, groups, inner_radius = 0)
# First group should be at top (y > 0.5)
g_a_center_y <- mean(coords$y[1:2])
expect_true(g_a_center_y > 0.5)
})
test_that("layout_groups within-group nodes start at pi/2", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- rep("single", 4)
coords <- layout_groups(net, groups)
# First node should be at top of the circle
# (highest y relative to center)
center_y <- mean(coords$y)
expect_equal(which.max(coords$y), 1)
})
# ============================================
# INNER RADIUS PARAMETER (line 97-98)
# ============================================
test_that("layout_groups inner_radius = 0 collapses nodes", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords <- layout_groups(net, groups, inner_radius = 0)
# Nodes in same group should be at same position
expect_equal(coords$x[1], coords$x[2])
expect_equal(coords$y[1], coords$y[2])
expect_equal(coords$x[3], coords$x[4])
expect_equal(coords$y[3], coords$y[4])
})
test_that("layout_groups inner_radius very small", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords <- layout_groups(net, groups, inner_radius = 0.001)
expect_equal(nrow(coords), 4)
# Nodes should be very close
dist_a <- sqrt((coords$x[1] - coords$x[2])^2 + (coords$y[1] - coords$y[2])^2)
expect_true(dist_a < 0.01)
})
test_that("layout_groups inner_radius very large", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords <- layout_groups(net, groups, inner_radius = 0.5)
expect_equal(nrow(coords), 4)
# Nodes should be spread out
dist_a <- sqrt((coords$x[1] - coords$x[2])^2 + (coords$y[1] - coords$y[2])^2)
expect_true(dist_a > 0.3)
})
# ============================================
# OUTER RADIUS PARAMETER (lines 60-61)
# ============================================
test_that("layout_groups outer_radius = 0 collapses groups", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords <- layout_groups(net, groups, outer_radius = 0)
# Group centers should be at (0.5, 0.5)
g_a_center <- c(mean(coords$x[1:2]), mean(coords$y[1:2]))
g_b_center <- c(mean(coords$x[3:4]), mean(coords$y[3:4]))
expect_equal(g_a_center[1], 0.5, tolerance = 0.2) # Close to center
expect_equal(g_b_center[1], 0.5, tolerance = 0.2)
})
test_that("layout_groups outer_radius affects group separation", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords_small <- layout_groups(net, groups, outer_radius = 0.1)
coords_large <- layout_groups(net, groups, outer_radius = 0.4)
# Calculate distance between group centers
dist_small <- sqrt(
(mean(coords_small$x[1:2]) - mean(coords_small$x[3:4]))^2 +
(mean(coords_small$y[1:2]) - mean(coords_small$y[3:4]))^2
)
dist_large <- sqrt(
(mean(coords_large$x[1:2]) - mean(coords_large$x[3:4]))^2 +
(mean(coords_large$y[1:2]) - mean(coords_large$y[3:4]))^2
)
expect_true(dist_large > dist_small)
})
# ============================================
# ROWNAMES ON GROUP_CENTERS (line 64)
# ============================================
test_that("layout_groups sets rownames on computed group_centers", {
adj <- create_test_matrix(6)
net <- CographNetwork$new(adj)
groups <- c("alpha", "alpha", "beta", "beta", "gamma", "gamma")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 6)
# Internal group_centers should have rownames matching group levels
})
test_that("layout_groups rownames handle numeric group names", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(10, 10, 20, 20)
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
# ============================================
# GROUP INDEX MATCHING (line 85)
# ============================================
test_that("layout_groups matches group index correctly", {
adj <- create_test_matrix(6)
net <- CographNetwork$new(adj)
groups <- c("B", "B", "A", "A", "C", "C")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 6)
# Groups should be positioned based on factor level order (A, B, C)
})
test_that("layout_groups handles non-alphabetical factor levels", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- factor(c("Z", "Z", "A", "A"), levels = c("Z", "A"))
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
# ============================================
# INTEGRATION WITH COGRAPH/SPLOT
# ============================================
test_that("cograph with groups layout works", {
adj <- create_test_matrix(6)
groups <- c(1, 1, 2, 2, 3, 3)
net <- cograph(adj, layout = "groups", groups = groups)
expect_cograph_network(net)
expect_equal(n_nodes(net), 6)
})
test_that("splot with groups layout plots using pre-computed coords", {
adj <- create_test_matrix(6)
groups <- c(1, 1, 2, 2, 3, 3)
net <- CographNetwork$new(adj)
coords <- layout_groups(net, groups)
result <- safe_plot(splot(adj, layout = as.matrix(coords[, c("x", "y")])))
expect_true(result$success, info = result$error)
})
test_that("splot with groups and custom radii works via pre-computed coords", {
adj <- create_test_matrix(6)
groups <- c("X", "X", "Y", "Y", "Z", "Z")
net <- CographNetwork$new(adj)
coords <- layout_groups(net, groups, inner_radius = 0.2, outer_radius = 0.4)
result <- safe_plot(splot(adj, layout = as.matrix(coords[, c("x", "y")])))
expect_true(result$success, info = result$error)
})
# ============================================
# COORDINATE VALIDATION
# ============================================
test_that("layout_groups produces finite coordinates", {
adj <- create_test_matrix(10)
net <- CographNetwork$new(adj)
groups <- rep(1:5, each = 2)
coords <- layout_groups(net, groups)
expect_true(all(is.finite(coords$x)))
expect_true(all(is.finite(coords$y)))
expect_false(any(is.na(coords$x)))
expect_false(any(is.na(coords$y)))
})
test_that("layout_groups coordinates are reasonable range", {
adj <- create_test_matrix(12)
net <- CographNetwork$new(adj)
groups <- rep(1:4, each = 3)
coords <- layout_groups(net, groups)
# With default params, should be in approx [0, 1]
expect_true(all(coords$x > -0.5 & coords$x < 1.5))
expect_true(all(coords$y > -0.5 & coords$y < 1.5))
})
# ============================================
# REPRODUCIBILITY
# ============================================
test_that("layout_groups is deterministic", {
adj <- create_test_matrix(8)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2, 3, 3, 4, 4)
coords1 <- layout_groups(net, groups)
coords2 <- layout_groups(net, groups)
expect_identical(coords1, coords2)
})
test_that("layout_groups same result with different parameter defaults", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords_default <- layout_groups(net, groups)
coords_explicit <- layout_groups(net, groups,
inner_radius = 0.15,
outer_radius = 0.35)
expect_identical(coords_default, coords_explicit)
})
# ============================================
# EDGE CASES WITH SPECIAL VALUES
# ============================================
test_that("layout_groups handles groups with spaces", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("Group One", "Group One", "Group Two", "Group Two")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups handles unicode group names", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("Alpha", "Alpha", "Beta", "Beta")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups handles single character group names", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
# ============================================
# S3 COGRAPH_NETWORK SUPPORT
# ============================================
test_that("layout_groups works with S3 cograph_network", {
adj <- create_test_matrix(6)
net <- as_cograph(adj)
expect_true(inherits(net, "cograph_network"))
coords <- layout_groups(net, groups = c(1, 1, 2, 2, 3, 3))
expect_equal(nrow(coords), 6)
expect_true(all(c("x", "y") %in% names(coords)))
})
test_that("layout_groups uses n_nodes() method for S3 network", {
adj <- create_test_matrix(5)
net <- as_cograph(adj)
expect_equal(n_nodes(net), 5)
coords <- layout_groups(net, groups = c(1, 1, 1, 2, 2))
expect_equal(nrow(coords), 5)
})
# ============================================
# EXTREME PARAMETER VALUES
# ============================================
test_that("layout_groups handles negative inner_radius", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
# Negative radius should still produce coords (reversed direction)
coords <- layout_groups(net, groups, inner_radius = -0.1)
expect_equal(nrow(coords), 4)
expect_true(all(is.finite(coords$x)))
})
test_that("layout_groups handles negative outer_radius", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
coords <- layout_groups(net, groups, outer_radius = -0.2)
expect_equal(nrow(coords), 4)
expect_true(all(is.finite(coords$x)))
})
test_that("layout_groups handles very large radii", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
coords <- layout_groups(net, groups, inner_radius = 10, outer_radius = 100)
expect_equal(nrow(coords), 4)
expect_true(all(is.finite(coords$x)))
})
# ============================================
# COMPLEX SCENARIOS
# ============================================
test_that("layout_groups with uneven group sizes", {
adj <- create_test_matrix(10)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 1, 1, 1, 2, 2, 2, 3, 3) # 5, 3, 2
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 10)
})
test_that("layout_groups with many small groups", {
adj <- create_test_matrix(12)
net <- CographNetwork$new(adj)
groups <- rep(1:6, each = 2)
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 12)
})
test_that("layout_groups with one large group and many singletons", {
adj <- create_test_matrix(8)
net <- CographNetwork$new(adj)
groups <- c("big", "big", "big", "big", "s1", "s2", "s3", "s4")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 8)
})
# ============================================
# CUSTOM GROUP POSITIONS WITH UNUSED LEVELS
# ============================================
test_that("layout_groups custom positions with factor unused levels", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
# Factor with unused level
groups <- factor(c("A", "A", "C", "C"), levels = c("A", "B", "C"))
# Provide positions for all levels including unused
custom_pos <- data.frame(
x = c(0.2, 0.5, 0.8),
y = c(0.5, 0.5, 0.5)
)
rownames(custom_pos) <- c("A", "B", "C")
coords <- layout_groups(net, groups, group_positions = custom_pos)
expect_equal(nrow(coords), 4)
})
# ============================================
# DATA FRAME RETURN STRUCTURE
# ============================================
test_that("layout_groups returns proper data.frame class", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
coords <- layout_groups(net, groups)
expect_s3_class(coords, "data.frame")
expect_named(coords, c("x", "y"))
})
test_that("layout_groups x and y are double type", {
adj <- create_test_matrix(4)
net <- CographNetwork$new(adj)
groups <- c(1, 1, 2, 2)
coords <- layout_groups(net, groups)
expect_type(coords$x, "double")
expect_type(coords$y, "double")
})
# ============================================
# WEIGHTED NETWORK SUPPORT
# ============================================
test_that("layout_groups works with weighted network", {
adj <- create_test_matrix(4, weighted = TRUE)
net <- CographNetwork$new(adj)
groups <- c("A", "A", "B", "B")
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
test_that("layout_groups works with directed network", {
adj <- create_test_matrix(4, symmetric = FALSE)
net <- CographNetwork$new(adj, directed = TRUE)
groups <- c(1, 1, 2, 2)
coords <- layout_groups(net, groups)
expect_equal(nrow(coords), 4)
})
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.