tests/testthat/test-layouts-extended.R

In cograph: Analysis and Visualization of Complex Networks

# test-layouts-extended.R - Extended Layout Algorithm Tests
# Additional tests beyond the basic test-layouts.R

# ============================================
# LAYOUT OVAL / ELLIPSE
# ============================================

skip_on_cran()

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)

  nodes1 <- get_nodes(net)
  nodes2 <- get_nodes(net2)

  # Layouts should be different
  expect_false(all(nodes1$x == nodes2$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)
  nodes <- get_nodes(net)

  expect_equal(nrow(nodes), 6)
  expect_true(all(c("x", "y") %in% names(nodes)))
})

# ============================================
# 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)

  nodes <- get_nodes(net2)
  expect_equal(nrow(nodes), 4)
  expect_true(all(c("x", "y") %in% names(nodes)))
})

# ============================================
# 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)
})