tests/testthat/test-coverage-plot-ml-heatmap-41.R

In cograph: Analysis and Visualization of Complex Networks

# Tests for plot_ml_heatmap() - Extended Coverage
# Coverage: R/plot-ml-heatmap.R
#
# This file extends test-coverage-plot-ml-heatmap-40.R with additional tests
# focusing on:
#   - cograph_network input with layer column detection
#   - Message output verification
#   - Error handling edge cases
#   - Graphics rendering with with_temp_png()
#   - Additional internal helper edge cases

# ============================================
# Setup: Make internal functions available
# ============================================

.extract_ml_layers <- cograph:::.extract_ml_layers
.transform_to_plane <- cograph:::.transform_to_plane
.build_ml_cells <- cograph:::.build_ml_cells
.build_ml_shells <- cograph:::.build_ml_shells
.build_ml_labels <- cograph:::.build_ml_labels
.build_ml_connections <- cograph:::.build_ml_connections
.resolve_ml_colors <- cograph:::.resolve_ml_colors

# ============================================
# Test Data Setup
# ============================================

create_test_layers <- function(n_layers = 3, n_rows = 4, n_cols = 4, seed = 42) {
  set.seed(seed)
  layers <- lapply(seq_len(n_layers), function(i) {
    matrix(runif(n_rows * n_cols), n_rows, n_cols)
  })
  names(layers) <- paste0("Layer", seq_len(n_layers))
  layers
}

# ============================================
# cograph_network Input Tests
# ============================================

test_that(".extract_ml_layers works with cograph_network with 'layers' column", {
  skip_if_not_installed("ggplot2")

  # Create a simple cograph_network with layers column
  mat <- matrix(runif(16), 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  net <- cograph(mat, layout = "circle")
  net$nodes$layers <- c("L1", "L1", "L2", "L2")

  # Auto-detect layers from "layers" column
  expect_message(
    result <- .extract_ml_layers(net, layer_list = NULL),
    "Using 'layers' column for layers"
  )

  expect_type(result, "list")
  expect_length(result, 2)
  expect_true(all(sapply(result, is.matrix)))
})

test_that(".extract_ml_layers works with cograph_network with 'layer' column", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(16), 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  net <- cograph(mat, layout = "circle")
  net$nodes$layer <- c("GroupA", "GroupA", "GroupB", "GroupB")

  expect_message(
    result <- .extract_ml_layers(net, layer_list = NULL),
    "Using 'layer' column for layers"
  )

  expect_type(result, "list")
  expect_length(result, 2)
})

test_that(".extract_ml_layers works with cograph_network with 'level' column", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(9), 3, 3)
  rownames(mat) <- colnames(mat) <- c("N1", "N2", "N3")

  net <- cograph(mat, layout = "circle")
  net$nodes$level <- c("Top", "Middle", "Bottom")

  expect_message(
    result <- .extract_ml_layers(net, layer_list = NULL),
    "Using 'level' column for layers"
  )

  expect_type(result, "list")
  expect_length(result, 3)
})

test_that(".extract_ml_layers works with cograph_network with 'levels' column", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(9), 3, 3)
  rownames(mat) <- colnames(mat) <- c("N1", "N2", "N3")

  net <- cograph(mat, layout = "circle")
  net$nodes$levels <- c("Level1", "Level2", "Level1")

  expect_message(
    result <- .extract_ml_layers(net, layer_list = NULL),
    "Using 'levels' column for layers"
  )

  expect_type(result, "list")
  expect_length(result, 2)
})

test_that(".extract_ml_layers works with cograph_network and explicit column name", {

  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(16), 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  net <- cograph(mat, layout = "circle")
  net$nodes$my_groups <- c("G1", "G1", "G2", "G2")

  # Pass the column name as layer_list
  # Note: message prints the split result, not the column name (line 201 in source)
  expect_message(
    result <- .extract_ml_layers(net, layer_list = "my_groups"),
    "Using '.*' column for layers"
  )

  expect_type(result, "list")
  expect_length(result, 2)
})

test_that(".extract_ml_layers errors on cograph_network without layer info", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(9), 3, 3)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")

  net <- cograph(mat, layout = "circle")
  # No layers/layer/level/levels column

  expect_error(
    .extract_ml_layers(net, layer_list = NULL),
    "layer_list required"
  )
})

test_that(".extract_ml_layers works with cograph_network and list layer_list", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(16), 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  net <- cograph(mat, layout = "circle")

  layer_list <- list(
    Group1 = c("A", "B"),
    Group2 = c("C", "D")
  )

  result <- .extract_ml_layers(net, layer_list = layer_list)

  expect_type(result, "list")
  expect_length(result, 2)
  expect_equal(names(result), c("Group1", "Group2"))
})

# ============================================
# plot_ml_heatmap with cograph_network
# ============================================

test_that("plot_ml_heatmap works with cograph_network with layers column", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(16), 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  net <- cograph(mat, layout = "circle")
  net$nodes$layers <- c("L1", "L1", "L2", "L2")

  expect_message(
    p <- plot_ml_heatmap(net),
    "Using 'layers' column for layers"
  )

  expect_s3_class(p, "ggplot")
})

test_that("plot_ml_heatmap works with cograph_network and explicit layer_list", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(16), 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")

  net <- cograph(mat, layout = "circle")

  layer_list <- list(
    Layer1 = c("A", "B"),
    Layer2 = c("C", "D")
  )

  p <- plot_ml_heatmap(net, layer_list = layer_list)

  expect_s3_class(p, "ggplot")
})

test_that("plot_ml_heatmap errors on cograph_network without layer info", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(9), 3, 3)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C")

  net <- cograph(mat, layout = "circle")

  expect_error(
    plot_ml_heatmap(net),
    "layer_list required"
  )
})

# ============================================
# Graphics Rendering Tests with with_temp_png
# ============================================

test_that("plot_ml_heatmap renders correctly with basic list", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 3)

  with_temp_png({
    p <- plot_ml_heatmap(layers)
    print(p)
  })

  expect_true(TRUE)
})

test_that("plot_ml_heatmap renders with show_connections = TRUE", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 3)

  with_temp_png({
    p <- plot_ml_heatmap(layers, show_connections = TRUE)
    print(p)
  })

  expect_true(TRUE)
})

test_that("plot_ml_heatmap renders with all visual parameters", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)

  with_temp_png({
    p <- plot_ml_heatmap(
      layers,
      colors = "plasma",
      layer_spacing = 3,
      skew = 0.5,
      compress = 0.7,
      show_connections = TRUE,
      connection_color = "#00FF00",
      connection_style = "solid",
      show_borders = TRUE,
      border_color = "navy",
      border_width = 2,
      cell_border_color = "grey",
      cell_border_width = 0.3,
      show_labels = TRUE,
      label_size = 6,
      show_legend = TRUE,
      legend_title = "Custom Legend",
      title = "Test Title",
      limits = c(0, 1),
      na_color = "yellow"
    )
    print(p)
  })

  expect_true(TRUE)
})

test_that("plot_ml_heatmap renders without legend", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)

  with_temp_png({
    p <- plot_ml_heatmap(layers, show_legend = FALSE)
    print(p)
  })

  expect_true(TRUE)
})

test_that("plot_ml_heatmap renders without borders", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)

  with_temp_png({
    p <- plot_ml_heatmap(layers, show_borders = FALSE)
    print(p)
  })

  expect_true(TRUE)
})

test_that("plot_ml_heatmap renders without labels", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)

  with_temp_png({
    p <- plot_ml_heatmap(layers, show_labels = FALSE)
    print(p)
  })

  expect_true(TRUE)
})

test_that("plot_ml_heatmap renders with cograph_network", {
  skip_if_not_installed("ggplot2")

  mat <- matrix(runif(16), 4, 4)
  rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
  net <- cograph(mat, layout = "circle")
  net$nodes$layers <- c("L1", "L1", "L2", "L2")

  with_temp_png({
    p <- suppressMessages(plot_ml_heatmap(net))
    print(p)
  })

  expect_true(TRUE)
})

# ============================================
# Additional Edge Cases for Internal Helpers
# ============================================

test_that(".transform_to_plane handles zero layer_spacing", {
  result <- .transform_to_plane(
    x = 1, y = 1,
    layer_idx = 1, n_layers = 3,
    skew = 0.4, compress = 0.6,
    layer_spacing = 0
  )

  expect_type(result, "list")
  expect_true(is.numeric(result$x))
  expect_true(is.numeric(result$y))
})

test_that(".transform_to_plane handles single layer", {
  result <- .transform_to_plane(
    x = 0, y = 0,
    layer_idx = 1, n_layers = 1,
    skew = 0.4, compress = 0.6,
    layer_spacing = 2.5
  )

  expect_type(result, "list")
  expect_equal(result$x, 0)
  # y should be 0 * 0.6 + 0 = 0 (n_layers - layer_idx = 1 - 1 = 0)
  expect_equal(result$y, 0)
})

test_that(".transform_to_plane handles extreme skew = 1", {
  result <- .transform_to_plane(
    x = 1, y = 1,
    layer_idx = 1, n_layers = 2,
    skew = 1, compress = 0.6,
    layer_spacing = 2.5
  )

  expect_type(result, "list")
  # x_new = x + y * skew = 1 + 1 * 1 = 2
  expect_equal(result$x, 2)
})

test_that(".transform_to_plane handles compress = 1", {
  result <- .transform_to_plane(
    x = 1, y = 2,
    layer_idx = 2, n_layers = 3,
    skew = 0, compress = 1,
    layer_spacing = 2.5
  )

  expect_type(result, "list")
  # y_new = y * compress + y_offset = 2 * 1 + (3 - 2) * 2.5 = 2 + 2.5 = 4.5
  expect_equal(result$y, 4.5)
})

test_that(".build_ml_cells handles single cell matrix", {
  layers <- list(L1 = matrix(0.5, 1, 1))

  cells <- .build_ml_cells(layers, skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  expect_s3_class(cells, "data.frame")
  # 1 layer x 1 cell x 4 corners = 4 rows

  expect_equal(nrow(cells), 4)
})

test_that(".build_ml_cells preserves weight values", {
  layers <- list(
    L1 = matrix(c(0.1, 0.2, 0.3, 0.4), 2, 2)
  )

  cells <- .build_ml_cells(layers, skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  # Each cell appears 4 times (4 corners)
  unique_weights <- unique(cells$weight)
  expect_setequal(unique_weights, c(0.1, 0.2, 0.3, 0.4))
})

test_that(".build_ml_cells handles layers with different dimensions is not supported", {
  # This tests that if layers have different sizes, we still get output
  # (the function uses the first layer's dimensions)
  layers <- list(
    L1 = matrix(runif(4), 2, 2),
    L2 = matrix(runif(9), 3, 3)
  )

  # This should work but may not render correctly visually
  cells <- .build_ml_cells(layers, skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  expect_s3_class(cells, "data.frame")
})

test_that(".build_ml_shells handles single layer", {
  layers <- list(Single = matrix(runif(4), 2, 2))

  shells <- .build_ml_shells(layers, n_rows = 2, n_cols = 2,
    skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  expect_s3_class(shells, "data.frame")
  # 1 layer x 5 corners = 5 rows
  expect_equal(nrow(shells), 5)
})

test_that(".build_ml_labels handles single layer", {
  layers <- list(Single = matrix(runif(4), 2, 2))

  labels <- .build_ml_labels(layers, n_rows = 2,
    skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  expect_s3_class(labels, "data.frame")
  expect_equal(nrow(labels), 1)
  expect_equal(labels$label, "Single")
})

test_that(".build_ml_connections returns empty-like structure for single layer", {
  layers <- list(Single = matrix(runif(4), 2, 2))

  conns <- .build_ml_connections(layers, n_rows = 2, n_cols = 2,
    skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  # With single layer, n_layers - 1 = 0 layer pairs, so no connections
  expect_null(conns)
})

test_that(".build_ml_connections handles non-square matrices", {
  layers <- list(
    L1 = matrix(runif(6), 2, 3),
    L2 = matrix(runif(6), 2, 3)
  )

  conns <- .build_ml_connections(layers, n_rows = 2, n_cols = 3,
    skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  expect_s3_class(conns, "data.frame")
  # min(2, 3) = 2 diagonal cells x 1 layer pair x 2 points = 4 rows
  expect_equal(nrow(conns), 4)
})

test_that(".resolve_ml_colors returns single-color as named palette default", {
  single_color <- c("red")
  result <- .resolve_ml_colors(single_color)

  # Single element string that doesn't match known palettes returns viridis default
  # because the switch() falls through to default
  expect_type(result, "character")
  expect_true(length(result) > 1)
})

test_that(".resolve_ml_colors handles two-color gradient", {
  colors <- c("white", "red")
  result <- .resolve_ml_colors(colors)

  expect_equal(result, colors)
  expect_length(result, 2)
})

# ============================================
# Connection Style Edge Cases
# ============================================

test_that("plot_ml_heatmap handles unknown connection_style", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)

  # Unknown style should default to "solid"
  p <- plot_ml_heatmap(layers,
    show_connections = TRUE,
    connection_style = "unknown_style"
  )

  expect_s3_class(p, "ggplot")
})

# ============================================
# NA Values in Matrices
# ============================================

test_that("plot_ml_heatmap handles matrices with all NA values", {
  skip_if_not_installed("ggplot2")

  layers <- list(
    A = matrix(NA, 2, 2),
    B = matrix(NA, 2, 2)
  )

  p <- plot_ml_heatmap(layers, na_color = "purple")

  expect_s3_class(p, "ggplot")
})

test_that("plot_ml_heatmap renders matrices with NA values", {
  skip_if_not_installed("ggplot2")

  layers <- list(
    A = matrix(c(0.5, NA, 0.3, NA), 2, 2),
    B = matrix(c(NA, 0.7, NA, 0.9), 2, 2)
  )

  with_temp_png({
    p <- plot_ml_heatmap(layers, na_color = "grey50")
    print(p)
  })

  expect_true(TRUE)
})

# ============================================
# Limits Parameter Edge Cases
# ============================================

test_that("plot_ml_heatmap handles limits outside data range", {
  skip_if_not_installed("ggplot2")

  set.seed(42)
  layers <- list(
    A = matrix(runif(4, 0.2, 0.8), 2, 2),
    B = matrix(runif(4, 0.2, 0.8), 2, 2)
  )

  # Limits extend beyond data range
  p <- plot_ml_heatmap(layers, limits = c(0, 2))

  expect_s3_class(p, "ggplot")
})

test_that("plot_ml_heatmap handles limits narrower than data range", {
  skip_if_not_installed("ggplot2")

  set.seed(42)
  layers <- list(
    A = matrix(runif(4, 0, 1), 2, 2),
    B = matrix(runif(4, 0, 1), 2, 2)
  )

  # Limits narrower than data - values outside will be clamped
  p <- plot_ml_heatmap(layers, limits = c(0.3, 0.7))

  expect_s3_class(p, "ggplot")
})

# ============================================
# Very Small/Large Values
# ============================================

test_that("plot_ml_heatmap handles very small values", {
  skip_if_not_installed("ggplot2")

  layers <- list(
    A = matrix(1e-10, 2, 2),
    B = matrix(1e-10, 2, 2)
  )

  p <- plot_ml_heatmap(layers)

  expect_s3_class(p, "ggplot")
})

test_that("plot_ml_heatmap handles very large values", {
  skip_if_not_installed("ggplot2")

  layers <- list(
    A = matrix(1e10, 2, 2),
    B = matrix(1e10, 2, 2)
  )

  p <- plot_ml_heatmap(layers)

  expect_s3_class(p, "ggplot")
})

test_that("plot_ml_heatmap handles mixed positive/negative values", {
  skip_if_not_installed("ggplot2")

  set.seed(42)
  layers <- list(
    A = matrix(rnorm(4), 2, 2),
    B = matrix(rnorm(4), 2, 2)
  )

  p <- plot_ml_heatmap(layers)

  expect_s3_class(p, "ggplot")
})

# ============================================
# Multiple Layers Stress Test
# ============================================

test_that("plot_ml_heatmap handles many layers", {
  skip_if_not_installed("ggplot2")
  skip_on_cran()

  set.seed(42)
  layers <- lapply(1:10, function(i) {
    matrix(runif(9), 3, 3)
  })
  names(layers) <- paste0("L", 1:10)

  p <- plot_ml_heatmap(layers)

  expect_s3_class(p, "ggplot")
})

test_that("plot_ml_heatmap renders many layers", {
  skip_if_not_installed("ggplot2")
  skip_on_cran()

  set.seed(42)
  layers <- lapply(1:5, function(i) {
    matrix(runif(16), 4, 4)
  })
  names(layers) <- paste0("Layer", 1:5)

  with_temp_png(width = 400, height = 400, {
    p <- plot_ml_heatmap(layers, show_connections = TRUE)
    print(p)
  })

  expect_true(TRUE)
})

# ============================================
# Unicode and Special Characters in Layer Names
# ============================================

test_that("plot_ml_heatmap handles layer names with spaces", {
  skip_if_not_installed("ggplot2")

  layers <- list(
    "Layer One" = matrix(runif(4), 2, 2),
    "Layer Two" = matrix(runif(4), 2, 2)
  )

  p <- plot_ml_heatmap(layers)

  expect_s3_class(p, "ggplot")
})

test_that("plot_ml_heatmap handles layer names with special characters", {
  skip_if_not_installed("ggplot2")

  layers <- list(
    "Layer-1" = matrix(runif(4), 2, 2),
    "Layer_2" = matrix(runif(4), 2, 2),
    "Layer.3" = matrix(runif(4), 2, 2)
  )

  p <- plot_ml_heatmap(layers)

  expect_s3_class(p, "ggplot")
})

# ============================================
# Different Matrix Sizes per Layer
# ============================================

test_that("plot_ml_heatmap works with varying matrix sizes", {
  skip_if_not_installed("ggplot2")

  # Note: This may not render correctly but should not error
  layers <- list(
    Small = matrix(runif(4), 2, 2),
    Large = matrix(runif(9), 3, 3)
  )

  p <- plot_ml_heatmap(layers)

  expect_s3_class(p, "ggplot")
})

# ============================================
# Zero Dimension Handling
# ============================================

test_that(".build_ml_connections handles very small n_connect", {
  layers <- list(
    L1 = matrix(runif(2), 1, 2),
    L2 = matrix(runif(2), 1, 2)
  )

  conns <- .build_ml_connections(layers, n_rows = 1, n_cols = 2,
    skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  expect_s3_class(conns, "data.frame")
  # min(1, 2) = 1 diagonal cell x 1 layer pair x 2 points = 2 rows
  expect_equal(nrow(conns), 2)
})

# ============================================
# Layer Index Calculations
# ============================================

test_that(".build_ml_cells correctly assigns layer_idx", {
  layers <- list(
    First = matrix(0.1, 2, 2),
    Second = matrix(0.2, 2, 2),
    Third = matrix(0.3, 2, 2)
  )

  cells <- .build_ml_cells(layers, skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  # Check layer_idx values
  expect_equal(sort(unique(cells$layer_idx)), c(1, 2, 3))
})

test_that(".build_ml_shells correctly assigns layer names", {
  layers <- list(
    Alpha = matrix(runif(4), 2, 2),
    Beta = matrix(runif(4), 2, 2),
    Gamma = matrix(runif(4), 2, 2)
  )

  shells <- .build_ml_shells(layers, n_rows = 2, n_cols = 2,
    skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  expect_true("Alpha" %in% shells$layer)
  expect_true("Beta" %in% shells$layer)
  expect_true("Gamma" %in% shells$layer)
})

# ============================================
# Cell ID Uniqueness
# ============================================

test_that(".build_ml_cells generates unique cell_ids", {
  layers <- create_test_layers(n_layers = 3, n_rows = 4, n_cols = 4)

  cells <- .build_ml_cells(layers, skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  # Each cell has 4 corners, cell_id is repeated 4 times
  cell_counts <- table(cells$cell_id)
  expect_true(all(cell_counts == 4))

  # Total unique cells = 3 layers x 4 rows x 4 cols = 48
  expect_equal(length(unique(cells$cell_id)), 48)
})

# ============================================
# Layer Factor Levels
# ============================================

test_that(".build_ml_cells creates factor with reversed layer levels", {
  layers <- list(
    A = matrix(runif(4), 2, 2),
    B = matrix(runif(4), 2, 2),
    C = matrix(runif(4), 2, 2)
  )

  cells <- .build_ml_cells(layers, skew = 0.4, compress = 0.6, layer_spacing = 2.5)

  expect_true(is.factor(cells$layer))
  expect_equal(levels(cells$layer), c("C", "B", "A"))
})

# ============================================
# Empty Layer List Handling
# ============================================

test_that(".extract_ml_layers returns empty list for empty input", {
  # An empty list of matrices returns empty list (not an error)
  result <- .extract_ml_layers(list(), layer_list = NULL)
  expect_type(result, "list")
  expect_length(result, 0)
})

# ============================================
# Color Scale Integration
# ============================================

test_that("plot_ml_heatmap color scales render correctly", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)

  palettes <- c("viridis", "inferno", "plasma", "heat", "blues", "reds")

  for (pal in palettes) {
    with_temp_png({
      p <- plot_ml_heatmap(layers, colors = pal)
      print(p)
    })
  }

  expect_true(TRUE)
})

# ============================================
# Combined Parameters Stress Test
# ============================================

test_that("plot_ml_heatmap handles all off options", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)

  p <- plot_ml_heatmap(
    layers,
    show_connections = FALSE,
    show_borders = FALSE,
    show_labels = FALSE,
    show_legend = FALSE,
    title = NULL
  )

  expect_s3_class(p, "ggplot")

  with_temp_png({
    print(p)
  })

  expect_true(TRUE)
})

test_that("plot_ml_heatmap handles all on options with connections", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 3)

  p <- plot_ml_heatmap(
    layers,
    show_connections = TRUE,
    connection_color = "#FF0000",
    connection_style = "dotted",
    show_borders = TRUE,
    border_color = "blue",
    border_width = 3,
    cell_border_color = "white",
    cell_border_width = 0.5,
    show_labels = TRUE,
    label_size = 7,
    show_legend = TRUE,
    legend_title = "Intensity",
    title = "Full Features"
  )

  expect_s3_class(p, "ggplot")

  with_temp_png({
    print(p)
  })

  expect_true(TRUE)
})

# ============================================
# Matrix Input with layer_list
# ============================================

test_that("plot_ml_heatmap handles matrix with overlapping node names", {
  skip_if_not_installed("ggplot2")

  full_matrix <- matrix(runif(36), 6, 6)
  rownames(full_matrix) <- colnames(full_matrix) <- paste0("N", 1:6)

  # Non-overlapping groups
  layer_list <- list(
    G1 = c("N1", "N2"),
    G2 = c("N3", "N4"),
    G3 = c("N5", "N6")
  )

  p <- plot_ml_heatmap(full_matrix, layer_list = layer_list)

  expect_s3_class(p, "ggplot")
})

test_that(".extract_ml_layers preserves submatrix structure", {
  full_matrix <- matrix(1:25, 5, 5)
  rownames(full_matrix) <- colnames(full_matrix) <- LETTERS[1:5]

  layer_list <- list(
    First = c("A", "B"),
    Second = c("C", "D", "E")
  )

  result <- .extract_ml_layers(full_matrix, layer_list = layer_list)

  expect_equal(dim(result$First), c(2, 2))
  expect_equal(dim(result$Second), c(3, 3))

  # Check that values are correctly extracted
  expect_equal(result$First, full_matrix[c("A", "B"), c("A", "B")])
  expect_equal(result$Second, full_matrix[c("C", "D", "E"), c("C", "D", "E")])
})

# ============================================
# Return Value Tests
# ============================================

test_that("plot_ml_heatmap returns ggplot with expected layers", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)
  p <- plot_ml_heatmap(layers, show_connections = TRUE, show_borders = TRUE)

  # Check plot has expected structure

  expect_s3_class(p, "ggplot")
  expect_true(length(p$layers) >= 2)  # At least cells + borders
})

test_that("plot_ml_heatmap coordinates are applied", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)
  p <- plot_ml_heatmap(layers)

  # Check that coordinates are applied (CoordCartesian or CoordFixed depending on ggplot2 version)
  expect_true(inherits(p$coordinates, "Coord"))
})

# ============================================
# Threshold Parameter Tests
# ============================================

test_that("plot_ml_heatmap threshold sets small cells to NA", {
  skip_if_not_installed("ggplot2")

  layers <- list(
    L1 = matrix(c(0.5, 0.03, 0.8, 0.01), 2, 2),
    L2 = matrix(c(0.04, 0.6, 0.02, 0.9), 2, 2)
  )

  p <- plot_ml_heatmap(layers, threshold = 0.05)
  expect_s3_class(p, "ggplot")

  # Cell polygon data should have NA weights for values below threshold
  cell_data <- p$layers[[1]]$data
  expect_true(any(is.na(cell_data$weight)))
})

test_that("plot_ml_heatmap threshold = 0 is a no-op", {
  skip_if_not_installed("ggplot2")

  layers <- create_test_layers(n_layers = 2)

  p1 <- plot_ml_heatmap(layers, threshold = 0)
  p2 <- plot_ml_heatmap(layers)

  d1 <- ggplot2::ggplot_build(p1)$data[[1]]
  d2 <- ggplot2::ggplot_build(p2)$data[[1]]
  expect_equal(d1$fill, d2$fill)
})