tests/testthat/test-coverage-tplot-40.R

In cograph: Analysis and Visualization of Complex Networks

# test-coverage-tplot-40.R - Comprehensive tests for tplot.R
# Tests for plot_tna() and tplot() functions - TNA-style network plotting

# ============================================
# BASIC FUNCTIONALITY
# ============================================

skip_on_cran()

test_that("plot_tna() accepts adjacency matrix", {
  adj <- create_test_matrix(5)

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

test_that("plot_tna() accepts weighted matrix", {
  adj <- create_test_matrix(5, weighted = TRUE)

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

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

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

test_that("tplot alias works identically to plot_tna", {
  adj <- create_test_matrix(4)

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

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

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

  expect_cograph_network(result)
})

# ============================================
# NODE COLOR PARAMETER
# ============================================

test_that("plot_tna() handles single color", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, color = "steelblue"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles per-node colors", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, color = c("red", "green", "blue", "orange")))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles hex color values", {
  adj <- create_test_matrix(3)

  result <- safe_plot(plot_tna(adj, color = c("#FF5733", "#33FF57", "#3357FF")))
  expect_true(result$success, info = result$error)
})

# ============================================
# LABELS PARAMETER
# ============================================

test_that("plot_tna() handles custom labels", {
  adj <- create_test_matrix(4)

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

test_that("plot_tna() handles NULL labels", {
  adj <- create_test_matrix(4)

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

test_that("plot_tna() handles long labels", {
  adj <- create_test_matrix(3)
  long_labels <- c("Long Label One", "Longer Label Two", "Very Long Label Three")

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

# ============================================
# LAYOUT PARAMETER
# ============================================

test_that("plot_tna() uses oval layout by default", {
  adj <- create_test_matrix(5)

  result <- safe_plot(plot_tna(adj, layout = "oval"))
  expect_true(result$success, info = result$error)
})

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

  result <- safe_plot(plot_tna(adj, layout = "circle"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() works with spring layout", {
  adj <- create_test_matrix(5)

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

test_that("plot_tna() 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(plot_tna(adj, layout = custom_layout))
  expect_true(result$success, info = result$error)
})

# ============================================
# THEME PARAMETER
# ============================================

test_that("plot_tna() uses colorblind theme by default", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, theme = "colorblind"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() works with classic theme", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, theme = "classic"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() works with dark theme", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, theme = "dark"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() works with minimal theme", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, theme = "minimal"))
  expect_true(result$success, info = result$error)
})

# ============================================
# MARGINS PARAMETER
# ============================================

test_that("plot_tna() handles custom margins", {
  adj <- create_test_matrix(4)

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

test_that("plot_tna() handles zero margins", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, mar = c(0, 0, 0, 0)))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles large margins", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, mar = c(0.5, 0.5, 0.5, 0.5)))
  expect_true(result$success, info = result$error)
})

# ============================================
# EDGE LABELS PARAMETER
# ============================================

test_that("plot_tna() shows edge labels by default", {
  adj <- create_test_matrix(4, weighted = TRUE)

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

test_that("plot_tna() hides edge labels when FALSE", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(plot_tna(adj, edge.labels = FALSE))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles edge.label.position parameter", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(plot_tna(adj, edge.labels = TRUE, edge.label.position = 0.5))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles edge.label.cex parameter", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(plot_tna(adj, edge.labels = TRUE, edge.label.cex = 1.2))
  expect_true(result$success, info = result$error)
})

# ============================================
# EDGE COLOR PARAMETER
# ============================================

test_that("plot_tna() uses TNA default edge color", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, edge.color = "#003355"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles custom edge color", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, edge.color = "gray50"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles NULL edge color", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(plot_tna(adj, edge.color = NULL))
  expect_true(result$success, info = result$error)
})

# ============================================
# NODE SIZE PARAMETER (vsize)
# ============================================

test_that("plot_tna() handles vsize parameter", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, vsize = 10))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles small vsize", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, vsize = 2))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles large vsize", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, vsize = 20))
  expect_true(result$success, info = result$error)
})

# ============================================
# PIE/DONUT PARAMETERS
# ============================================

test_that("plot_tna() handles pie parameter for donut fill", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, pie = c(0.2, 0.4, 0.6, 0.8)))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles pieColor parameter", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj,
    pie = c(0.3, 0.5, 0.7, 0.9),
    pieColor = c("red", "blue", "green", "orange")
  ))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles single pie value", {
  adj <- create_test_matrix(4)

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

# ============================================
# LINE TYPE PARAMETER (lty)
# ============================================

test_that("plot_tna() handles lty numeric values", {
  adj <- create_test_matrix(4)

  # Test solid line type (1)
  result <- safe_plot(plot_tna(adj, lty = 1))
  expect_true(result$success, info = result$error)

  # Test dashed line type (2)
  result <- safe_plot(plot_tna(adj, lty = 2))
  expect_true(result$success, info = result$error)

  # Test dotted line type (3)
  result <- safe_plot(plot_tna(adj, lty = 3))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles lty character values", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, lty = "solid"))
  expect_true(result$success, info = result$error)

  result <- safe_plot(plot_tna(adj, lty = "dashed"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles NULL lty", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, lty = NULL))
  expect_true(result$success, info = result$error)
})

# ============================================
# DIRECTED PARAMETER
# ============================================

test_that("plot_tna() handles directed = TRUE", {
  adj <- create_test_matrix(4, symmetric = FALSE)

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

test_that("plot_tna() handles directed = FALSE", {
  adj <- create_test_matrix(4)

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

# ============================================
# MINIMUM/CUT PARAMETERS
# ============================================

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

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

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

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

test_that("plot_tna() handles both minimum and cut", {
  adj <- create_test_matrix(4, weighted = TRUE)

  result <- safe_plot(plot_tna(adj, minimum = 0.2, cut = 0.6))
  expect_true(result$success, info = result$error)
})

# ============================================
# POSITIVE/NEGATIVE COLORS
# ============================================

test_that("plot_tna() handles posCol parameter", {
  adj <- create_test_matrix(4, weighted = TRUE, symmetric = FALSE)

  result <- safe_plot(plot_tna(adj, posCol = "darkgreen"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles negCol parameter", {
  adj <- create_test_matrix(4, weighted = TRUE, symmetric = FALSE)

  result <- safe_plot(plot_tna(adj, negCol = "darkred"))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles both posCol and negCol", {
  adj <- create_test_matrix(4, weighted = TRUE, symmetric = FALSE)

  result <- safe_plot(plot_tna(adj, posCol = "#009900", negCol = "#C62828"))
  expect_true(result$success, info = result$error)
})

# ============================================
# ARROW ANGLE PARAMETER
# ============================================

test_that("plot_tna() handles arrowAngle parameter", {
  adj <- create_test_matrix(4, symmetric = FALSE)

  result <- safe_plot(plot_tna(adj, directed = TRUE, arrowAngle = pi/4))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles NULL arrowAngle", {
  adj <- create_test_matrix(4, symmetric = FALSE)

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

# ============================================
# TITLE PARAMETER
# ============================================

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

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

test_that("plot_tna() handles NULL title", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, title = NULL))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles long title", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, title = "This is a Very Long Title for Testing"))
  expect_true(result$success, info = result$error)
})

# ============================================
# ELLIPSIS PARAMETERS (passed to splot)
# ============================================

test_that("plot_tna() passes node_border_color through ellipsis", {
  adj <- create_test_matrix(4)

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

test_that("plot_tna() passes node_border_width through ellipsis", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, node_border_width = 2))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() passes background through ellipsis", {
  adj <- create_test_matrix(4)

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

test_that("plot_tna() passes edge_alpha through ellipsis", {
  adj <- create_test_matrix(4)

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

# ============================================
# EDGE CASES AND SPECIAL INPUTS
# ============================================

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

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

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

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

test_that("plot_tna() handles network with no edges", {
  adj <- matrix(0, 4, 4)

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

test_that("plot_tna() handles fully connected network", {
  adj <- create_test_topology("complete", n = 5)

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

test_that("plot_tna() handles named matrix", {
  adj <- create_test_matrix(4)
  rownames(adj) <- colnames(adj) <- c("Node1", "Node2", "Node3", "Node4")

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

test_that("plot_tna() handles self-loops", {
  adj <- create_test_matrix(4)
  diag(adj) <- 1

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

# ============================================
# TNA DEFAULT PARAMETERS
# ============================================

test_that("plot_tna() sets TNA default edge_start_style", {
  adj <- create_test_matrix(4)

  # Should use dotted edge start style by default
  result <- safe_plot(plot_tna(adj))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() sets TNA default arrow_size", {
  adj <- create_test_matrix(4, symmetric = FALSE)

  # Should use 0.61 arrow_size by default
  result <- safe_plot(plot_tna(adj, directed = TRUE))
  expect_true(result$success, info = result$error)
})

# ============================================
# COMBINATION TESTS
# ============================================

test_that("plot_tna() works with multiple parameters combined", {
  adj <- create_test_matrix(5, weighted = TRUE)

  result <- safe_plot(plot_tna(
    adj,
    color = c("red", "blue", "green", "orange", "purple"),
    labels = c("A", "B", "C", "D", "E"),
    layout = "circle",
    theme = "colorblind",
    vsize = 10,
    edge.labels = TRUE,
    edge.label.cex = 0.8,
    title = "Combined Test"
  ))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() works with pie and custom colors", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(
    adj,
    color = c("#1f77b4", "#ff7f0e", "#2ca02c", "#d62728"),
    pie = c(0.25, 0.50, 0.75, 1.0),
    pieColor = c("maroon", "navy", "forestgreen", "purple"),
    vsize = 12
  ))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() works with directed network and arrow customization", {
  adj <- create_test_matrix(5, symmetric = FALSE)

  result <- safe_plot(plot_tna(
    adj,
    directed = TRUE,
    arrowAngle = pi/5,
    edge.color = "#003355",
    edge.labels = TRUE
  ))
  expect_true(result$success, info = result$error)
})

# ============================================
# OUTPUT TO FILE
# ============================================

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

  png(tmp, width = 400, height = 400)
  plot_tna(adj, title = "PNG Test")
  dev.off()

  expect_file_created(tmp)
  expect_file_size(tmp, min_bytes = 100)
})

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

  png(tmp, width = 400, height = 400)
  tplot(adj, title = "Tplot PNG Test")
  dev.off()

  expect_file_created(tmp)
})

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

test_that("plot_tna() handles lty with value > 6", {
  adj <- create_test_matrix(4)

  # Should clamp to valid lty value
  result <- safe_plot(plot_tna(adj, lty = 10))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() handles empty lty vector", {
  adj <- create_test_matrix(4)

  result <- safe_plot(plot_tna(adj, lty = numeric(0)))
  expect_true(result$success, info = result$error)
})

# ============================================
# QGRAPH COMPATIBILITY
# ============================================

test_that("plot_tna() maintains qgraph-style parameter names", {
  adj <- create_test_matrix(4, weighted = TRUE)

  # All qgraph-style parameter names should work
  result <- safe_plot(plot_tna(
    adj,
    edge.labels = TRUE,
    edge.label.position = 0.5,
    edge.label.cex = 0.7,
    edge.color = "gray"
  ))
  expect_true(result$success, info = result$error)
})

test_that("plot_tna() accepts cograph_network input", {
  adj <- create_test_matrix(4)
  net <- cograph(adj)

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

test_that("tplot() accepts cograph_network input", {
  adj <- create_test_matrix(4)
  net <- cograph(adj)

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