# test-layouts-extended.R - Extended Layout Algorithm Tests # Additional tests beyond the basic test-layouts.R # ============================================ # LAYOUT OVAL / ELLIPSE # ============================================ test_that("layout_oval() produces elliptical coordinates", { skip_if_not(exists("layout_oval", envir = asNamespace("cograph"), inherits = FALSE), "layout_oval not available") adj <- create_test_matrix(6) net <- CographNetwork$new(adj) # Check the function signature - it might not have a, b parameters coords <- tryCatch( cograph:::layout_oval(net), error = function(e) NULL ) if (is.null(coords)) skip("layout_oval function signature differs") expect_equal(nrow(coords), 6) expect_true(all(c("x", "y") %in% names(coords))) x_range <- max(coords$x) - min(coords$x) y_range <- max(coords$y) - min(coords$y) expect_true(x_range > 0) expect_true(y_range > 0) }) test_that("splot() works with oval layout", { adj <- create_test_matrix(6) result <- safe_plot(splot(adj, layout = "oval")) expect_true(result$success, info = result$error) }) test_that("layout_oval() accepts custom aspect parameters", { skip_if_not(exists("layout_oval", envir = asNamespace("cograph"), inherits = FALSE), "layout_oval not available") adj <- create_test_matrix(8) net <- CographNetwork$new(adj) # Just test that oval layout works (signature may vary) coords <- tryCatch( cograph:::layout_oval(net), error = function(e) NULL ) if (is.null(coords)) skip("layout_oval function not working") expect_equal(nrow(coords), 8) }) # ============================================ # IGRAPH LAYOUT INTEGRATION # ============================================ test_that("splot() works with igraph kk layout", { skip_if_no_igraph() adj <- create_test_matrix(6) result <- safe_plot(splot(adj, layout = "kk", seed = 42)) expect_true(result$success, info = result$error) }) test_that("splot() works with igraph fr layout", { skip_if_no_igraph() adj <- create_test_matrix(6) result <- safe_plot(splot(adj, layout = "fr", seed = 42)) expect_true(result$success, info = result$error) }) test_that("splot() works with igraph mds layout", { skip_if_no_igraph() adj <- create_test_matrix(6) result <- safe_plot(splot(adj, layout = "mds", seed = 42)) expect_true(result$success, info = result$error) }) test_that("sn_layout() applies igraph layouts correctly", { skip_if_no_igraph() adj <- create_test_matrix(6) net <- cograph(adj, layout = "circle") # Change to igraph layout net2 <- sn_layout(net, "kk", seed = 42) layout1 <- net$network$get_layout() layout2 <- net2$network$get_layout() # Layouts should be different expect_false(all(layout1$x == layout2$x)) }) test_that("cograph() accepts igraph layout function directly", { skip_if_no_igraph() adj <- create_test_matrix(6) net <- cograph(adj, layout = igraph::layout_with_kk) layout <- net$network$get_layout() expect_equal(nrow(layout), 6) expect_true(all(c("x", "y") %in% names(layout))) }) # ============================================ # CUSTOM COORDINATE LAYOUTS # ============================================ test_that("splot() accepts matrix layout coordinates", { adj <- create_test_matrix(4) custom_layout <- matrix(c(0, 1, 0, 1, 0, 0, 1, 1), ncol = 2) result <- safe_plot(splot(adj, layout = custom_layout)) expect_true(result$success, info = result$error) }) test_that("splot() accepts data.frame layout coordinates", { adj <- create_test_matrix(4) custom_layout <- data.frame(x = c(0, 1, 0, 1), y = c(0, 0, 1, 1)) result <- safe_plot(splot(adj, layout = custom_layout)) expect_true(result$success, info = result$error) }) test_that("sn_layout() accepts custom coordinates", { adj <- create_test_matrix(4) net <- cograph(adj) custom_coords <- matrix(c(0.5, 0, 1, 0.5, 0, 0.5, 0.5, 1), ncol = 2) net2 <- sn_layout(net, custom_coords) layout <- net2$network$get_layout() expect_equal(nrow(layout), 4) }) # ============================================ # LAYOUT NORMALIZATION # ============================================ test_that("CographLayout normalizes coordinates to [0,1]", { layout <- CographLayout$new("circle") # Test with coordinates outside [0,1] coords <- data.frame(x = c(-10, 0, 10, 20), y = c(-5, 0, 5, 10)) normalized <- layout$normalize_coords(coords) expect_true(all(normalized$x >= 0 & normalized$x <= 1)) expect_true(all(normalized$y >= 0 & normalized$y <= 1)) }) test_that("CographLayout preserves relative positions during normalization", { layout <- CographLayout$new("circle") coords <- data.frame(x = c(0, 10, 20), y = c(0, 10, 20)) normalized <- layout$normalize_coords(coords) # Middle point should still be in the middle expect_equal(normalized$x[2], mean(c(normalized$x[1], normalized$x[3]))) expect_equal(normalized$y[2], mean(c(normalized$y[1], normalized$y[3]))) }) # ============================================ # LAYOUT REGISTRY # ============================================ test_that("list_layouts() returns all built-in layouts", { layouts <- list_layouts() expect_true("circle" %in% layouts) expect_true("spring" %in% layouts) expect_true("groups" %in% layouts) }) test_that("get_layout() retrieves registered layouts", { circle_fn <- get_layout("circle") expect_true(is.function(circle_fn)) }) test_that("register_layout() registers custom layouts", { custom_layout <- function(network, ...) { n <- network$n_nodes data.frame(x = seq(0, 1, length.out = n), y = rep(0.5, n)) } register_layout("test_linear", custom_layout) expect_true("test_linear" %in% list_layouts()) # Retrieve and verify retrieved <- get_layout("test_linear") expect_true(is.function(retrieved)) }) test_that("custom registered layout works in splot()", { # Register a simple horizontal layout register_layout("test_horizontal", function(network, ...) { n <- network$n_nodes data.frame(x = seq(0, 1, length.out = n), y = rep(0.5, n)) }) adj <- create_test_matrix(4) result <- safe_plot(splot(adj, layout = "test_horizontal")) expect_true(result$success, info = result$error) }) # ============================================ # LAYOUT WITH GROUPS # ============================================ test_that("layout_groups() separates groups spatially", { adj <- matrix(0, 6, 6) # Group 1 internal edges adj[1, 2] <- adj[2, 1] <- 1 # Group 2 internal edges adj[3, 4] <- adj[4, 3] <- 1 # Group 3 internal edges adj[5, 6] <- adj[6, 5] <- 1 net <- CographNetwork$new(adj) groups <- c(1, 1, 2, 2, 3, 3) coords <- layout_groups(net, groups) expect_equal(nrow(coords), 6) # Nodes in same group should be closer than nodes in different groups dist_within_g1 <- sqrt((coords$x[1] - coords$x[2])^2 + (coords$y[1] - coords$y[2])^2) dist_between_g1_g2 <- sqrt((coords$x[1] - coords$x[3])^2 + (coords$y[1] - coords$y[3])^2) expect_true(dist_within_g1 < dist_between_g1_g2) }) test_that("splot() with spring layout and group parameter", { adj <- create_test_matrix(6) groups <- c(1, 1, 2, 2, 3, 3) # Use spring layout with groups (layout = "groups" has known issues) result <- safe_plot(splot(adj, layout = "spring", groups = groups)) expect_true(result$success, info = result$error) }) # ============================================ # SPRING LAYOUT PARAMETERS # ============================================ test_that("layout_spring() accepts iterations parameter", { adj <- create_test_matrix(6) net <- CographNetwork$new(adj) coords_few <- layout_spring(net, iterations = 5, seed = 42) coords_many <- layout_spring(net, iterations = 100, seed = 42) expect_equal(nrow(coords_few), 6) expect_equal(nrow(coords_many), 6) }) test_that("layout_spring() produces deterministic output with seed", { adj <- create_test_matrix(6) net <- CographNetwork$new(adj) coords1 <- layout_spring(net, iterations = 50, seed = 123) coords2 <- layout_spring(net, iterations = 50, seed = 123) expect_equal(coords1$x, coords2$x) expect_equal(coords1$y, coords2$y) }) test_that("layout_spring() produces different output with different seeds", { adj <- create_test_matrix(6) net <- CographNetwork$new(adj) coords1 <- layout_spring(net, iterations = 50, seed = 123) coords2 <- layout_spring(net, iterations = 50, seed = 456) # Very unlikely to be exactly the same expect_false(all(coords1$x == coords2$x)) }) # ============================================ # CIRCLE LAYOUT PROPERTIES # ============================================ test_that("layout_circle() produces equidistant points", { adj <- create_test_matrix(8) net <- CographNetwork$new(adj) coords <- layout_circle(net) expect_equal(nrow(coords), 8) # Calculate center cx <- mean(coords$x) cy <- mean(coords$y) # All points should be same distance from center dists <- sqrt((coords$x - cx)^2 + (coords$y - cy)^2) # All distances should be approximately equal expect_true(max(dists) - min(dists) < 0.01) }) test_that("layout_circle() points are evenly spaced angularly", { adj <- create_test_matrix(6) net <- CographNetwork$new(adj) coords <- layout_circle(net) cx <- mean(coords$x) cy <- mean(coords$y) # Calculate angles angles <- atan2(coords$y - cy, coords$x - cx) angles_sorted <- sort(angles) # Calculate differences (should be ~equal) diffs <- diff(c(angles_sorted, angles_sorted[1] + 2*pi)) # All angular differences should be approximately equal expected_diff <- 2*pi / 6 expect_true(all(abs(diffs - expected_diff) < 0.01)) }) # ============================================ # LAYOUT EDGE CASES # ============================================ test_that("layouts handle single-node network", { adj <- matrix(0, 1, 1) net <- CographNetwork$new(adj) # Circle layout coords_circle <- layout_circle(net) expect_equal(nrow(coords_circle), 1) # Spring layout coords_spring <- layout_spring(net, seed = 42) expect_equal(nrow(coords_spring), 1) }) test_that("layouts handle two-node network", { adj <- matrix(c(0, 1, 1, 0), 2, 2) net <- CographNetwork$new(adj) coords_circle <- layout_circle(net) expect_equal(nrow(coords_circle), 2) # Points should be on opposite sides expect_true(abs(coords_circle$x[1] - coords_circle$x[2]) > 0.5 || abs(coords_circle$y[1] - coords_circle$y[2]) > 0.5) }) test_that("layouts handle disconnected network", { adj <- create_test_topology("disconnected", n = 6) net <- CographNetwork$new(adj) coords_spring <- layout_spring(net, iterations = 50, seed = 42) expect_equal(nrow(coords_spring), 6) }) # ============================================ # LAYOUT SCALE PARAMETER # ============================================ test_that("splot() layout_scale expands layout", { adj <- create_test_matrix(4) # Capture layout from normal run net1 <- with_temp_png(splot(adj, layout_scale = 1, seed = 42)) net2 <- with_temp_png(splot(adj, layout_scale = 1.5, seed = 42)) # Both should work expect_cograph_network(net1) expect_cograph_network(net2) }) test_that("splot() layout_scale contracts layout", { adj <- create_test_matrix(4) result <- safe_plot(splot(adj, layout_scale = 0.7, seed = 42)) expect_true(result$success, info = result$error) }) test_that("splot() layout_scale='auto' works", { adj <- create_test_matrix(4) result <- safe_plot(splot(adj, layout_scale = "auto", seed = 42)) expect_true(result$success, info = result$error) }) # ============================================ # RESCALE PARAMETER # ============================================ test_that("splot() rescale=TRUE normalizes layout", { adj <- create_test_matrix(4) result <- safe_plot(splot(adj, rescale = TRUE)) expect_true(result$success, info = result$error) }) test_that("splot() rescale=FALSE preserves original coordinates", { adj <- create_test_matrix(4) result <- safe_plot(splot(adj, rescale = FALSE)) expect_true(result$success, info = result$error) }) # ============================================ # LAYOUT MARGIN PARAMETER # ============================================ test_that("splot() layout_margin affects spacing", { adj <- create_test_matrix(4) # Zero margin result1 <- safe_plot(splot(adj, layout_margin = 0)) expect_true(result1$success, info = result1$error) # Large margin result2 <- safe_plot(splot(adj, layout_margin = 0.3)) expect_true(result2$success, info = result2$error) })