tests/testthat/test-coverage-splot-edges-40.R

# test-coverage-splot-edges-40.R - Comprehensive tests for splot-edges.R
# Tests for edge rendering functions in base R graphics

# Load internal functions for testing
skip_on_cran()

find_curve_split_index <- cograph:::find_curve_split_index
draw_curve_with_start_segment <- cograph:::draw_curve_with_start_segment
draw_straight_edge_base <- cograph:::draw_straight_edge_base
draw_curved_edge_base <- cograph:::draw_curved_edge_base
draw_self_loop_base <- cograph:::draw_self_loop_base
draw_edge_label_base <- cograph:::draw_edge_label_base
get_edge_label_position <- cograph:::get_edge_label_position
render_edges_base <- cograph:::render_edges_base
splot_angle <- cograph:::splot_angle
cent_to_edge <- cograph:::cent_to_edge
arrow_base_midpoint <- cograph:::arrow_base_midpoint
draw_arrow_base <- cograph:::draw_arrow_base
recycle_to_length <- cograph:::recycle_to_length
get_edge_order <- cograph:::get_edge_order
resolve_loop_rotation <- cograph:::resolve_loop_rotation
adjust_alpha <- cograph:::adjust_alpha

# ============================================
# FIND_CURVE_SPLIT_INDEX TESTS
# ============================================

test_that("find_curve_split_index returns 1 for n < 2", {
  expect_equal(find_curve_split_index(c(0), c(0), 0.5), 1)
  expect_equal(find_curve_split_index(numeric(0), numeric(0), 0.5), 1)
})

test_that("find_curve_split_index returns 1 for fraction <= 0", {
  x <- c(0, 1, 2, 3)
  y <- c(0, 0, 0, 0)
  expect_equal(find_curve_split_index(x, y, 0), 1)
  expect_equal(find_curve_split_index(x, y, -0.5), 1)
})

test_that("find_curve_split_index returns n for fraction >= 1", {
  x <- c(0, 1, 2, 3)
  y <- c(0, 0, 0, 0)
  expect_equal(find_curve_split_index(x, y, 1), 4)
  expect_equal(find_curve_split_index(x, y, 1.5), 4)
})

test_that("find_curve_split_index returns correct midpoint for fraction = 0.5", {
  x <- c(0, 1, 2, 3, 4)
  y <- c(0, 0, 0, 0, 0)
  # Equal spacing: at fraction 0.5, should be around index 3
  idx <- find_curve_split_index(x, y, 0.5)
  expect_true(idx >= 2 && idx <= 4)
})

test_that("find_curve_split_index handles zero-length curves", {
  x <- c(1, 1, 1)
  y <- c(1, 1, 1)
  # Total length is 0, should return 1

expect_equal(find_curve_split_index(x, y, 0.5), 1)
})

test_that("find_curve_split_index ensures at least 2 points in each segment", {
  x <- c(0, 1, 2, 3, 4)
  y <- c(0, 0, 0, 0, 0)
  # Very small fraction should not return 1
  idx <- find_curve_split_index(x, y, 0.001)
  expect_true(idx >= 2)
  # Very large fraction should not return n
  idx2 <- find_curve_split_index(x, y, 0.999)
  expect_true(idx2 <= 4)
})

# ============================================
# DRAW_CURVE_WITH_START_SEGMENT TESTS
# ============================================

test_that("draw_curve_with_start_segment handles n < 2", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Should return invisibly without error
  result <- draw_curve_with_start_segment(c(0), c(0), "black", 1, 1)
  dev.off()

  expect_null(result)
})
test_that("draw_curve_with_start_segment draws single line when no split needed", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # start_fraction = 0, so no split needed
  draw_curve_with_start_segment(c(-0.5, 0, 0.5), c(0, 0.3, 0),
                                col = "blue", lwd = 2, lty = 1,
                                start_lty = 2, start_fraction = 0)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curve_with_start_segment draws split line with different lty", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # start_fraction = 0.3 with different lty
  draw_curve_with_start_segment(c(-0.5, 0, 0.5), c(0, 0.3, 0),
                                col = "red", lwd = 2, lty = 1,
                                start_lty = 2, start_fraction = 0.3)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curve_with_start_segment handles same start_lty and lty", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Same lty means no split
  draw_curve_with_start_segment(c(-0.5, 0, 0.5), c(0, 0.3, 0),
                                col = "green", lwd = 1, lty = 2,
                                start_lty = 2, start_fraction = 0.5)
  dev.off()

  expect_true(file.exists(tmp))
})

# ============================================
# DRAW_STRAIGHT_EDGE_BASE TESTS
# ============================================

test_that("draw_straight_edge_base draws a simple edge", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_straight_edge_base(x1 = -0.5, y1 = 0, x2 = 0.5, y2 = 0,
                          col = "gray50", lwd = 1, lty = 1,
                          arrow = FALSE, asize = 0.02)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_straight_edge_base draws edge with arrow", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_straight_edge_base(x1 = -0.5, y1 = -0.5, x2 = 0.5, y2 = 0.5,
                          col = "blue", lwd = 2, lty = 1,
                          arrow = TRUE, asize = 0.05)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_straight_edge_base draws bidirectional edge", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_straight_edge_base(x1 = -0.5, y1 = 0, x2 = 0.5, y2 = 0,
                          col = "red", lwd = 2, lty = 1,
                          arrow = TRUE, asize = 0.04,
                          bidirectional = TRUE)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_straight_edge_base handles different line types", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Dashed line
  draw_straight_edge_base(-0.5, 0.3, 0.5, 0.3, col = "black", lwd = 1, lty = 2)
  # Dotted line
  draw_straight_edge_base(-0.5, 0, 0.5, 0, col = "black", lwd = 1, lty = 3)
  # Dash-dot line
  draw_straight_edge_base(-0.5, -0.3, 0.5, -0.3, col = "black", lwd = 1, lty = 4)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_straight_edge_base handles start_fraction with different lty", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_straight_edge_base(-0.5, 0, 0.5, 0,
                          col = "purple", lwd = 2, lty = 1,
                          arrow = FALSE,
                          start_lty = 2, start_fraction = 0.3)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_straight_edge_base handles custom arrow_angle", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Wide arrow
  draw_straight_edge_base(-0.5, 0.3, 0.5, 0.3,
                          col = "orange", arrow = TRUE, asize = 0.05,
                          arrow_angle = pi/4)
  # Narrow arrow
  draw_straight_edge_base(-0.5, -0.3, 0.5, -0.3,
                          col = "orange", arrow = TRUE, asize = 0.05,
                          arrow_angle = pi/8)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_straight_edge_base handles zero arrow size", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # arrow = TRUE but asize = 0 means no arrow drawn
  draw_straight_edge_base(-0.5, 0, 0.5, 0,
                          col = "gray", arrow = TRUE, asize = 0)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_straight_edge_base handles vertical edges", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_straight_edge_base(0, -0.5, 0, 0.5,
                          col = "blue", arrow = TRUE, asize = 0.04)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_straight_edge_base handles diagonal edges", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_straight_edge_base(-0.5, -0.5, 0.5, 0.5,
                          col = "green", arrow = TRUE, asize = 0.04,
                          bidirectional = TRUE)
  dev.off()

  expect_true(file.exists(tmp))
})

# ============================================
# DRAW_CURVED_EDGE_BASE TESTS
# ============================================

test_that("draw_curved_edge_base falls back to straight for curve ~0", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Very small curve should use straight edge
  draw_curved_edge_base(-0.5, 0, 0.5, 0, curve = 1e-8,
                        col = "gray", lwd = 1, arrow = FALSE)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curved_edge_base draws positive curve", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_curved_edge_base(-0.5, 0, 0.5, 0, curve = 0.3,
                        col = "blue", lwd = 2, arrow = TRUE, asize = 0.04)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curved_edge_base draws negative curve", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_curved_edge_base(-0.5, 0, 0.5, 0, curve = -0.3,
                        col = "red", lwd = 2, arrow = TRUE, asize = 0.04)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curved_edge_base draws bidirectional curved edge", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_curved_edge_base(-0.5, 0, 0.5, 0, curve = 0.4,
                        col = "purple", lwd = 2,
                        arrow = TRUE, asize = 0.04,
                        bidirectional = TRUE)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curved_edge_base handles custom curvePivot", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Curve peak at 30%
  draw_curved_edge_base(-0.5, 0.3, 0.5, 0.3, curve = 0.3, curvePivot = 0.3,
                        col = "orange", lwd = 2)
  # Curve peak at 70%
  draw_curved_edge_base(-0.5, -0.3, 0.5, -0.3, curve = 0.3, curvePivot = 0.7,
                        col = "cyan", lwd = 2)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curved_edge_base handles zero-length edge", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Same start and end point - should return invisibly
  draw_curved_edge_base(0, 0, 0, 0, curve = 0.3, col = "gray")
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curved_edge_base handles start_segment styling", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_curved_edge_base(-0.5, 0, 0.5, 0, curve = 0.3,
                        col = "green", lwd = 2, lty = 1,
                        start_lty = 2, start_fraction = 0.25)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curved_edge_base handles large curvature", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_curved_edge_base(-0.3, 0, 0.3, 0, curve = 0.8,
                        col = "maroon", lwd = 2, arrow = TRUE, asize = 0.04)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_curved_edge_base handles very small curvature", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_curved_edge_base(-0.5, 0, 0.5, 0, curve = 0.01,
                        col = "navy", lwd = 1, arrow = TRUE, asize = 0.03)
  dev.off()

  expect_true(file.exists(tmp))
})

# ============================================
# DRAW_SELF_LOOP_BASE TESTS
# ============================================

test_that("draw_self_loop_base draws basic loop", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_self_loop_base(0, 0, node_size = 0.1, col = "gray50", lwd = 1)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_self_loop_base draws loop with arrow", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_self_loop_base(0, 0, node_size = 0.1, col = "blue", lwd = 2,
                      arrow = TRUE, asize = 0.03)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_self_loop_base handles different rotations", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 400, height = 400)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Loop pointing up (default)
  draw_self_loop_base(-0.5, 0.5, 0.08, col = "red", rotation = pi/2)
  # Loop pointing right
  draw_self_loop_base(0.5, 0.5, 0.08, col = "green", rotation = 0)
  # Loop pointing down
  draw_self_loop_base(-0.5, -0.5, 0.08, col = "blue", rotation = -pi/2)
  # Loop pointing left
  draw_self_loop_base(0.5, -0.5, 0.08, col = "orange", rotation = pi)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_self_loop_base handles different line types", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_self_loop_base(-0.3, 0, 0.08, col = "black", lty = 2)  # dashed
  draw_self_loop_base(0.3, 0, 0.08, col = "black", lty = 3)   # dotted
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_self_loop_base handles no arrow", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_self_loop_base(0, 0, 0.1, col = "purple", arrow = FALSE)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_self_loop_base handles custom arrow_angle", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_self_loop_base(0, 0, 0.1, col = "darkgreen",
                      arrow = TRUE, asize = 0.04, arrow_angle = pi/4)
  dev.off()

  expect_true(file.exists(tmp))
})

# ============================================
# DRAW_EDGE_LABEL_BASE TESTS
# ============================================

test_that("draw_edge_label_base returns invisibly for NULL/NA/empty label", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  result1 <- draw_edge_label_base(0, 0, label = NULL)
  result2 <- draw_edge_label_base(0, 0, label = NA)
  result3 <- draw_edge_label_base(0, 0, label = "")
  dev.off()

  expect_null(result1)
  expect_null(result2)
  expect_null(result3)
})

test_that("draw_edge_label_base draws simple label", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_edge_label_base(0, 0, label = "0.75", cex = 1, col = "gray30")
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_edge_label_base draws label with background", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_edge_label_base(0, 0, label = "0.50", cex = 1,
                       col = "black", bg = "white")
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_edge_label_base draws label without background", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_edge_label_base(0, 0, label = "test", bg = NA)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_edge_label_base draws label with shadow", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_edge_label_base(0, 0, label = "shadow",
                       shadow = TRUE, shadow_color = "gray40",
                       shadow_offset = 0.5, shadow_alpha = 0.5)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_edge_label_base draws label with halo", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_edge_label_base(0, 0, label = "halo",
                       shadow = "halo", shadow_color = "white",
                       shadow_offset = 1, shadow_alpha = 1)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_edge_label_base handles different font sizes", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_edge_label_base(-0.3, 0, label = "small", cex = 0.5)
  draw_edge_label_base(0.3, 0, label = "large", cex = 1.5)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("draw_edge_label_base handles different fonts", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  draw_edge_label_base(-0.4, 0.3, label = "plain", font = 1)
  draw_edge_label_base(0, 0.3, label = "bold", font = 2)
  draw_edge_label_base(0.4, 0.3, label = "italic", font = 3)
  dev.off()

  expect_true(file.exists(tmp))
})

# ============================================
# GET_EDGE_LABEL_POSITION TESTS
# ============================================

test_that("get_edge_label_position returns midpoint for straight edge", {
  pos <- get_edge_label_position(-1, 0, 1, 0, position = 0.5, curve = 0)
  expect_equal(pos$x, 0, tolerance = 0.01)
  expect_equal(pos$y, 0, tolerance = 0.01)
})

test_that("get_edge_label_position returns start for position = 0", {
  pos <- get_edge_label_position(-1, 0, 1, 0, position = 0, curve = 0)
  expect_equal(pos$x, -1, tolerance = 0.01)
  expect_equal(pos$y, 0, tolerance = 0.01)
})

test_that("get_edge_label_position returns end for position = 1", {
  pos <- get_edge_label_position(-1, 0, 1, 0, position = 1, curve = 0)
  expect_equal(pos$x, 1, tolerance = 0.01)
  expect_equal(pos$y, 0, tolerance = 0.01)
})

test_that("get_edge_label_position applies label_offset for straight edge", {
  pos <- get_edge_label_position(-1, 0, 1, 0, position = 0.5,
                                  curve = 0, label_offset = 0.1)
  expect_equal(pos$x, 0, tolerance = 0.01)
  # Offset is perpendicular to edge
  expect_true(abs(pos$y) > 0)
})

test_that("get_edge_label_position handles curved edge", {
  pos <- get_edge_label_position(-1, 0, 1, 0, position = 0.5,
                                  curve = 0.3, curvePivot = 0.5)
  # Should be offset from the straight line due to curve
  expect_equal(pos$x, 0, tolerance = 0.1)
  expect_true(abs(pos$y) > 0)  # Curved away from y=0
})

test_that("get_edge_label_position handles different curvePivot", {
  pos1 <- get_edge_label_position(-1, 0, 1, 0, position = 0.3,
                                   curve = 0.3, curvePivot = 0.3)
  pos2 <- get_edge_label_position(-1, 0, 1, 0, position = 0.3,
                                   curve = 0.3, curvePivot = 0.7)
  # Different pivot should give different y positions
  expect_false(abs(pos1$y - pos2$y) < 0.001)
})

test_that("get_edge_label_position handles zero-length edge", {
  pos <- get_edge_label_position(0, 0, 0, 0, position = 0.5)
  expect_equal(pos$x, 0)
  expect_equal(pos$y, 0)
})

test_that("get_edge_label_position handles NA curve", {
  pos <- get_edge_label_position(-1, 0, 1, 0, position = 0.5, curve = NA)
  expect_equal(pos$x, 0, tolerance = 0.01)
  expect_equal(pos$y, 0, tolerance = 0.01)
})

test_that("get_edge_label_position handles empty curve", {
  pos <- get_edge_label_position(-1, 0, 1, 0, position = 0.5, curve = numeric(0))
  expect_equal(pos$x, 0, tolerance = 0.01)
  expect_equal(pos$y, 0, tolerance = 0.01)
})

# ============================================
# RENDER_EDGES_BASE TESTS
# ============================================

test_that("render_edges_base handles empty edge set", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  edges <- data.frame(from = integer(0), to = integer(0))
  layout <- matrix(c(-0.5, 0.5, 0, 0), ncol = 2)
  result <- render_edges_base(edges, layout, node_sizes = 0.1)
  dev.off()

  expect_null(result)
})

test_that("render_edges_base renders simple edges", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.5, 0.8))
  layout <- matrix(c(-0.5, 0, 0.5, -0.3, 0.3, 0), ncol = 2)
  render_edges_base(edges, layout, node_sizes = 0.1,
                    edge.color = "gray50", edge.width = 1)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("render_edges_base renders self-loop", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  edges <- data.frame(from = c(1, 1), to = c(2, 1), weight = c(0.5, 0.3))
  layout <- matrix(c(-0.3, 0.3, 0, 0), ncol = 2)
  render_edges_base(edges, layout, node_sizes = 0.1,
                    edge.color = "blue", arrows = TRUE, asize = 0.03)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("render_edges_base renders curved edges", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  edges <- data.frame(from = c(1, 2), to = c(2, 1), weight = c(0.5, 0.6))
  layout <- matrix(c(-0.3, 0.3, 0, 0), ncol = 2)
  render_edges_base(edges, layout, node_sizes = 0.1,
                    curve = c(0.3, 0.3), arrows = TRUE, asize = 0.03)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("render_edges_base renders edge labels", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.5, 0.8))
  layout <- matrix(c(-0.5, 0, 0.5, -0.3, 0.3, 0), ncol = 2)
  render_edges_base(edges, layout, node_sizes = 0.1,
                    edge.labels = c("0.5", "0.8"),
                    edge.label.cex = 0.8, edge.label.bg = "white")
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("render_edges_base handles bidirectional arrows", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  edges <- data.frame(from = c(1), to = c(2), weight = c(0.7))
  layout <- matrix(c(-0.3, 0.3, 0, 0), ncol = 2)
  render_edges_base(edges, layout, node_sizes = 0.1,
                    arrows = TRUE, asize = 0.04, bidirectional = TRUE)
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("render_edges_base respects edge ordering by weight", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  # Stronger edges should be rendered on top (last)
  edges <- data.frame(from = c(1, 1, 2), to = c(2, 3, 3),
                      weight = c(0.2, 0.9, 0.5))
  layout <- matrix(c(-0.5, 0.5, 0, 0, 0.5, -0.5), ncol = 2)
  render_edges_base(edges, layout, node_sizes = 0.1,
                    edge.color = c("lightblue", "darkblue", "blue"),
                    edge.width = c(1, 3, 2))
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("render_edges_base handles different shapes", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.5, 0.5))
  layout <- matrix(c(-0.5, 0, 0.5, -0.2, 0.2, 0), ncol = 2)
  render_edges_base(edges, layout, node_sizes = 0.1,
                    shapes = c("circle", "square", "triangle"))
  dev.off()

  expect_true(file.exists(tmp))
})

test_that("render_edges_base handles custom loop rotation", {
  tmp <- tempfile(fileext = ".png")
  on.exit(unlink(tmp), add = TRUE)

  png(tmp, width = 200, height = 200)
  plot(0, 0, xlim = c(-1, 1), ylim = c(-1, 1), type = "n")
  edges <- data.frame(from = c(1, 1), to = c(1, 2), weight = c(0.5, 0.5))
  layout <- matrix(c(0, 0.5, 0, 0), ncol = 2)
  render_edges_base(edges, layout, node_sizes = 0.1,
                    loopRotation = c(pi/4, NA),  # 45 degrees for loop
                    arrows = TRUE, asize = 0.03)
  dev.off()

  expect_true(file.exists(tmp))
})

# ============================================
# INTEGRATION TESTS WITH SPLOT
# ============================================

test_that("splot renders edges correctly with various parameters", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj, edge_color = "steelblue",
                            edge_width = 2, curvature = 0.2))
  expect_true(result$success, info = result$error)
})

test_that("splot renders self-loops correctly", {
  adj <- create_test_matrix(4)
  diag(adj) <- c(1, 0, 1, 0)  # Add self-loops to nodes 1 and 3

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

test_that("splot renders curved reciprocal edges correctly", {
  # Directed network with reciprocal edges
  edges <- data.frame(
    from = c(1, 2, 2, 3),
    to = c(2, 1, 3, 2),
    weight = c(0.5, 0.6, 0.7, 0.4)
  )

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

test_that("splot renders edge labels correctly", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(splot(adj, edge_labels = TRUE,
                            edge_label_size = 0.7,
                            edge_label_bg = "lightyellow"))
  expect_true(result$success, info = result$error)
})

test_that("splot renders arrows correctly in directed network", {
  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)
})

test_that("splot handles per-edge curvature vector", {
  edges <- data.frame(
    from = c(1, 2, 3),
    to = c(2, 3, 1),
    weight = c(0.5, 0.6, 0.7)
  )

  result <- safe_plot(splot(edges, curvature = c(0, 0.3, 0.5)))
  expect_true(result$success, info = result$error)
})

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

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

test_that("splot handles bidirectional arrows", {
  adj <- create_test_matrix(4)

  result <- safe_plot(splot(adj, bidirectional = TRUE, arrow_size = 1.2))
  expect_true(result$success, info = 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 curves = 'force' mode", {
  adj <- create_test_matrix(4)

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

test_that("splot handles edge_ci underlays", {
  adj <- create_test_matrix(4, weighted = TRUE)
  n_edges <- sum(adj != 0) / 2

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

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

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

test_that("splot handles loop_rotation parameter", {
  adj <- create_test_matrix(3)
  diag(adj) <- 1  # Add self-loops

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

test_that("splot handles edge rendering with threshold", {
  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 negative and positive edge colors", {
  adj <- create_test_matrix(4, weighted = TRUE, symmetric = FALSE)

  result <- safe_plot(splot(adj,
    edge_positive_color = "#228B22",
    edge_negative_color = "#DC143C"
  ))
  expect_true(result$success, info = result$error)
})

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

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

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

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

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

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

test_that("splot handles ring topology", {
  adj <- create_test_topology("ring", n = 6)

  result <- safe_plot(splot(adj, layout = "circle", curvature = 0.1))
  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.