tests/testthat/test-splot.R

# test-splot.R - Core splot() function tests (CRITICAL)
# Tests for the main base R graphics plotting function

# ============================================
# INPUT TYPES
# ============================================

test_that("splot() accepts adjacency matrix", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj))
  expect_true(result$success, info = result$error)
})

test_that("splot() accepts weighted matrix", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj))
  expect_true(result$success, info = result$error)
})

test_that("splot() accepts asymmetric (directed) matrix", {
  adj <- create_test_matrix(4, symmetric = FALSE)

  result <- safe_plot(splot(adj, directed = TRUE))
  expect_true(result$success, info = result$error)
})

test_that("splot() accepts edge list data.frame", {
  edges <- create_test_edgelist(n_edges = 6, n_nodes = 4)

  result <- safe_plot(splot(edges))
  expect_true(result$success, info = result$error)
})

test_that("splot() accepts edge list with character nodes", {
  edges <- create_test_edgelist(n_edges = 6, n_nodes = 4, char_nodes = TRUE)

  result <- safe_plot(splot(edges))
  expect_true(result$success, info = result$error)
})

test_that("splot() accepts weighted edge list", {
  edges <- create_test_edgelist(n_edges = 6, n_nodes = 4, weighted = TRUE)

  result <- safe_plot(splot(edges))
  expect_true(result$success, info = result$error)
})

test_that("splot() accepts cograph_network object", {
  adj <- create_test_matrix(4)
  net <- cograph(adj)

  result <- safe_plot(splot(net))
  expect_true(result$success, info = result$error)
})

test_that("splot() accepts igraph object", {
  skip_if_no_igraph()

  g <- igraph::make_ring(5)

  result <- safe_plot(splot(g))
  expect_true(result$success, info = result$error)
})

# ============================================
# LAYOUTS
# ============================================

test_that("splot() works with circle layout", {
  adj <- create_test_matrix(5)

  result <- safe_plot(splot(adj, layout = "circle"))
  expect_true(result$success, info = result$error)
})
test_that("splot() works with spring layout", {
  adj <- create_test_matrix(5)

  result <- safe_plot(splot(adj, layout = "spring", seed = 42))
  expect_true(result$success, info = result$error)
})

test_that("splot() works with groups parameter", {
  adj <- create_test_matrix(6)
  groups <- c(1, 1, 2, 2, 3, 3)

  # Use spring layout with groups coloring (layout="groups" has a known issue)
  result <- safe_plot(splot(adj, layout = "spring", groups = groups, seed = 42))
  expect_true(result$success, info = result$error)
})

test_that("splot() works with custom coordinate matrix", {

  adj <- create_test_matrix(4)
  custom_layout <- matrix(c(0, 0, 1, 1, 0, 1, 0, 1), ncol = 2)

  result <- safe_plot(splot(adj, layout = custom_layout))
  expect_true(result$success, info = result$error)
})

test_that("splot() works with igraph two-letter layout codes", {
  skip_if_no_igraph()
  adj <- create_test_matrix(5)

  # Test common igraph layout codes
  for (code in c("kk", "fr", "mds")) {
    result <- safe_plot(splot(adj, layout = code, seed = 42))
    expect_true(result$success, info = paste("Layout", code, "failed:", result$error))
  }
})

# ============================================
# NODE AESTHETICS
# ============================================

test_that("splot() handles node_size parameter", {
  adj <- create_test_matrix(4)

  # Scalar value
  result <- safe_plot(splot(adj, node_size = 5))
  expect_true(result$success, info = result$error)

  # Vector value
  result <- safe_plot(splot(adj, node_size = c(3, 4, 5, 6)))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles node_shape parameter", {
  adj <- create_test_matrix(3)

  # Test multiple shapes
  shapes <- c("circle", "square", "triangle", "diamond", "pentagon",
              "hexagon", "star", "heart", "ellipse", "cross")

  for (shape in shapes) {
    result <- safe_plot(splot(adj, node_shape = shape))
    expect_true(result$success, info = paste("Shape", shape, "failed:", result$error))
  }
})

test_that("splot() handles per-node shapes", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, node_shape = c("circle", "square", "triangle", "diamond")))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles node_fill colors", {
  adj <- create_test_matrix(4)

  # Single color
  result <- safe_plot(splot(adj, node_fill = "steelblue"))
  expect_true(result$success, info = result$error)

  # Per-node colors
  result <- safe_plot(splot(adj, node_fill = c("red", "green", "blue", "orange")))
  expect_true(result$success, info = result$error)

  # Hex colors
  result <- safe_plot(splot(adj, node_fill = "#FF5733"))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles node_border_color and node_border_width", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, node_border_color = "black", node_border_width = 2))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles node_alpha transparency", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, node_alpha = 0.5))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles labels parameter", {
  adj <- create_test_matrix(4)

  # TRUE (default - use indices/names)
  result <- safe_plot(splot(adj, labels = TRUE))
  expect_true(result$success, info = result$error)

  # FALSE
  result <- safe_plot(splot(adj, labels = FALSE))
  expect_true(result$success, info = result$error)

  # Character vector
  result <- safe_plot(splot(adj, labels = c("A", "B", "C", "D")))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles label positioning options", {
  adj <- create_test_matrix(3)

  for (pos in c("center", "above", "below", "left", "right")) {
    result <- safe_plot(splot(adj, labels = TRUE, label_position = pos))
    expect_true(result$success, info = paste("Position", pos, "failed:", result$error))
  }
})

test_that("splot() handles label font parameters", {
  adj <- create_test_matrix(3)

  result <- safe_plot(splot(adj,
    labels = TRUE,
    label_size = 1.2,
    label_color = "navy",
    label_fontface = "bold",
    label_fontfamily = "serif"
  ))
  expect_true(result$success, info = result$error)
})

# ============================================
# PIE AND DONUT NODES
# ============================================

test_that("splot() handles pie_values for pie chart nodes", {
  adj <- create_test_matrix(3)
  pie_vals <- list(c(1, 2, 3), c(2, 2), c(1, 1, 1, 1))

  result <- safe_plot(splot(adj, pie_values = pie_vals))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles pie_colors", {
  adj <- create_test_matrix(3)
  pie_vals <- list(c(1, 2), c(2, 2), c(3, 1))
  pie_cols <- list(c("red", "blue"), c("green", "yellow"), c("purple", "orange"))

  result <- safe_plot(splot(adj, pie_values = pie_vals, pie_colors = pie_cols))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles donut_fill for donut nodes", {
  adj <- create_test_matrix(3)

  # Scalar fill proportion
  result <- safe_plot(splot(adj, donut_fill = 0.5))
  expect_true(result$success, info = result$error)

  # Per-node fill proportions
  result <- safe_plot(splot(adj, donut_fill = c(0.2, 0.5, 0.8)))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles donut_color and donut_bg_color", {
  adj <- create_test_matrix(3)

  result <- safe_plot(splot(adj,
    donut_fill = c(0.3, 0.6, 0.9),
    donut_color = "steelblue",
    donut_bg_color = "lightyellow"
  ))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles donut_shape for polygon donuts", {
  adj <- create_test_matrix(3)

  for (shape in c("circle", "square", "hexagon", "triangle")) {
    result <- safe_plot(splot(adj, donut_fill = 0.7, donut_shape = shape))
    expect_true(result$success, info = paste("Donut shape", shape, "failed:", result$error))
  }
})

test_that("splot() handles donut value display", {
  adj <- create_test_matrix(3)

  result <- safe_plot(splot(adj,
    donut_fill = c(0.25, 0.50, 0.75),
    donut_show_value = TRUE,
    donut_value_suffix = "%",
    donut_value_digits = 0
  ))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles donut with node_shape='donut'", {
  adj <- create_test_matrix(3)

  result <- safe_plot(splot(adj, node_shape = "donut", donut_fill = 0.8))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles double donut (donut2)", {
  adj <- create_test_matrix(3)

  result <- safe_plot(splot(adj,
    donut_fill = c(0.7, 0.8, 0.6),
    donut2_values = list(c(0.5), c(0.4), c(0.6)),
    donut2_colors = list("orange", "purple", "green")
  ))
  expect_true(result$success, info = result$error)
})

# ============================================
# EDGE AESTHETICS
# ============================================

test_that("splot() handles edge_color parameter", {
  adj <- create_test_matrix(4, weighted = TRUE)

  # Single color
  result <- safe_plot(splot(adj, edge_color = "gray50"))
  expect_true(result$success, info = result$error)

  # NULL for weight-based coloring
  result <- safe_plot(splot(adj, edge_color = NULL))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles edge_width parameter", {
  adj <- create_test_matrix(4)

  # Scalar
  result <- safe_plot(splot(adj, edge_width = 2))
  expect_true(result$success, info = result$error)

  # NULL for weight-based sizing
  adj_w <- create_test_matrix(4, weighted = TRUE)
  result <- safe_plot(splot(adj_w, edge_width = NULL))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles edge_width_range", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj, edge_width_range = c(0.5, 5)))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles edge_scale_mode options", {
  adj <- create_test_matrix(4, weighted = TRUE)

  for (mode in c("linear", "log", "sqrt", "rank")) {
    result <- safe_plot(splot(adj, edge_scale_mode = mode))
    expect_true(result$success, info = paste("Scale mode", mode, "failed:", result$error))
  }
})

test_that("splot() handles edge_alpha transparency", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, edge_alpha = 0.5))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles edge_style line types", {
  adj <- create_test_matrix(4)

  # Numeric styles
  for (style in 1:3) {
    result <- safe_plot(splot(adj, edge_style = style))
    expect_true(result$success, info = paste("Edge style", style, "failed:", result$error))
  }
})

test_that("splot() handles curvature parameter", {
  adj <- create_test_matrix(4)

  # Straight edges
  result <- safe_plot(splot(adj, curvature = 0))
  expect_true(result$success, info = result$error)

  # Curved edges
  result <- safe_plot(splot(adj, curvature = 0.3))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles curves modes", {
  adj <- create_test_matrix(4, symmetric = FALSE)

  result <- safe_plot(splot(adj, curves = TRUE))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, curves = FALSE))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, curves = "force"))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles arrow parameters for directed networks", {
  adj <- create_test_matrix(4, symmetric = FALSE)

  result <- safe_plot(splot(adj, directed = TRUE, show_arrows = TRUE, arrow_size = 1.5))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, directed = TRUE, bidirectional = TRUE))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles edge_labels parameter", {
  adj <- create_test_matrix(4, weighted = TRUE)

  # TRUE shows weights
  result <- safe_plot(splot(adj, edge_labels = TRUE))
  expect_true(result$success, info = result$error)

  # FALSE hides labels
  result <- safe_plot(splot(adj, edge_labels = FALSE))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles edge label styling", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj,
    edge_labels = TRUE,
    edge_label_size = 0.8,
    edge_label_color = "navy",
    edge_label_bg = "white"
  ))
  expect_true(result$success, info = result$error)
})

# ============================================
# CI UNDERLAYS AND LABEL TEMPLATES
# ============================================

test_that("splot() handles edge_ci underlays", {
  adj <- create_test_matrix(4, weighted = TRUE)
  n_edges <- sum(adj != 0) / 2  # Symmetric matrix
  ci_vals <- runif(n_edges, 0.1, 0.3)

  result <- safe_plot(splot(adj,
    edge_ci = ci_vals,
    edge_ci_scale = 2,
    edge_ci_alpha = 0.2
  ))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles edge_label_template", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj,
    edge_label_template = "{est}",
    edge_label_digits = 2
  ))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles edge_label_style presets", {
  adj <- create_test_matrix(4, weighted = TRUE)

  for (style in c("none", "estimate")) {
    result <- safe_plot(splot(adj, edge_label_style = style))
    expect_true(result$success, info = paste("Label style", style, "failed:", result$error))
  }
})

# ============================================
# WEIGHT HANDLING
# ============================================

test_that("splot() handles positive and negative edge colors", {
  adj <- create_test_matrix(4, weighted = TRUE, symmetric = FALSE)

  result <- safe_plot(splot(adj,
    edge_positive_color = "darkgreen",
    edge_negative_color = "darkred"
  ))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles threshold parameter", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj, threshold = 0.3))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles maximum parameter", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj, maximum = 0.8))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles weight_digits rounding", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj, weight_digits = 1))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, weight_digits = NULL))  # No rounding
  expect_true(result$success, info = result$error)
})

# ============================================
# PLOT SETTINGS
# ============================================

test_that("splot() handles title parameter", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, title = "Test Network", title_size = 1.5))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles background color", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, background = "lightgray"))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, background = "transparent"))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles margins parameter", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, margins = c(0.2, 0.2, 0.2, 0.2)))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles layout_scale parameter", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, layout_scale = 0.8))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, layout_scale = 1.2))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, layout_scale = "auto"))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles layout_margin parameter", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, layout_margin = 0))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, layout_margin = 0.3))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles rescale parameter", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, rescale = TRUE))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, rescale = FALSE))
  expect_true(result$success, info = result$error)
})

# ============================================
# THEME INTEGRATION
# ============================================

test_that("splot() handles theme parameter", {
  adj <- create_test_matrix(4)

  for (theme in c("classic", "dark", "minimal", "colorblind")) {
    result <- safe_plot(splot(adj, theme = theme))
    expect_true(result$success, info = paste("Theme", theme, "failed:", result$error))
  }
})

# ============================================
# LEGEND
# ============================================

test_that("splot() handles legend parameter", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj, legend = TRUE))
  expect_true(result$success, info = result$error)

  result <- safe_plot(splot(adj, legend = FALSE))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles legend with groups", {
  adj <- create_test_matrix(6)
  groups <- c(1, 1, 2, 2, 3, 3)

  result <- safe_plot(splot(adj, legend = TRUE, groups = groups))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles legend_position options", {
  adj <- create_test_matrix(4)

  for (pos in c("topright", "topleft", "bottomright", "bottomleft")) {
    result <- safe_plot(splot(adj, legend = TRUE, legend_position = pos))
    expect_true(result$success, info = paste("Legend position", pos, "failed:", result$error))
  }
})

# ============================================
# OUTPUT
# ============================================

test_that("splot() outputs to PNG file", {
  adj <- create_test_matrix(4)
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  splot(adj, filetype = "png", filename = tools::file_path_sans_ext(tmp),
        width = 5, height = 5, res = 100)

  expect_file_created(paste0(tools::file_path_sans_ext(tmp), ".png"))
})

test_that("splot() outputs to PDF file", {
  adj <- create_test_matrix(4)
  tmp <- tempfile(fileext = ".pdf")
  on.exit(unlink(tmp), add = TRUE)

  splot(adj, filetype = "pdf", filename = tools::file_path_sans_ext(tmp),
        width = 5, height = 5)

  expect_file_created(paste0(tools::file_path_sans_ext(tmp), ".pdf"))
})

test_that("splot() outputs to SVG file", {
  skip_on_cran()  # SVG requires cairo

  adj <- create_test_matrix(4)
  tmp <- tempfile(fileext = ".svg")
  on.exit(unlink(tmp), add = TRUE)

  # Skip if SVG device not available
  svg_test <- tempfile(fileext = ".svg")
  result <- tryCatch({
    grDevices::svg(svg_test)
    grDevices::dev.off()
    unlink(svg_test)
    TRUE
  }, warning = function(w) {
    unlink(svg_test)
    if (grepl("cairo|X11", conditionMessage(w), ignore.case = TRUE)) FALSE else TRUE
  }, error = function(e) { unlink(svg_test); FALSE })

  if (!result) skip("SVG device not available on this system")

  splot(adj, filetype = "svg", filename = tools::file_path_sans_ext(tmp),
        width = 5, height = 5)

  expect_file_created(paste0(tools::file_path_sans_ext(tmp), ".svg"))
})

# ============================================
# RETURN VALUE
# ============================================

test_that("splot() returns cograph_network invisibly", {
  adj <- create_test_matrix(4)

  result <- with_temp_png({
    ret <- splot(adj)
    ret
  })

  expect_cograph_network(result)
})

# ============================================
# EDGE CASES
# ============================================

test_that("splot() handles single-node network", {
  adj <- matrix(0, 1, 1)

  result <- safe_plot(splot(adj))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles two-node network", {
  adj <- matrix(c(0, 1, 1, 0), 2, 2)

  result <- safe_plot(splot(adj))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles network with self-loops", {
  adj <- create_test_matrix(4)
  diag(adj) <- 1  # Add self-loops

  result <- safe_plot(splot(adj))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles fully disconnected nodes", {
  adj <- matrix(0, 4, 4)  # No edges

  result <- safe_plot(splot(adj))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles complete graph", {
  adj <- create_test_topology("complete", n = 5)

  result <- safe_plot(splot(adj))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles named matrix with row/column names", {
  adj <- create_test_matrix(4)
  rownames(adj) <- colnames(adj) <- c("Node_A", "Node_B", "Node_C", "Node_D")

  result <- safe_plot(splot(adj, labels = TRUE))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles very long node labels", {
  adj <- create_test_matrix(3)
  long_labels <- c("This is a very long label", "Another lengthy node name", "Short")

  result <- safe_plot(splot(adj, labels = long_labels))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles Unicode node labels", {
  skip_on_cran()  # Unicode handling can vary by platform
  adj <- create_test_matrix(3)

  result <- safe_plot(splot(adj, labels = c("\u03B1", "\u03B2", "\u03B3")))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles zero weights in weighted matrix", {
  adj <- create_test_matrix(4, weighted = TRUE)
  adj[adj != 0][1] <- 0  # Set one weight to exactly 0

  result <- safe_plot(splot(adj))
  expect_true(result$success, info = result$error)
})

# ============================================
# SEED REPRODUCIBILITY
# ============================================

test_that("splot() with same seed produces consistent layouts", {
  adj <- create_test_matrix(5)

  # Run twice with same seed
  net1 <- with_temp_png(splot(adj, layout = "spring", seed = 123))
  net2 <- with_temp_png(splot(adj, layout = "spring", seed = 123))

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

  expect_equal(nodes1$x, nodes2$x)
  expect_equal(nodes1$y, nodes2$y)
})

# ============================================
# VECTORIZED CURVATURE TESTS
# ============================================

test_that("splot() accepts per-edge curvature vector", {
  # Create a simple directed network with known edges
  edges <- data.frame(
    from = c(1, 2, 1),
    to = c(2, 1, 3),
    weight = c(1, 1, 1)
  )
  curvatures <- c(0.3, 0.3, 0)  # Two curved, one straight

  result <- safe_plot(splot(edges, directed = TRUE, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

test_that("splot() curvature vector is recycled correctly", {
  # Matrix with 6 edges (3 unique in symmetric case)
  mat <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), 3, 3)

  # Two values recycled to 6
  result <- safe_plot(splot(mat, curvature = c(0.2, 0)))
  expect_true(result$success, info = result$error)
})

test_that("splot() curvature = 0 in vector means straight edge", {
  edges <- data.frame(
    from = c(1, 2, 3),
    to = c(2, 3, 1),
    weight = c(1, 1, 1)
  )

  # Mixed curvatures: curved, straight, curved
  result <- safe_plot(splot(edges, curvature = c(0.3, 0, 0.4)))
  expect_true(result$success, info = result$error)
})

test_that("splot() accepts single curvature value (existing behavior)", {
  adj <- create_test_matrix(4)

  # Single value should still work
  result <- safe_plot(splot(adj, curvature = 0.25))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles curvature vector with directed reciprocal edges", {
  # Directed graph with reciprocal edges (A <-> B)
  edges <- data.frame(
    from = c(1, 2, 1, 3),
    to = c(2, 1, 3, 1),
    weight = c(0.5, 0.5, 0.7, 0.3)
  )

  # Per-edge curvatures
  curvatures <- c(0.3, 0.3, 0.2, 0.2)

  result <- safe_plot(splot(edges, directed = TRUE, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles all-zero curvature vector", {
  mat <- create_test_matrix(4)

  # All straight edges
  n_edges <- sum(mat != 0)
  curvatures <- rep(0, n_edges)

  result <- safe_plot(splot(mat, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

test_that("splot() handles all-positive curvature vector", {
  mat <- create_test_matrix(4)

  # All curved edges
  n_edges <- sum(mat != 0)
  curvatures <- rep(0.4, n_edges)

  result <- safe_plot(splot(mat, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

test_that("splot() curvature vector works with edge list input", {
  edges <- create_test_edgelist(n_edges = 5, n_nodes = 4)

  # Per-edge curvatures matching edge count
  curvatures <- c(0, 0.2, 0.4, 0.1, 0.3)

  result <- safe_plot(splot(edges, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

test_that("splot() curvature vector works with cograph_network input", {
  adj <- create_test_matrix(4)
  net <- cograph(adj)

  # Get number of edges
  n_edges <- n_edges(net)
  curvatures <- runif(n_edges, 0, 0.3)

  result <- safe_plot(splot(net, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

test_that("splot() curvature with negative values (curves opposite direction)", {
  edges <- data.frame(
    from = c(1, 2),
    to = c(2, 3),
    weight = c(1, 1)
  )

  # Negative curvature curves the opposite direction
  curvatures <- c(0.3, -0.3)

  result <- safe_plot(splot(edges, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

test_that("splot() curvature vector with very small values", {
  edges <- data.frame(
    from = c(1, 2, 3),
    to = c(2, 3, 1),
    weight = c(1, 1, 1)
  )

  # Very small curvatures (nearly straight)
  curvatures <- c(0.01, 0.02, 0.005)

  result <- safe_plot(splot(edges, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

test_that("splot() curvature vector with large values", {
  edges <- data.frame(
    from = c(1, 2),
    to = c(2, 1),
    weight = c(1, 1)
  )

  # Large curvatures (very curved)
  curvatures <- c(0.8, 0.9)

  result <- safe_plot(splot(edges, directed = TRUE, curvature = curvatures))
  expect_true(result$success, info = result$error)
})

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.