tests/testthat/test-coverage-cograph-41.R

# Test file for cograph.R - coverage improvement tests (Series 41)
# Targets uncovered branches and edge cases in cograph.R

# =============================================================================
# Helper function local to this test file (avoids collision with test-utils)
# =============================================================================
skip_on_cran()

make_test_matrix <- function(n = 3, symmetric = TRUE, with_names = TRUE) {
  mat <- matrix(runif(n * n), nrow = n)
  if (symmetric) {
    mat <- (mat + t(mat)) / 2
  }
  diag(mat) <- 0
  if (with_names) {
    rownames(mat) <- colnames(mat) <- LETTERS[seq_len(n)]
  }
  mat
}

# =============================================================================
# ensure_cograph_network - additional branch coverage
# =============================================================================

test_that("ensure_cograph_network returns unchanged when nodes have x column but no NA values", {
  mat <- make_test_matrix(3)
  # Create network with layout already computed
  net <- cograph(mat, layout = "circle", seed = 42)

  # Nodes have valid x values
  expect_false(all(is.na(net$nodes$x)))

  # Call ensure_cograph_network - should NOT recompute layout (early return)
  result <- cograph:::ensure_cograph_network(net, layout = "spring", seed = 99)

  expect_s3_class(result, "cograph_network")
  # Coordinates should remain from original circle layout (not recomputed as spring)
  expect_false(all(is.na(result$nodes$x)))
})

test_that("ensure_cograph_network recomputes layout when x column missing", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)  # No layout specified

  # Remove x column entirely
  net$nodes$x <- NULL

  # Should compute layout
  result <- cograph:::ensure_cograph_network(net, layout = "circle", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_true("x" %in% names(result$nodes))
  expect_false(all(is.na(result$nodes$x)))
})

test_that("ensure_cograph_network handles igraph input when available", {
  skip_if_not_installed("igraph")

  g <- igraph::make_ring(5)
  result <- cograph:::ensure_cograph_network(g, layout = "circle", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 5)
})

test_that("ensure_cograph_network handles network (statnet) input when available", {
  skip_if_not_installed("network")

  # Create simple statnet network
  net_mat <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), nrow = 3)
  net_obj <- network::network(net_mat, directed = FALSE)

  result <- cograph:::ensure_cograph_network(net_obj, layout = "circle", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 3)
})

test_that("ensure_cograph_network handles tna input when available", {
  skip_if_not_installed("tna")

  # Create simple tna object
  tna_obj <- structure(
    list(
      weights = matrix(c(0, 0.3, 0.2, 0.4, 0, 0.3, 0.3, 0.4, 0), nrow = 3),
      labels = c("A", "B", "C"),
      inits = c(0.4, 0.3, 0.3)
    ),
    class = "tna"
  )

  result <- cograph:::ensure_cograph_network(tna_obj, layout = "circle", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 3)
})

# =============================================================================
# compute_layout_for_cograph - additional branch coverage
# =============================================================================

test_that("compute_layout_for_cograph handles function layout when igraph available", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  net <- as_cograph(mat)

  # Use igraph layout function directly
  result <- cograph:::compute_layout_for_cograph(
    net,
    layout = igraph::layout_in_circle,
    seed = 42
  )

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "custom_function")
})

test_that("compute_layout_for_cograph handles igraph layout name code", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  net <- as_cograph(mat)

  # Use two-letter igraph code
  result <- cograph:::compute_layout_for_cograph(net, layout = "kk", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_false(all(is.na(result$nodes$x)))
})

test_that("compute_layout_for_cograph handles igraph_ prefix layout name", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  net <- as_cograph(mat)

  result <- cograph:::compute_layout_for_cograph(net, layout = "igraph_fr", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_false(all(is.na(result$nodes$x)))
})

test_that("compute_layout_for_cograph handles layout_ prefix layout name", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  net <- as_cograph(mat)

  result <- cograph:::compute_layout_for_cograph(net, layout = "layout_nicely", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_false(all(is.na(result$nodes$x)))
})

test_that("compute_layout_for_cograph renames columns when coords have 2+ columns", {
  mat <- make_test_matrix(3)
  net <- as_cograph(mat)

  # Matrix with unnamed columns
  custom_coords <- matrix(c(0, 0.5, 1, 0, 1, 0.5), nrow = 3, ncol = 2)

  result <- cograph:::compute_layout_for_cograph(net, layout = custom_coords, seed = 42)

  expect_equal(result$nodes$x, c(0, 0.5, 1))
  expect_equal(result$nodes$y, c(0, 1, 0.5))
})

test_that("compute_layout_for_cograph respects existing column names if ncol < 2", {
  mat <- make_test_matrix(3)
  net <- as_cograph(mat)

  # Data frame with proper column names
  custom_coords <- data.frame(x = c(0.1, 0.5, 0.9), y = c(0.2, 0.8, 0.5))

  result <- cograph:::compute_layout_for_cograph(net, layout = custom_coords, seed = 42)

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

# =============================================================================
# cograph() - source type detection branches
# =============================================================================

test_that("cograph detects igraph source type", {
  skip_if_not_installed("igraph")

  g <- igraph::make_ring(4)
  net <- cograph(g)

  expect_equal(net$meta$source, "igraph")
})

test_that("cograph detects network (statnet) source type", {
  skip_if_not_installed("network")

  net_mat <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), nrow = 3)
  net_obj <- network::network(net_mat, directed = FALSE)

  result <- cograph(net_obj)

  expect_equal(result$meta$source, "network")
})

test_that("cograph detects qgraph source type", {
  skip_if_not_installed("qgraph")

  mat <- make_test_matrix(3)

  # Create qgraph plot silently
  tmp <- tempfile(fileext = ".png")
  png(tmp)
  q <- qgraph::qgraph(mat, DoNotPlot = TRUE)
  dev.off()
  unlink(tmp)

  result <- cograph(q)

  expect_equal(result$meta$source, "qgraph")
})

test_that("cograph detects tna source type", {
  skip_if_not_installed("tna")

  # Create tna object
  tna_obj <- structure(
    list(
      weights = matrix(c(0, 0.3, 0.2, 0.4, 0, 0.3, 0.3, 0.4, 0), nrow = 3),
      labels = c("A", "B", "C"),
      inits = c(0.4, 0.3, 0.3)
    ),
    class = "tna"
  )

  result <- cograph(tna_obj)

  expect_equal(result$meta$source, "tna")
})

test_that("cograph handles unknown source type gracefully", {
  # This should error because the input type is not supported
  expect_error(
    cograph("invalid_input"),
    "Unsupported input type"
  )
})

# =============================================================================
# cograph() - weights matrix preservation branches
# =============================================================================

test_that("cograph uses weights_matrix from parsed input when available", {
  skip_if_not_installed("tna")

  # TNA objects have weights_matrix in parsed output
  tna_obj <- structure(
    list(
      weights = matrix(c(0, 0.3, 0.2, 0.4, 0, 0.3, 0.3, 0.4, 0), nrow = 3),
      labels = c("A", "B", "C"),
      inits = c(0.4, 0.3, 0.3)
    ),
    class = "tna"
  )

  result <- cograph(tna_obj)

  expect_true(!is.null(result$weights))
  expect_true(is.matrix(result$weights))
  expect_equal(dim(result$weights), c(3, 3))
})

test_that("cograph preserves square matrix input as weights", {
  mat <- make_test_matrix(4)
  result <- cograph(mat)

  expect_true(!is.null(result$weights))
  expect_true(is.matrix(result$weights))
  expect_equal(result$weights, mat)
})

test_that("cograph does not create weights from edge list input", {
  edges <- data.frame(from = c("A", "B"), to = c("B", "C"))
  result <- cograph(edges)

  # Edge list doesn't have a square matrix, so weights should be NULL or not preserved
  # (based on implementation, it may be NULL)
  expect_true(is.null(result$weights) || !is.matrix(result$weights) ||
              all(dim(result$weights) == c(3, 3)))
})

# =============================================================================
# cograph() - layout handling branches
# =============================================================================

test_that("cograph handles function layout (igraph layout function)", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  result <- cograph(mat, layout = igraph::layout_in_circle, seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "custom_function")
  expect_false(all(is.na(result$nodes$x)))
})

test_that("cograph handles igraph two-letter layout code", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  result <- cograph(mat, layout = "fr", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_false(all(is.na(result$nodes$x)))
})

test_that("cograph handles igraph_ prefix layout name", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  result <- cograph(mat, layout = "igraph_circle", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_false(all(is.na(result$nodes$x)))
})

test_that("cograph handles layout_ prefix layout name", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  result <- cograph(mat, layout = "layout_with_kk", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_false(all(is.na(result$nodes$x)))
})

test_that("cograph handles matrix layout input", {
  mat <- make_test_matrix(3)
  coords <- matrix(c(0.1, 0.5, 0.9, 0.2, 0.8, 0.5), nrow = 3, ncol = 2)

  result <- cograph(mat, layout = coords)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$nodes$x[1], 0.1)
  expect_equal(result$nodes$y[3], 0.5)
})

test_that("cograph handles data.frame layout input", {
  mat <- make_test_matrix(3)
  coords <- data.frame(x = c(0.1, 0.5, 0.9), y = c(0.2, 0.8, 0.5))

  result <- cograph(mat, layout = coords)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$nodes$x, c(0.1, 0.5, 0.9))
  expect_equal(result$nodes$y, c(0.2, 0.8, 0.5))
})

test_that("cograph renames coords columns when using matrix layout", {
  mat <- make_test_matrix(3)
  # Matrix without column names
  coords <- matrix(c(0, 0.5, 1, 0, 1, 0.5), nrow = 3)

  result <- cograph(mat, layout = coords)

  expect_true("x" %in% names(result$nodes))
  expect_true("y" %in% names(result$nodes))
})

test_that("cograph uses CographLayout for built-in layout names", {
  mat <- make_test_matrix(4)
  result <- cograph(mat, layout = "spring", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "spring")
  expect_false(all(is.na(result$nodes$x)))
})

# =============================================================================
# cograph() - TNA metadata handling
# =============================================================================

test_that("cograph creates tna metadata when input is tna object", {
  skip_if_not_installed("tna")

  tna_obj <- structure(
    list(
      weights = matrix(c(0, 0.3, 0.2, 0.4, 0, 0.3, 0.3, 0.4, 0), nrow = 3),
      labels = c("A", "B", "C"),
      inits = c(0.4, 0.3, 0.3)
    ),
    class = "tna"
  )

  result <- cograph(tna_obj)

  expect_true(!is.null(result$meta$tna))
  expect_equal(result$meta$tna$type, "tna")
})

test_that("cograph does not create tna metadata for matrix input", {
  mat <- make_test_matrix(3)
  result <- cograph(mat)

  expect_true(is.null(result$meta$tna))
})

# =============================================================================
# sn_layout() - comprehensive branch coverage
# =============================================================================

test_that("sn_layout handles CographLayout object", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  layout_obj <- CographLayout$new("circle")
  result <- sn_layout(net, layout_obj)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "custom")
  expect_false(all(is.na(result$nodes$x)))
})

test_that("sn_layout handles igraph layout function when available", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  net <- cograph(mat)

  result <- sn_layout(net, igraph::layout_in_circle, seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "custom_function")
})

test_that("sn_layout handles igraph two-letter code", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  net <- cograph(mat)

  result <- sn_layout(net, "mds", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "mds")
})

test_that("sn_layout handles igraph_ prefix", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  net <- cograph(mat)

  result <- sn_layout(net, "igraph_kk", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "igraph_kk")
})

test_that("sn_layout handles layout_ prefix", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(4)
  net <- cograph(mat)

  result <- sn_layout(net, "layout_with_fr", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "layout_with_fr")
})

test_that("sn_layout handles matrix coordinates", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  coords <- matrix(c(0, 0.5, 1, 0, 1, 0.5), nrow = 3)
  result <- sn_layout(net, coords)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "custom")
  expect_equal(result$nodes$x[1], 0)
})

test_that("sn_layout handles data.frame coordinates", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  coords <- data.frame(x = c(0.1, 0.5, 0.9), y = c(0.3, 0.6, 0.9))
  result <- sn_layout(net, coords)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$nodes$x[2], 0.5)
  expect_equal(result$nodes$y[2], 0.6)
})

test_that("sn_layout renames coords columns when matrix has 2+ columns", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  # 3-column matrix (extra column ignored)
  coords <- matrix(c(0, 0.5, 1, 0, 1, 0.5, 1, 2, 3), nrow = 3)
  result <- sn_layout(net, coords)

  expect_true("x" %in% names(result$nodes))
  expect_true("y" %in% names(result$nodes))
})

test_that("sn_layout errors on invalid layout type (numeric)", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  expect_error(
    sn_layout(net, 12345)
  )
})

test_that("sn_layout errors on invalid layout type (logical)", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  expect_error(
    sn_layout(net, TRUE),
    "layout must be"
  )
})

test_that("sn_layout uses built-in layout for non-igraph string", {
  mat <- make_test_matrix(4)
  net <- cograph(mat)

  result <- sn_layout(net, "grid", seed = 42)

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$layout$name, "grid")
})

test_that("sn_layout updates layout coords in network nodes", {
  mat <- make_test_matrix(3)
  net <- cograph(mat, layout = "circle", seed = 42)

  old_x <- net$nodes$x

  # Apply different layout
  result <- sn_layout(net, "spring", seed = 99)

  # Coordinates should be different
  expect_false(all(old_x == result$nodes$x))
})

test_that("sn_layout stores layout info with coords", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  result <- sn_layout(net, "circle", seed = 123)

  expect_true(!is.null(result$meta$layout))
  expect_equal(result$meta$layout$name, "circle")
  expect_equal(result$meta$layout$seed, 123)
  expect_true(!is.null(result$meta$layout$coords))
})

# =============================================================================
# sn_theme() - comprehensive branch coverage
# =============================================================================

test_that("sn_theme gets theme from registry by name", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  result <- sn_theme(net, "classic")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$theme))
})

test_that("sn_theme accepts CographTheme object directly", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  # Get theme object
  theme_obj <- get_theme("dark")

  if (!is.null(theme_obj) && inherits(theme_obj, "CographTheme")) {
    result <- sn_theme(net, theme_obj)
    expect_s3_class(result, "cograph_network")
    expect_true(!is.null(result$theme))
  } else {
    skip("Dark theme not registered or not CographTheme class")
  }
})

test_that("sn_theme errors on unknown theme name", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  expect_error(
    sn_theme(net, "nonexistent_theme_xyz"),
    "Unknown theme"
  )
})

test_that("sn_theme errors on invalid theme type (numeric)", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  expect_error(
    sn_theme(net, 12345),
    "theme must be a string"
  )
})

test_that("sn_theme errors on invalid theme type (list)", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  expect_error(
    sn_theme(net, list(bg = "white")),
    "theme must be a string"
  )
})

test_that("sn_theme applies overrides when provided", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  result <- sn_theme(net, "classic", background = "lightblue")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$theme))
})

test_that("sn_theme does not apply overrides when list is empty", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  # No overrides provided
  result <- sn_theme(net, "classic")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$theme))
})

test_that("sn_theme auto-converts matrix input", {
  mat <- make_test_matrix(3)

  result <- sn_theme(mat, "minimal")

  expect_s3_class(result, "cograph_network")
})

# =============================================================================
# sn_palette() - comprehensive branch coverage
# =============================================================================

test_that("sn_palette gets palette from registry by name", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  result <- sn_palette(net, "viridis")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$node_aes))
})

test_that("sn_palette accepts function palette", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  custom_pal <- function(n) rainbow(n)
  result <- sn_palette(net, custom_pal)

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$node_aes$fill))
})

test_that("sn_palette errors on unknown palette name", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  expect_error(
    sn_palette(net, "nonexistent_palette_xyz"),
    "Unknown palette"
  )
})

test_that("sn_palette errors on invalid palette type (numeric)", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  expect_error(
    sn_palette(net, 12345),
    "palette must be a string"
  )
})

test_that("sn_palette errors on invalid palette type (logical)", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  expect_error(
    sn_palette(net, FALSE),
    "palette must be a string"
  )
})

test_that("sn_palette maps colors by variable when 'by' specified", {
  mat <- make_test_matrix(4)
  net <- cograph(mat)
  net$nodes$group <- c("A", "A", "B", "B")

  result <- sn_palette(net, "colorblind", by = "group")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$node_aes$fill))
  # First two should have same color, last two should have same color
  expect_equal(result$node_aes$fill[1], result$node_aes$fill[2])
  expect_equal(result$node_aes$fill[3], result$node_aes$fill[4])
})

test_that("sn_palette uses default single color when 'by' not in nodes", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  # 'by' is specified but column doesn't exist
  result <- sn_palette(net, "viridis", by = "nonexistent_column")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$node_aes$fill))
  # All nodes should have same color (first from palette)
  expect_equal(length(unique(result$node_aes$fill)), 1)
})

test_that("sn_palette applies to edges when target='edges'", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  result <- sn_palette(net, "colorblind", target = "edges")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$edge_aes))
  expect_true(!is.null(result$edge_aes$positive_color))
  expect_true(!is.null(result$edge_aes$negative_color))
})

test_that("sn_palette applies to both nodes and edges when target='both'", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)

  result <- sn_palette(net, "viridis", target = "both")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$node_aes$fill))
  expect_true(!is.null(result$edge_aes$positive_color))
})

test_that("sn_palette handles network with no edges for target='edges'", {
  # Network with no edges
  mat <- matrix(0, nrow = 3, ncol = 3)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")
  net <- cograph(mat)

  # Should not error even with no edges
  result <- sn_palette(net, "viridis", target = "edges")

  expect_s3_class(result, "cograph_network")
})

test_that("sn_palette handles network with NULL edges for target='edges'", {
  mat <- matrix(0, nrow = 3, ncol = 3)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")
  net <- cograph(mat)

  # Force edges to NULL
  net$edges <- NULL

  result <- sn_palette(net, "viridis", target = "edges")

  expect_s3_class(result, "cograph_network")
})

test_that("sn_palette initializes node_aes when NULL", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)
  net$node_aes <- NULL

  result <- sn_palette(net, "viridis")

  expect_true(!is.null(result$node_aes))
  expect_true(!is.null(result$node_aes$fill))
})

test_that("sn_palette initializes edge_aes when NULL", {
  mat <- make_test_matrix(3)
  net <- cograph(mat)
  net$edge_aes <- NULL

  result <- sn_palette(net, "colorblind", target = "edges")

  expect_true(!is.null(result$edge_aes))
})

test_that("sn_palette auto-converts matrix input", {
  mat <- make_test_matrix(3)

  result <- sn_palette(mat, "viridis")

  expect_s3_class(result, "cograph_network")
})

# =============================================================================
# Edge cases and corner cases
# =============================================================================

test_that("cograph handles large network", {
  mat <- make_test_matrix(50)
  net <- cograph(mat, layout = "spring", seed = 42)

  expect_s3_class(net, "cograph_network")
  expect_equal(n_nodes(net), 50)
})

test_that("cograph handles weighted edge list", {
  edges <- data.frame(
    from = c("A", "B", "C", "A"),
    to = c("B", "C", "A", "C"),
    weight = c(0.5, 0.3, 0.8, 0.2)
  )

  net <- cograph(edges)

  expect_s3_class(net, "cograph_network")
  expect_equal(n_nodes(net), 3)
  expect_true(all(c("weight") %in% names(net$edges)))
})

test_that("cograph handles edge list with numeric node IDs", {
  edges <- data.frame(
    from = c(1, 2, 3),
    to = c(2, 3, 1)
  )

  net <- cograph(edges)

  expect_s3_class(net, "cograph_network")
})

test_that("cograph handles directed asymmetric matrix", {
  mat <- matrix(c(0, 1, 0, 0, 0, 1, 0, 0, 0), nrow = 3)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")

  net <- cograph(mat, directed = TRUE)

  expect_s3_class(net, "cograph_network")
  expect_true(is_directed(net))
})

test_that("cograph handles forced undirected on asymmetric matrix", {
  mat <- matrix(c(0, 1, 0, 0, 0, 1, 0, 0, 0), nrow = 3)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")

  net <- cograph(mat, directed = FALSE)

  expect_s3_class(net, "cograph_network")
  expect_false(is_directed(net))
})

test_that("cograph handles nodes parameter", {
  mat <- make_test_matrix(3)
  custom_nodes <- data.frame(
    label = c("Node1", "Node2", "Node3"),
    group = c("G1", "G1", "G2")
  )

  net <- cograph(mat, nodes = custom_nodes)

  expect_s3_class(net, "cograph_network")
  # Node labels should be updated
  nodes <- get_nodes(net)
  expect_true("group" %in% names(nodes) || "label" %in% names(nodes))
})

test_that("cograph all igraph layout codes work", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(5)

  codes <- c("kk", "fr", "mds", "ni", "ci", "st", "gr", "rd")

  for (code in codes) {
    result <- tryCatch(
      cograph(mat, layout = code, seed = 42),
      error = function(e) NULL
    )

    if (!is.null(result)) {
      expect_s3_class(result, "cograph_network")
    }
  }
})

test_that("sn_layout all igraph layout codes work", {
  skip_if_not_installed("igraph")

  mat <- make_test_matrix(5)
  net <- cograph(mat)

  codes <- c("kk", "fr", "mds", "ni", "ci", "st", "gr", "rd")

  for (code in codes) {
    result <- tryCatch(
      sn_layout(net, code, seed = 42),
      error = function(e) NULL
    )

    if (!is.null(result)) {
      expect_s3_class(result, "cograph_network")
    }
  }
})

# =============================================================================
# Pipe chain integration tests
# =============================================================================

test_that("pipe chain with all modifiers works", {
  mat <- make_test_matrix(4)

  result <- mat |>
    cograph(layout = "circle", seed = 42) |>
    sn_layout("spring", seed = 99) |>
    sn_theme("classic") |>
    sn_palette("viridis")

  expect_s3_class(result, "cograph_network")
  expect_true(!is.null(result$theme))
  expect_true(!is.null(result$node_aes$fill))
  expect_equal(result$meta$layout$name, "spring")
})

test_that("pipe chain starting from matrix with sn_layout", {
  mat <- make_test_matrix(3)

  result <- mat |>
    sn_layout("circle", seed = 42) |>
    sn_theme("dark")

  expect_s3_class(result, "cograph_network")
})

test_that("pipe chain starting from matrix with sn_theme", {
  mat <- make_test_matrix(3)

  result <- mat |>
    sn_theme("minimal") |>
    sn_palette("colorblind")

  expect_s3_class(result, "cograph_network")
})

test_that("pipe chain starting from matrix with sn_palette", {
  mat <- make_test_matrix(3)

  result <- mat |>
    sn_palette("viridis", target = "both")

  expect_s3_class(result, "cograph_network")
})

# =============================================================================
# Integration with external packages (when available)
# =============================================================================

test_that("full workflow with igraph input", {
  skip_if_not_installed("igraph")

  g <- igraph::sample_gnp(10, 0.3)

  result <- g |>
    cograph() |>
    sn_layout("fr", seed = 42) |>
    sn_theme("classic") |>
    sn_palette("viridis")

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 10)
})

test_that("full workflow with network (statnet) input", {
  skip_if_not_installed("network")

  net_mat <- make_test_matrix(5)
  net_obj <- network::network(net_mat, directed = FALSE)

  result <- net_obj |>
    cograph() |>
    sn_layout("circle", seed = 42) |>
    sn_palette("colorblind")

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 5)
})

test_that("full workflow with tna input", {
  skip_if_not_installed("tna")

  tna_obj <- structure(
    list(
      weights = matrix(c(0, 0.3, 0.2, 0.4, 0, 0.3, 0.3, 0.4, 0), nrow = 3),
      labels = c("A", "B", "C"),
      inits = c(0.4, 0.3, 0.3)
    ),
    class = "tna"
  )

  result <- tna_obj |>
    cograph() |>
    sn_layout("circle") |>
    sn_theme("classic")

  expect_s3_class(result, "cograph_network")
  expect_equal(result$meta$source, "tna")
  expect_true(!is.null(result$meta$tna))
})

# =============================================================================
# Null/NA handling edge cases
# =============================================================================

test_that("cograph handles matrix with NA values", {
  mat <- make_test_matrix(3)
  mat[1, 2] <- NA

  # Should work (NAs treated as no edge)
  result <- cograph(mat)

  expect_s3_class(result, "cograph_network")
})

test_that("cograph handles matrix with all zeros", {
  mat <- matrix(0, nrow = 4, ncol = 4)
  rownames(mat) <- colnames(mat) <- LETTERS[1:4]

  result <- cograph(mat)

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 4)
  expect_equal(n_edges(result), 0)
})

test_that("sn_layout handles NULL seed", {
  mat <- make_test_matrix(4)
  net <- cograph(mat)

  result <- sn_layout(net, "spring", seed = NULL)

  expect_s3_class(result, "cograph_network")
})

test_that("cograph handles NULL layout (no layout computed)", {
  mat <- make_test_matrix(3)

  result <- cograph(mat, layout = NULL)

  expect_s3_class(result, "cograph_network")
  # Layout should be NULL or nodes should have NA coordinates
  expect_true(all(is.na(result$nodes$x)) || is.null(result$nodes$x))
})

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.