tests/testthat/test-coverage-layout-registry-41.R

# =============================================================================
# Test Coverage for layout-registry.R (Additional Tests - File 41)
# =============================================================================
# Comprehensive additional tests focusing on edge cases, parameter variations,
# and interactions with different network types.
# Focus: register_layout, get_layout, list_layouts and built-in layout functions

# Helper function to create mock network with specific n_nodes
skip_on_cran()

create_mock_network <- function(n = 5) {
  net <- list(n_nodes = n)
  class(net) <- "CographNetwork"
  net
}

# Helper function to create R6 CographNetwork
create_r6_network <- function(n = 5, edges = TRUE) {
  mat <- matrix(0, n, n)
  if (edges && n > 1) {
    for (i in 1:(n - 1)) {
      mat[i, i + 1] <- 1
      mat[i + 1, i] <- 1
    }
  }
  rownames(mat) <- colnames(mat) <- paste0("N", 1:n)
  CographNetwork$new(mat)
}

# Helper to create cograph_network (lightweight)
create_lightweight_network <- function(n = 5, edges = TRUE) {
  mat <- matrix(0, n, n)
  if (edges && n > 1) {
    for (i in 1:(n - 1)) {
      mat[i, i + 1] <- 1
      mat[i + 1, i] <- 1
    }
  }
  rownames(mat) <- colnames(mat) <- paste0("N", 1:n)
  as_cograph(mat)
}

# =============================================================================
# Test: register_layout function validation
# =============================================================================

test_that("register_layout validates function parameter strictly", {
  expect_error(
    register_layout("test_bad_1", "not_a_function"),
    "layout_fn must be a function"
  )

  expect_error(
    register_layout("test_bad_2", 123),
    "layout_fn must be a function"
  )

  expect_error(
    register_layout("test_bad_3", list(a = 1)),
    "layout_fn must be a function"
  )

  expect_error(
    register_layout("test_bad_4", NULL),
    "layout_fn must be a function"
  )

  expect_error(
    register_layout("test_bad_5", NA),
    "layout_fn must be a function"
  )
})

test_that("register_layout accepts valid functions", {
  # Simple function
  fn1 <- function(network, ...) {
    data.frame(x = 0.5, y = 0.5)
  }
  expect_silent(register_layout("test_valid_1", fn1))
  expect_true("test_valid_1" %in% list_layouts())

  # Anonymous function
  expect_silent(register_layout("test_valid_2", function(network, ...) {
    data.frame(x = 0, y = 0)
  }))
  expect_true("test_valid_2" %in% list_layouts())

  # Function with default parameters
  fn3 <- function(network, param1 = 10, param2 = "abc", ...) {
    n <- network$n_nodes
    data.frame(x = rep(0.5, n), y = rep(0.5, n))
  }
  expect_silent(register_layout("test_valid_3", fn3))
  expect_true("test_valid_3" %in% list_layouts())
})

test_that("register_layout returns invisible NULL", {
  fn <- function(network, ...) data.frame(x = 0, y = 0)
  result <- register_layout("test_return", fn)
  expect_null(result)
})

test_that("register_layout can overwrite existing layout multiple times", {
  original <- get_layout("grid")

  # First overwrite
  fn1 <- function(network, ...) data.frame(x = 0.1, y = 0.1)
  register_layout("grid", fn1)
  expect_equal(get_layout("grid")(create_mock_network(1))$x, 0.1)

  # Second overwrite
  fn2 <- function(network, ...) data.frame(x = 0.2, y = 0.2)
  register_layout("grid", fn2)
  expect_equal(get_layout("grid")(create_mock_network(1))$x, 0.2)

  # Restore original
  register_layout("grid", original)
})

# =============================================================================
# Test: get_layout function
# =============================================================================

test_that("get_layout returns NULL for non-existent layouts", {
  expect_null(get_layout("nonexistent_layout_xyz_123"))
  expect_null(get_layout(""))
  expect_null(get_layout("   "))
})

test_that("get_layout returns functions for all built-in layouts", {
  expected_layouts <- c(
    "circle", "oval", "ellipse", "spring", "fr", "fruchterman-reingold",
    "groups", "grid", "random", "star", "bipartite", "custom",
    "gephi_fr", "gephi"
  )

  for (name in expected_layouts) {
    fn <- get_layout(name)
    expect_true(is.function(fn), info = paste("Layout not a function:", name))
  }
})

test_that("get_layout is case-sensitive", {
  expect_true(is.function(get_layout("circle")))
  expect_null(get_layout("CIRCLE"))
  expect_null(get_layout("Circle"))
})

# =============================================================================
# Test: list_layouts function
# =============================================================================

test_that("list_layouts returns character vector", {
  layouts <- list_layouts()
  expect_true(is.character(layouts))
  expect_true(length(layouts) > 0)
})

test_that("list_layouts contains all built-in layouts", {
  layouts <- list_layouts()
  expected <- c(
    "circle", "oval", "ellipse", "spring", "fr", "fruchterman-reingold",
    "groups", "grid", "random", "star", "bipartite", "custom",
    "gephi_fr", "gephi"
  )

  for (name in expected) {
    expect_true(name %in% layouts, info = paste("Missing:", name))
  }
})

test_that("list_layouts reflects newly registered layouts", {
  initial_count <- length(list_layouts())

  register_layout("test_new_layout_xyz", function(network, ...) {
    data.frame(x = 0, y = 0)
  })

  expect_true("test_new_layout_xyz" %in% list_layouts())
  expect_equal(length(list_layouts()), initial_count + 1)
})

# =============================================================================
# Test: Grid Layout - Extended Edge Cases
# =============================================================================

test_that("grid layout handles ncol = 1 (single column)", {
  net <- create_mock_network(5)
  grid_fn <- get_layout("grid")
  coords <- grid_fn(net, ncol = 1)

  expect_equal(nrow(coords), 5)
  expect_equal(length(unique(coords$x)), 1)
  expect_equal(length(unique(coords$y)), 5)
})

test_that("grid layout handles ncol greater than n_nodes", {
  net <- create_mock_network(3)
  grid_fn <- get_layout("grid")
  coords <- grid_fn(net, ncol = 10)

  expect_equal(nrow(coords), 3)
  expect_true(all(coords$y == coords$y[1]))
})

test_that("grid layout handles perfect square node count", {
  net <- create_mock_network(16)
  grid_fn <- get_layout("grid")
  coords <- grid_fn(net)

  expect_equal(nrow(coords), 16)
  expect_equal(length(unique(coords$x)), 4)
  expect_equal(length(unique(coords$y)), 4)
})

test_that("grid layout returns empty for 0 nodes", {
  net <- create_mock_network(0)
  grid_fn <- get_layout("grid")
  coords <- grid_fn(net)

  expect_equal(nrow(coords), 0)
  expect_true("x" %in% names(coords))
  expect_true("y" %in% names(coords))
})

test_that("grid layout returns center for 1 node", {
  net <- create_mock_network(1)
  grid_fn <- get_layout("grid")
  coords <- grid_fn(net)

  expect_equal(nrow(coords), 1)
  expect_equal(coords$x[1], 0.5)
  expect_equal(coords$y[1], 0.5)
})

test_that("grid layout ncol = n gives single row", {
  net <- create_mock_network(4)
  grid_fn <- get_layout("grid")
  coords <- grid_fn(net, ncol = 4)

  expect_equal(length(unique(coords$y)), 1)
  expect_equal(length(unique(coords$x)), 4)
})

# =============================================================================
# Test: Random Layout - Comprehensive Tests
# =============================================================================

test_that("random layout produces reproducible results with seed", {
  net <- create_mock_network(10)
  random_fn <- get_layout("random")

  coords1 <- random_fn(net, seed = 42)
  coords2 <- random_fn(net, seed = 42)

  expect_equal(coords1$x, coords2$x)
  expect_equal(coords1$y, coords2$y)
})

test_that("random layout works with seed = 0", {
  net <- create_mock_network(5)
  random_fn <- get_layout("random")

  coords1 <- random_fn(net, seed = 0)
  coords2 <- random_fn(net, seed = 0)

  expect_equal(coords1$x, coords2$x)
})

test_that("random layout produces values in correct range", {
  net <- create_mock_network(100)
  random_fn <- get_layout("random")
  coords <- random_fn(net, seed = 123)

  expect_true(all(coords$x >= 0.1 & coords$x <= 0.9))
  expect_true(all(coords$y >= 0.1 & coords$y <= 0.9))
})

test_that("random layout handles zero nodes", {
  net <- create_mock_network(0)
  random_fn <- get_layout("random")
  coords <- random_fn(net, seed = 42)

  expect_equal(nrow(coords), 0)
})

# =============================================================================
# Test: Star Layout - Comprehensive Tests
# =============================================================================

test_that("star layout returns empty for 0 nodes", {
  net <- create_mock_network(0)
  star_fn <- get_layout("star")
  coords <- star_fn(net)

  expect_equal(nrow(coords), 0)
})

test_that("star layout returns center for 1 node", {
  net <- create_mock_network(1)
  star_fn <- get_layout("star")
  coords <- star_fn(net)

  expect_equal(nrow(coords), 1)
  expect_equal(coords$x[1], 0.5)
  expect_equal(coords$y[1], 0.5)
})

test_that("star layout with 2 nodes places center correctly", {
  net <- create_mock_network(2)
  star_fn <- get_layout("star")

  # Center at node 1
 coords1 <- star_fn(net, center = 1)
  expect_equal(coords1$x[1], 0.5)
  expect_equal(coords1$y[1], 0.5)

  # Center at node 2
  coords2 <- star_fn(net, center = 2)
  expect_equal(coords2$x[2], 0.5)
  expect_equal(coords2$y[2], 0.5)
})

test_that("star layout places outer nodes at correct radius", {
  net <- create_mock_network(5)
  star_fn <- get_layout("star")
  coords <- star_fn(net, center = 1)

  for (i in 2:5) {
    dist <- sqrt((coords$x[i] - 0.5)^2 + (coords$y[i] - 0.5)^2)
    expect_equal(dist, 0.4, tolerance = 0.001)
  }
})

test_that("star layout outer nodes are evenly spaced", {
  net <- create_mock_network(5)
  star_fn <- get_layout("star")
  coords <- star_fn(net, center = 1)

  outer_idx <- 2:5
  angles <- atan2(coords$y[outer_idx] - 0.5, coords$x[outer_idx] - 0.5)
  angles_sorted <- sort(angles)

  diffs <- diff(c(angles_sorted, angles_sorted[1] + 2 * pi))
  expected_diff <- 2 * pi / 4

  for (d in diffs) {
    expect_equal(d, expected_diff, tolerance = 0.01)
  }
})

test_that("star layout works with center at last node", {
  net <- create_mock_network(6)
  star_fn <- get_layout("star")
  coords <- star_fn(net, center = 6)

  expect_equal(coords$x[6], 0.5)
  expect_equal(coords$y[6], 0.5)

  for (i in 1:5) {
    dist <- sqrt((coords$x[i] - 0.5)^2 + (coords$y[i] - 0.5)^2)
    expect_equal(dist, 0.4, tolerance = 0.001)
  }
})

# =============================================================================
# Test: Bipartite Layout - Comprehensive Tests
# =============================================================================

test_that("bipartite layout returns empty for 0 nodes", {
  net <- create_mock_network(0)
  bipartite_fn <- get_layout("bipartite")
  coords <- bipartite_fn(net)

  expect_equal(nrow(coords), 0)
})

test_that("bipartite layout uses default alternating types", {
  net <- create_mock_network(4)
  bipartite_fn <- get_layout("bipartite")
  coords <- bipartite_fn(net)

  expect_equal(coords$x[1], 0.2)
  expect_equal(coords$x[2], 0.8)
  expect_equal(coords$x[3], 0.2)
  expect_equal(coords$x[4], 0.8)
})

test_that("bipartite layout handles all same type (type1 only)", {
  net <- create_mock_network(4)
  bipartite_fn <- get_layout("bipartite")
  types <- c(0, 0, 0, 0)
  coords <- bipartite_fn(net, types = types)

  expect_equal(nrow(coords), 4)
  expect_true(all(coords$x == 0.2))
})

test_that("bipartite layout handles all same type (type2 only)", {
  net <- create_mock_network(4)
  bipartite_fn <- get_layout("bipartite")
  # First unique type becomes type1 (left), second becomes type2 (right)
  types <- c(1, 1, 1, 1)
  coords <- bipartite_fn(net, types = types)

  expect_equal(nrow(coords), 4)
  # All on left since there's only one type
  expect_true(all(coords$x == 0.2))
})

test_that("bipartite layout vertical spacing is correct", {
  net <- create_mock_network(6)
  bipartite_fn <- get_layout("bipartite")
  types <- c(0, 0, 0, 1, 1, 1)
  coords <- bipartite_fn(net, types = types)

  expect_equal(coords$y[1], 0.9)
  expect_equal(coords$y[2], 0.5)
  expect_equal(coords$y[3], 0.1)
  expect_equal(coords$y[4], 0.9)
  expect_equal(coords$y[5], 0.5)
  expect_equal(coords$y[6], 0.1)
})

test_that("bipartite layout handles single node per side", {
  net <- create_mock_network(2)
  bipartite_fn <- get_layout("bipartite")
  types <- c(0, 1)
  coords <- bipartite_fn(net, types = types)

  expect_equal(nrow(coords), 2)
  expect_equal(coords$x[1], 0.2)
  expect_equal(coords$x[2], 0.8)
})

test_that("bipartite layout handles character types", {
  net <- create_mock_network(4)
  bipartite_fn <- get_layout("bipartite")
  types <- c("left", "left", "right", "right")
  coords <- bipartite_fn(net, types = types)

  expect_equal(nrow(coords), 4)
  expect_equal(coords$x[1], 0.2)
  expect_equal(coords$x[3], 0.8)
})

test_that("bipartite layout handles factor types", {
  net <- create_mock_network(4)
  bipartite_fn <- get_layout("bipartite")
  types <- factor(c("A", "A", "B", "B"))
  coords <- bipartite_fn(net, types = types)

  expect_equal(nrow(coords), 4)
})

# =============================================================================
# Test: Custom Layout - Comprehensive Tests
# =============================================================================

test_that("custom layout accepts matrix input", {
  net <- create_mock_network(3)
  custom_fn <- get_layout("custom")

  custom_coords <- matrix(c(0.1, 0.5, 0.9, 0.2, 0.5, 0.8), ncol = 2)
  coords <- custom_fn(net, coords = custom_coords)

  expect_equal(nrow(coords), 3)
  expect_equal(coords$x[1], 0.1)
  expect_equal(coords$y[1], 0.2)
})

test_that("custom layout accepts data frame input", {
  net <- create_mock_network(3)
  custom_fn <- get_layout("custom")

  custom_coords <- data.frame(a = c(0.1, 0.5, 0.9), b = c(0.2, 0.5, 0.8))
  coords <- custom_fn(net, coords = custom_coords)

  expect_true("x" %in% names(coords))
  expect_true("y" %in% names(coords))
  expect_equal(coords$x[1], 0.1)
  expect_equal(coords$y[1], 0.2)
})

test_that("custom layout preserves existing x/y names", {
  net <- create_mock_network(3)
  custom_fn <- get_layout("custom")

  custom_coords <- data.frame(x = c(0.1, 0.5, 0.9), y = c(0.2, 0.5, 0.8))
  coords <- custom_fn(net, coords = custom_coords)

  expect_equal(coords$x, c(0.1, 0.5, 0.9))
  expect_equal(coords$y, c(0.2, 0.5, 0.8))
})

test_that("custom layout handles matrix with extra columns", {
  net <- create_mock_network(3)
  custom_fn <- get_layout("custom")

  mat <- matrix(1:9, ncol = 3)
  coords <- custom_fn(net, coords = mat)

  expect_equal(nrow(coords), 3)
  expect_true("x" %in% names(coords))
  expect_true("y" %in% names(coords))
})

# =============================================================================
# Test: Gephi FR Layout - Comprehensive Tests
# =============================================================================

test_that("gephi_fr layout returns empty for 0 nodes", {
  skip_if_not_installed("igraph")

  # Create empty mock network for gephi function (direct call)
  gephi_fn <- get_layout("gephi_fr")

  # Call with mock network that has 0 nodes
  net_mock <- list(n_nodes = 0)
  class(net_mock) <- "CographNetwork"

  # The gephi_fr internally uses network_to_igraph, so we skip this test
  # since empty networks can't be properly converted
  skip("Empty networks require special handling in network_to_igraph")
})

test_that("gephi_fr layout handles network with no edges", {
  skip_if_not_installed("igraph")

  mat <- matrix(0, 5, 5)
  rownames(mat) <- colnames(mat) <- paste0("N", 1:5)
  net <- CographNetwork$new(mat)

  gephi_fn <- get_layout("gephi_fr")
  coords <- gephi_fn(net, niter = 10)

  expect_equal(nrow(coords), 5)
  expect_true(all(is.finite(coords$x)))
  expect_true(all(is.finite(coords$y)))
})

test_that("gephi_fr layout works with single node", {
  skip_if_not_installed("igraph")

  mat <- matrix(0, 1, 1)
  rownames(mat) <- colnames(mat) <- "A"
  net <- CographNetwork$new(mat)

  gephi_fn <- get_layout("gephi_fr")
  coords <- gephi_fn(net, niter = 5)

  expect_equal(nrow(coords), 1)
})

test_that("gephi_fr layout works with dense network", {
  skip_if_not_installed("igraph")

  n <- 6
  mat <- matrix(1, n, n)
  diag(mat) <- 0
  rownames(mat) <- colnames(mat) <- paste0("N", 1:n)
  net <- CographNetwork$new(mat)

  gephi_fn <- get_layout("gephi_fr")
  coords <- gephi_fn(net, niter = 20)

  expect_equal(nrow(coords), n)
  expect_true(all(is.finite(coords$x)))
  expect_true(all(is.finite(coords$y)))
})

test_that("gephi_fr layout handles weighted edges", {
  skip_if_not_installed("igraph")

  mat <- matrix(0, 4, 4)
  mat[1, 2] <- mat[2, 1] <- 0.5
  mat[2, 3] <- mat[3, 2] <- 1.0
  mat[3, 4] <- mat[4, 3] <- 2.0
  rownames(mat) <- colnames(mat) <- paste0("N", 1:4)
  net <- CographNetwork$new(mat)

  gephi_fn <- get_layout("gephi_fr")
  coords <- gephi_fn(net, niter = 15)

  expect_equal(nrow(coords), 4)
})

test_that("gephi_fr layout respects all parameters", {
  skip_if_not_installed("igraph")

  net <- create_r6_network(5)
  gephi_fn <- get_layout("gephi_fr")

  # Test various parameter combinations
  coords1 <- gephi_fn(net, area = 5000, gravity = 5.0, speed = 0.5, niter = 10)
  coords2 <- gephi_fn(net, area = 20000, gravity = 20.0, speed = 2.0, niter = 10)

  expect_equal(nrow(coords1), 5)
  expect_equal(nrow(coords2), 5)
})

test_that("gephi_fr layout handles extreme parameters", {
  skip_if_not_installed("igraph")

  net <- create_r6_network(4)
  gephi_fn <- get_layout("gephi_fr")

  # Very high gravity
  coords1 <- gephi_fn(net, gravity = 100, niter = 5)
  expect_equal(nrow(coords1), 4)

  # Very low gravity
  coords2 <- gephi_fn(net, gravity = 0.01, niter = 5)
  expect_equal(nrow(coords2), 4)

  # Very high speed
  coords3 <- gephi_fn(net, speed = 10, niter = 5)
  expect_equal(nrow(coords3), 4)

  # Very small area
  coords4 <- gephi_fn(net, area = 10, niter = 5)
  expect_equal(nrow(coords4), 4)
})

test_that("gephi alias works same as gephi_fr", {
  skip_if_not_installed("igraph")

  net <- create_r6_network(4)
  gephi_fn <- get_layout("gephi")
  gephi_fr_fn <- get_layout("gephi_fr")

  expect_true(is.function(gephi_fn))
  expect_true(is.function(gephi_fr_fn))

  coords1 <- gephi_fn(net, niter = 5)
  coords2 <- gephi_fr_fn(net, niter = 5)

  expect_equal(nrow(coords1), nrow(coords2))
})

# =============================================================================
# Test: Layout Aliases
# =============================================================================

test_that("oval and ellipse are aliases", {
  oval_fn <- get_layout("oval")
  ellipse_fn <- get_layout("ellipse")

  expect_true(is.function(oval_fn))
  expect_true(is.function(ellipse_fn))
})

test_that("spring, fr, and fruchterman-reingold are aliases", {
  spring_fn <- get_layout("spring")
  fr_fn <- get_layout("fr")
  fruchterman_fn <- get_layout("fruchterman-reingold")

  expect_true(is.function(spring_fn))
  expect_true(is.function(fr_fn))
  expect_true(is.function(fruchterman_fn))
})

# =============================================================================
# Test: CographLayout Class Integration
# =============================================================================

test_that("CographLayout computes coordinates for all layout types", {
  net <- create_r6_network(4)
  layout_types <- c("circle", "oval", "grid", "random", "star", "bipartite")

  for (type in layout_types) {
    layout <- CographLayout$new(type)
    coords <- layout$compute(net)

    expect_equal(nrow(coords), 4, info = paste("Layout:", type))
    expect_true("x" %in% names(coords), info = paste("Layout:", type))
    expect_true("y" %in% names(coords), info = paste("Layout:", type))
  }
})

test_that("CographLayout passes parameters correctly", {
  net <- create_r6_network(6)

  # Grid with ncol
  layout <- CographLayout$new("grid", ncol = 2)
  coords <- layout$compute(net)
  expect_equal(length(unique(coords$x)), 2)

  # Random with seed
  layout1 <- CographLayout$new("random", seed = 42)
  layout2 <- CographLayout$new("random", seed = 42)
  coords1 <- layout1$compute(net)
  coords2 <- layout2$compute(net)
  expect_equal(coords1$x, coords2$x, tolerance = 0.001)

  # Star with center
  layout <- CographLayout$new("star", center = 3)
  coords <- layout$compute(net)
  # Node 3 should be at center after normalization
  # (center might be shifted due to normalization but should be distinct)
  expect_equal(nrow(coords), 6)
})

test_that("CographLayout errors on unknown layout", {
  layout <- CographLayout$new("nonexistent_xyz")
  net <- create_r6_network(3)

  expect_error(layout$compute(net), "Unknown layout type")
})

test_that("CographLayout get_type returns correct type", {
  layout <- CographLayout$new("grid")
  expect_equal(layout$get_type(), "grid")

  layout2 <- CographLayout$new("circle")
  expect_equal(layout2$get_type(), "circle")
})

test_that("CographLayout get_params returns stored parameters", {
  layout <- CographLayout$new("grid", ncol = 3, foo = "bar")
  params <- layout$get_params()

  expect_equal(params$ncol, 3)
  expect_equal(params$foo, "bar")
})

test_that("CographLayout print method outputs correctly", {
  layout <- CographLayout$new("spring", iterations = 100)
  expect_output(print(layout), "CographLayout")
  expect_output(print(layout), "spring")
  expect_output(print(layout), "iterations")
})

test_that("CographLayout normalize_coords works correctly", {
  layout <- CographLayout$new("circle")

  # Test with extreme coordinates
  coords <- data.frame(x = c(-100, 0, 100), y = c(-50, 0, 50))
  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 normalize_coords handles single point", {
  layout <- CographLayout$new("circle")

  coords <- data.frame(x = 100, y = 200)
  normalized <- layout$normalize_coords(coords)

  expect_equal(normalized$x, 0.5)
  expect_equal(normalized$y, 0.5)
})

test_that("CographLayout normalize_coords handles matrix input", {
  layout <- CographLayout$new("circle")

  coords <- matrix(c(-10, 0, 10, -5, 0, 5), ncol = 2)
  normalized <- layout$normalize_coords(coords)

  expect_true(is.data.frame(normalized))
  expect_true("x" %in% names(normalized))
  expect_true("y" %in% names(normalized))
})

test_that("CographLayout handles custom layout", {
  custom_coords <- data.frame(x = c(0.1, 0.5, 0.9), y = c(0.2, 0.5, 0.8))
  layout <- CographLayout$new("custom", coords = custom_coords)
  net <- create_r6_network(3)

  coords <- layout$compute(net)
  expect_equal(nrow(coords), 3)
})

# =============================================================================
# Test: register_builtin_layouts idempotency
# =============================================================================

test_that("register_builtin_layouts can be called multiple times safely", {
  layouts_before <- list_layouts()

  # Call internal function
  cograph:::register_builtin_layouts()

  layouts_after <- list_layouts()
  expect_equal(sort(layouts_before), sort(layouts_after))
})

# =============================================================================
# Test: Layout output validation
# =============================================================================

test_that("all layouts return finite coordinates", {
  net <- create_mock_network(10)
  simple_layouts <- c("grid", "random", "star", "bipartite")

  for (name in simple_layouts) {
    fn <- get_layout(name)
    coords <- fn(net)

    expect_true(all(is.finite(coords$x)), info = paste(name, "x not finite"))
    expect_true(all(is.finite(coords$y)), info = paste(name, "y not finite"))
  }
})

test_that("all layouts return correct row count", {
  for (n in c(0, 1, 2, 5, 10, 50)) {
    net <- create_mock_network(n)
    simple_layouts <- c("grid", "random", "star", "bipartite")

    for (name in simple_layouts) {
      fn <- get_layout(name)
      coords <- fn(net)

      expect_equal(nrow(coords), n, info = paste(name, "with", n, "nodes"))
    }
  }
})

test_that("all layouts return proper data frame structure", {
  net <- create_mock_network(5)
  simple_layouts <- c("grid", "random", "star", "bipartite")

  for (name in simple_layouts) {
    fn <- get_layout(name)
    coords <- fn(net)

    expect_true(is.data.frame(coords), info = paste(name, "not data.frame"))
    expect_true("x" %in% names(coords), info = paste(name, "no x"))
    expect_true("y" %in% names(coords), info = paste(name, "no y"))
    expect_true(is.numeric(coords$x), info = paste(name, "x not numeric"))
    expect_true(is.numeric(coords$y), info = paste(name, "y not numeric"))
  }
})

# =============================================================================
# Test: Various network types with layouts
# =============================================================================

test_that("layouts work with R6 CographNetwork", {
  net <- create_r6_network(5)
  layout_types <- c("circle", "oval", "grid", "star", "bipartite")

  for (type in layout_types) {
    layout <- CographLayout$new(type)
    coords <- layout$compute(net)

    expect_equal(nrow(coords), 5, info = paste("Layout:", type))
  }
})

test_that("layouts work with lightweight cograph_network", {
  net <- create_lightweight_network(5)
  # These layouts need to work with cograph_network through CographLayout
  # CographLayout uses get_layout and those functions expect n_nodes field
  # cograph_network uses n_nodes() function instead, so use direct layout functions

  # Circle and oval use layout_circle/layout_oval directly
  coords <- layout_circle(net)
  expect_equal(nrow(coords), 5)

  coords <- layout_oval(net)
  expect_equal(nrow(coords), 5)

  coords <- layout_spring(net, iterations = 10)
  expect_equal(nrow(coords), 5)
})

# =============================================================================
# Test: Spring layout specifics
# =============================================================================

test_that("spring layout produces reproducible results with seed", {
  net <- create_r6_network(4)

  layout1 <- CographLayout$new("spring", seed = 42)
  layout2 <- CographLayout$new("spring", seed = 42)

  coords1 <- layout1$compute(net)
  coords2 <- layout2$compute(net)

  expect_equal(coords1$x, coords2$x, tolerance = 0.001)
  expect_equal(coords1$y, coords2$y, tolerance = 0.001)
})

test_that("spring layout aliases produce coordinates", {
  net <- create_r6_network(4)

  for (alias in c("spring", "fr", "fruchterman-reingold")) {
    layout <- CographLayout$new(alias)
    coords <- layout$compute(net)

    expect_equal(nrow(coords), 4, info = paste("Alias:", alias))
    expect_true("x" %in% names(coords), info = paste("Alias:", alias))
    expect_true("y" %in% names(coords), info = paste("Alias:", alias))
  }
})

# =============================================================================
# Test: Groups layout
# =============================================================================

test_that("groups layout arranges nodes by group", {
  layout <- CographLayout$new("groups", groups = c(1, 1, 2, 2, 3, 3))
  net <- create_r6_network(6)
  coords <- layout$compute(net)

  expect_equal(nrow(coords), 6)
})

test_that("groups layout with single group", {
  layout <- CographLayout$new("groups", groups = c(1, 1, 1, 1))
  net <- create_r6_network(4)
  coords <- layout$compute(net)

  expect_equal(nrow(coords), 4)
})

# =============================================================================
# Test: Edge cases for built-in layouts
# =============================================================================

test_that("grid layout handles very large networks", {
  net <- create_mock_network(1000)
  grid_fn <- get_layout("grid")
  coords <- grid_fn(net)

  expect_equal(nrow(coords), 1000)
  expect_true(all(coords$x >= 0.1 & coords$x <= 0.9))
  expect_true(all(coords$y >= 0.1 & coords$y <= 0.9))
})

test_that("random layout handles very large networks", {
  net <- create_mock_network(1000)
  random_fn <- get_layout("random")
  coords <- random_fn(net, seed = 42)

  expect_equal(nrow(coords), 1000)
})

test_that("star layout handles large networks", {
  net <- create_mock_network(100)
  star_fn <- get_layout("star")
  coords <- star_fn(net, center = 50)

  expect_equal(nrow(coords), 100)
  expect_equal(coords$x[50], 0.5)
  expect_equal(coords$y[50], 0.5)
})

test_that("bipartite layout handles large networks", {
  net <- create_mock_network(100)
  bipartite_fn <- get_layout("bipartite")
  types <- rep(c(0, 1), 50)
  coords <- bipartite_fn(net, types = types)

  expect_equal(nrow(coords), 100)
})

Try the cograph package in your browser

Any scripts or data that you put into this service are public.

cograph documentation built on April 1, 2026, 1:07 a.m.