tests/testthat/test-palettes.R

In cograph: Analysis and Visualization of Complex Networks

# test-palettes.R - Color Palette Function Tests
# Tests for all 7 palette functions and sn_palette()

# ============================================
# PALETTE FUNCTION BASICS
# ============================================

skip_on_cran()

test_that("palette_rainbow() returns correct number of colors", {
  for (n in c(1, 3, 5, 10, 20)) {
    colors <- palette_rainbow(n)
    expect_equal(length(colors), n)
  }
})

test_that("palette_rainbow() returns valid colors", {
  colors <- palette_rainbow(5)
  expect_valid_colors(colors)
})

test_that("palette_rainbow() handles alpha parameter", {
  colors_full <- palette_rainbow(5, alpha = 1)
  colors_half <- palette_rainbow(5, alpha = 0.5)

  # Both should have 5 colors

  expect_equal(length(colors_full), 5)
  expect_equal(length(colors_half), 5)

  # All should be valid
  expect_valid_colors(colors_full)
  expect_valid_colors(colors_half)
})

test_that("palette_colorblind() returns correct number of colors", {
  for (n in c(1, 3, 5, 8, 12)) {
    colors <- palette_colorblind(n)
    expect_equal(length(colors), n)
  }
})

test_that("palette_colorblind() returns valid colors", {
  colors <- palette_colorblind(8)
  expect_valid_colors(colors)
})

test_that("palette_colorblind() handles n > base colors", {
  # Wong's palette has 8 base colors
  colors <- palette_colorblind(15)
  expect_equal(length(colors), 15)
  expect_valid_colors(colors)
})

test_that("palette_colorblind() handles alpha parameter", {
  colors <- palette_colorblind(5, alpha = 0.7)
  expect_equal(length(colors), 5)
  expect_valid_colors(colors)
})

test_that("palette_pastel() returns correct number of colors", {
  for (n in c(1, 4, 8, 12)) {
    colors <- palette_pastel(n)
    expect_equal(length(colors), n)
  }
})

test_that("palette_pastel() returns valid colors", {
  colors <- palette_pastel(8)
  expect_valid_colors(colors)
})

test_that("palette_pastel() handles n > base colors", {
  colors <- palette_pastel(15)
  expect_equal(length(colors), 15)
  expect_valid_colors(colors)
})

test_that("palette_pastel() handles alpha parameter", {
  colors <- palette_pastel(5, alpha = 0.5)
  expect_equal(length(colors), 5)
  expect_valid_colors(colors)
})

test_that("palette_viridis() returns correct number of colors", {
  for (n in c(1, 5, 10, 20)) {
    colors <- palette_viridis(n)
    expect_equal(length(colors), n)
  }
})

test_that("palette_viridis() returns valid colors", {
  colors <- palette_viridis(10)
  expect_valid_colors(colors)
})

test_that("palette_viridis() handles different options", {
  for (opt in c("viridis", "magma", "plasma", "inferno", "cividis")) {
    colors <- palette_viridis(5, option = opt)
    expect_equal(length(colors), 5)
    expect_valid_colors(colors)
  }
})

test_that("palette_viridis() falls back to viridis for unknown option", {
  colors <- palette_viridis(5, option = "unknown_option")
  expect_equal(length(colors), 5)
  expect_valid_colors(colors)
})

test_that("palette_viridis() handles alpha parameter", {
  colors <- palette_viridis(5, alpha = 0.8)
  expect_equal(length(colors), 5)
  expect_valid_colors(colors)
})

test_that("palette_blues() returns correct number of colors", {
  for (n in c(1, 5, 10)) {
    colors <- palette_blues(n)
    expect_equal(length(colors), n)
  }
})

test_that("palette_blues() returns valid colors", {
  colors <- palette_blues(8)
  expect_valid_colors(colors)
})

test_that("palette_blues() handles alpha parameter", {
  colors <- palette_blues(5, alpha = 0.6)
  expect_equal(length(colors), 5)
  expect_valid_colors(colors)
})

test_that("palette_reds() returns correct number of colors", {
  for (n in c(1, 5, 10)) {
    colors <- palette_reds(n)
    expect_equal(length(colors), n)
  }
})

test_that("palette_reds() returns valid colors", {
  colors <- palette_reds(8)
  expect_valid_colors(colors)
})

test_that("palette_reds() handles alpha parameter", {
  colors <- palette_reds(5, alpha = 0.4)
  expect_equal(length(colors), 5)
  expect_valid_colors(colors)
})

test_that("palette_diverging() returns correct number of colors", {
  for (n in c(1, 5, 11, 20)) {
    colors <- palette_diverging(n)
    expect_equal(length(colors), n)
  }
})

test_that("palette_diverging() returns valid colors", {
  colors <- palette_diverging(11)
  expect_valid_colors(colors)
})

test_that("palette_diverging() handles midpoint parameter", {
  colors_white <- palette_diverging(5, midpoint = "white")
  colors_gray <- palette_diverging(5, midpoint = "gray90")

  expect_equal(length(colors_white), 5)
  expect_equal(length(colors_gray), 5)
  expect_valid_colors(colors_white)
  expect_valid_colors(colors_gray)
})

test_that("palette_diverging() handles alpha parameter", {
  colors <- palette_diverging(5, alpha = 0.75)
  expect_equal(length(colors), 5)
  expect_valid_colors(colors)
})

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

test_that("palettes handle n=1", {
  expect_equal(length(palette_rainbow(1)), 1)
  expect_equal(length(palette_colorblind(1)), 1)
  expect_equal(length(palette_pastel(1)), 1)
  expect_equal(length(palette_viridis(1)), 1)
  expect_equal(length(palette_blues(1)), 1)
  expect_equal(length(palette_reds(1)), 1)
  expect_equal(length(palette_diverging(1)), 1)
})

test_that("palettes handle large n", {
  n <- 100
  expect_equal(length(palette_rainbow(n)), n)
  expect_equal(length(palette_colorblind(n)), n)
  expect_equal(length(palette_pastel(n)), n)
  expect_equal(length(palette_viridis(n)), n)
  expect_equal(length(palette_blues(n)), n)
  expect_equal(length(palette_reds(n)), n)
  expect_equal(length(palette_diverging(n)), n)
})

test_that("palettes return character vectors", {
  expect_type(palette_rainbow(5), "character")
  expect_type(palette_colorblind(5), "character")
  expect_type(palette_pastel(5), "character")
  expect_type(palette_viridis(5), "character")
  expect_type(palette_blues(5), "character")
  expect_type(palette_reds(5), "character")
  expect_type(palette_diverging(5), "character")
})

test_that("alpha=0 produces transparent colors", {
  colors <- palette_rainbow(3, alpha = 0)
  expect_equal(length(colors), 3)

  # Verify alpha channel is 0
  for (col in colors) {
    rgb_vals <- grDevices::col2rgb(col, alpha = TRUE)
    expect_equal(unname(rgb_vals["alpha", 1]), 0)
  }
})

test_that("alpha=1 produces opaque colors", {
  colors <- palette_rainbow(3, alpha = 1)

  # Verify alpha channel is 255 (fully opaque)
  for (col in colors) {
    rgb_vals <- grDevices::col2rgb(col, alpha = TRUE)
    expect_equal(unname(rgb_vals["alpha", 1]), 255)
  }
})

# ============================================
# SN_PALETTE() FUNCTION
# ============================================

test_that("sn_palette() applies palette to nodes", {
  adj <- create_test_matrix(5)
  net <- cograph(adj)

  net2 <- sn_palette(net, "viridis", target = "nodes")

  expect_cograph_network(net2)
  aes <- net2$node_aes
  expect_true(!is.null(aes$fill))
})

test_that("sn_palette() applies palette to edges", {
  adj <- create_test_matrix(5)
  net <- cograph(adj)

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

  expect_cograph_network(net2)
  aes <- net2$edge_aes
  expect_true(!is.null(aes$positive_color) || !is.null(aes$negative_color))
})

test_that("sn_palette() applies palette to both nodes and edges", {
  adj <- create_test_matrix(5)
  net <- cograph(adj)

  net2 <- sn_palette(net, "colorblind", target = "both")

  expect_cograph_network(net2)
})

test_that("sn_palette() works with string palette name", {
  adj <- create_test_matrix(5)
  net <- cograph(adj)

  # Test all built-in palette names
  for (pal_name in c("rainbow", "colorblind", "pastel", "viridis", "blues", "reds", "diverging")) {
    net2 <- sn_palette(net, pal_name)
    expect_cograph_network(net2)
  }
})

test_that("sn_palette() works with custom palette function", {
  adj <- create_test_matrix(5)
  net <- cograph(adj)

  custom_pal <- function(n) rep("purple", n)
  net2 <- sn_palette(net, custom_pal)

  expect_cograph_network(net2)
  aes <- net2$node_aes
  expect_true(all(aes$fill == "purple"))
})

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

  expect_error(sn_palette(net, "unknown_palette"))
})

test_that("sn_palette() can map colors by variable", {
  adj <- create_test_matrix(5)
  net <- cograph(adj)

  # This tests the 'by' parameter functionality
  # When by is specified and exists in nodes, colors are mapped
  net2 <- sn_palette(net, "colorblind", target = "nodes")
  expect_cograph_network(net2)
})

test_that("sn_palette() preserves network structure", {
  adj <- create_test_matrix(5)
  net <- cograph(adj)
  n_nodes_before <- n_nodes(net)
  n_edges_before <- n_edges(net)

  net2 <- sn_palette(net, "viridis")

  expect_equal(n_nodes(net2), n_nodes_before)
  expect_equal(n_edges(net2), n_edges_before)
})

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

test_that("splot() works with palette-customized network", {
  adj <- create_test_matrix(5)
  net <- cograph(adj) |>
    sn_palette("viridis", target = "nodes")

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

test_that("palette colors render correctly in splot", {
  adj <- create_test_matrix(4)

  # Test direct use with node_fill using palette
  colors <- palette_colorblind(4)

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

# ============================================
# PALETTE REGISTRY
# ============================================

test_that("list_palettes() returns available palettes", {
  skip_if_not(exists("list_palettes", envir = asNamespace("cograph")))

  palettes <- cograph:::list_palettes()

  expect_true(length(palettes) > 0)
  expect_true("rainbow" %in% palettes)
  expect_true("colorblind" %in% palettes)
  expect_true("viridis" %in% palettes)
})

test_that("get_palette() retrieves palette functions", {
  skip_if_not(exists("get_palette", envir = asNamespace("cograph")))

  pal_fn <- cograph:::get_palette("rainbow")

  expect_true(is.function(pal_fn))
  colors <- pal_fn(5)
  expect_equal(length(colors), 5)
})

test_that("get_palette() returns NULL for unknown palette", {
  skip_if_not(exists("get_palette", envir = asNamespace("cograph")))

  result <- cograph:::get_palette("nonexistent_palette")
  expect_null(result)
})