tests/testthat/test-coverage-plot-mcml-40.R

# Tests for plot_mcml() Multi-Cluster Multi-Layer Network visualization
# Comprehensive coverage for R/plot-mcml.R

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

# Create test matrices and cluster lists for reuse
create_test_weights <- function(n = 6, seed = 42) {
  set.seed(seed)
  mat <- matrix(runif(n * n, 0, 0.5), n, n)
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:n]
  mat
}

create_test_clusters <- function(n = 6) {
  list(
    Cluster1 = LETTERS[1:2],
    Cluster2 = LETTERS[3:4],
    Cluster3 = LETTERS[5:6]
  )
}

# ============================================
# Basic Functionality Tests
# ============================================

test_that("plot_mcml works with basic matrix and clusters", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters)
  ))
})

test_that("plot_mcml returns cluster_summary invisibly", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- with_temp_png(plot_mcml(weights, clusters))

  expect_s3_class(result, "cluster_summary")
  expect_equal(result$meta$n_clusters, 3)
  expect_equal(result$meta$n_nodes, 6)
})

test_that("mcml returns cluster_summary", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  expect_s3_class(result, "cluster_summary")
  expect_equal(result$meta$n_clusters, 3)
  expect_equal(result$meta$n_nodes, 6)
  expect_equal(names(result$clusters), c("Cluster1", "Cluster2", "Cluster3"))
  expect_true(is.matrix(result$macro$weights))
  expect_equal(nrow(result$macro$weights), 3)
  expect_equal(ncol(result$macro$weights), 3)
  expect_true(is.numeric(result$macro$inits))
  expect_equal(length(result$macro$inits), 3)
})

test_that("plot_mcml accepts cluster_summary object", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # First extract data
  data <- cluster_summary(weights, clusters)

  # Then plot from pre-extracted data
  expect_no_error(with_temp_png(
    result <- plot_mcml(data)
  ))

  # Should return the same object
  expect_s3_class(result, "cluster_summary")
})

test_that("plot_mcml handles unlabeled matrices", {
  set.seed(42)
  mat <- matrix(runif(16, 0, 0.5), 4, 4)
  diag(mat) <- 0
  # No row/column names

  clusters <- list(
    C1 = c(1, 2),
    C2 = c(3, 4)
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml works with numeric indices in clusters", {
  set.seed(42)
  mat <- matrix(runif(16, 0, 0.5), 4, 4)
  diag(mat) <- 0

  clusters <- list(
    A = c(1, 2),
    B = c(3, 4)
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

# ============================================
# TNA Object Integration Tests
# ============================================

test_that("plot_mcml works with tna objects", {
  skip_if_no_tna()

  library(tna)
  data(engagement, package = "tna")
  model <- tna(engagement)

  # engagement has 3 labels: Active, Average, Disengaged
  n_labels <- length(model$labels)
  if (n_labels >= 2) {
    clusters <- list(
      A = model$labels[1],
      B = model$labels[2:n_labels]
    )

    expect_no_error(with_temp_png(
      plot_mcml(model, clusters)
    ))
  }
})

test_that("plot_mcml extracts weights and labels from tna", {
  skip_if_no_tna()

  library(tna)
  data(engagement, package = "tna")
  model <- tna(engagement)

  n_labels <- length(model$labels)
  if (n_labels >= 2) {
    half <- ceiling(n_labels / 2)
    # Ensure we don't go out of bounds
    second_half_start <- min(half + 1, n_labels)

    clusters <- list(
      A = model$labels[1:half],
      B = model$labels[second_half_start:n_labels]
    )

    # Should work without error, extracting weights from tna
    expect_no_error(with_temp_png(
      plot_mcml(model, clusters)
    ))
  }
})

# ============================================
# Parameter Tests - layer_spacing
# ============================================

test_that("plot_mcml respects custom layer_spacing", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, layer_spacing = 6)
  ))

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, layer_spacing = 2)
  ))
})

test_that("plot_mcml auto-calculates layer_spacing when NULL", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Default is NULL - should auto-calculate

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, layer_spacing = NULL)
  ))
})

# ============================================
# Parameter Tests - spacing
# ============================================

test_that("plot_mcml respects cluster spacing parameter", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, spacing = 5)
  ))

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, spacing = 1)
  ))
})

# ============================================
# Parameter Tests - shape_size
# ============================================

test_that("plot_mcml respects shape_size parameter", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, shape_size = 2)
  ))

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, shape_size = 0.5)
  ))
})

# ============================================
# Parameter Tests - summary_size
# ============================================

test_that("plot_mcml respects summary_size parameter", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, summary_size = 6)
  ))

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, summary_size = 2)
  ))
})

# ============================================
# Parameter Tests - skew_angle
# ============================================

test_that("plot_mcml respects skew_angle parameter", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Different perspective angles
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, skew_angle = 30)
  ))

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, skew_angle = 80)
  ))

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, skew_angle = 0)
  ))
})

# ============================================
# Parameter Tests - aggregation
# ============================================

test_that("plot_mcml uses sum aggregation by default", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Default aggregation is "sum"
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, aggregation = "sum")
  ))
})

test_that("plot_mcml respects mean aggregation", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, aggregation = "mean")
  ))
})

test_that("plot_mcml respects max aggregation", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, aggregation = "max")
  ))
})

test_that("plot_mcml errors on invalid aggregation", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_error(
    with_temp_png(plot_mcml(weights, clusters, aggregation = "invalid")),
    "arg"
  )
})

# ============================================
# Parameter Tests - minimum
# ============================================

test_that("plot_mcml respects minimum edge threshold", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # High minimum filters out weak edges
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, minimum = 0.3)
  ))

  # No threshold
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, minimum = 0)
  ))
})

test_that("plot_mcml handles high minimum threshold", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Very high threshold - may filter all edges
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, minimum = 0.9)
  ))
})

# ============================================
# Parameter Tests - colors
# ============================================

test_that("plot_mcml uses auto colors when colors = NULL", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, colors = NULL)
  ))
})

test_that("plot_mcml respects custom colors", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  custom_colors <- c("red", "blue", "green")

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, colors = custom_colors)
  ))
})

test_that("plot_mcml recycles colors when fewer than clusters", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()  # 3 clusters

  # Only provide 2 colors - should recycle
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, colors = c("red", "blue"))
  ))
})

test_that("plot_mcml works with hex colors", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  hex_colors <- c("#E69F00", "#56B4E9", "#009E73")

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, colors = hex_colors)
  ))
})

# ============================================
# Parameter Tests - legend
# ============================================

test_that("plot_mcml shows legend by default", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, legend = TRUE)
  ))
})

test_that("plot_mcml hides legend when legend = FALSE", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, legend = FALSE)
  ))
})

# ============================================
# Cluster Configuration Tests
# ============================================

test_that("plot_mcml handles two clusters", {
  set.seed(42)
  mat <- matrix(runif(16, 0, 0.5), 4, 4)
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles many clusters", {
  set.seed(42)
  n <- 12
  mat <- matrix(runif(n * n, 0, 0.5), n, n)
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:n]

  clusters <- list(
    C1 = LETTERS[1:2],
    C2 = LETTERS[3:4],
    C3 = LETTERS[5:6],
    C4 = LETTERS[7:8],
    C5 = LETTERS[9:10],
    C6 = LETTERS[11:12]
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles single-node clusters", {
  set.seed(42)
  mat <- matrix(runif(9, 0, 0.5), 3, 3)
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:3]

  clusters <- list(
    C1 = "A",
    C2 = "B",
    C3 = "C"
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles mixed cluster sizes", {
  set.seed(42)
  n <- 6
  mat <- matrix(runif(n * n, 0, 0.5), n, n)
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:n]

  clusters <- list(
    Large = LETTERS[1:4],  # 4 nodes
    Small = LETTERS[5:6]   # 2 nodes
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles unnamed clusters", {
  weights <- create_test_weights()

  # Clusters without names
  clusters <- list(
    LETTERS[1:2],
    LETTERS[3:4],
    LETTERS[5:6]
  )

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters)
  ))
})

# ============================================
# Edge Case Tests
# ============================================

test_that("plot_mcml handles zero weight matrix", {
  mat <- matrix(0, 4, 4)
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles sparse matrix", {
  set.seed(42)
  mat <- matrix(0, 6, 6)
  colnames(mat) <- rownames(mat) <- LETTERS[1:6]
  # Only one edge
  mat[1, 2] <- 0.5

  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles matrix with NAs", {
  set.seed(42)
  mat <- matrix(runif(16, 0, 0.5), 4, 4)
  diag(mat) <- 0
  mat[1, 2] <- NA
  mat[2, 3] <- NA
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles all weights equal", {
  mat <- matrix(0.5, 4, 4)
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles diagonal weights", {
  set.seed(42)
  mat <- matrix(runif(16, 0, 0.5), 4, 4)
  # Non-zero diagonal (self-loops)
  diag(mat) <- 0.3
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

# ============================================
# Visual Parameter Combination Tests
# ============================================

test_that("plot_mcml works with all visual parameters", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(
      weights, clusters,
      layer_spacing = 5,
      spacing = 4,
      shape_size = 1.5,
      summary_size = 5,
      skew_angle = 45,
      aggregation = "mean",
      minimum = 0.1,
      colors = c("#FF5733", "#33FF57", "#3357FF"),
      legend = TRUE
    )
  ))
})

test_that("plot_mcml works with minimal visual parameters", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(
      weights, clusters,
      shape_size = 0.5,
      summary_size = 2,
      legend = FALSE
    )
  ))
})

# ============================================
# Edge Weight Scaling Tests
# ============================================

test_that("plot_mcml scales edge widths by weight", {
  set.seed(42)
  mat <- matrix(0, 4, 4)
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  # Create edges with varying weights
  mat[1, 2] <- 0.1  # weak
  mat[3, 4] <- 0.9  # strong

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles very large weights", {
  set.seed(42)
  mat <- matrix(runif(16, 0, 10), 4, 4)  # Large weights
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles very small weights", {
  set.seed(42)
  mat <- matrix(runif(16, 0, 0.01), 4, 4)  # Small weights
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

# ============================================
# Cluster Inter-connections Tests
# ============================================

test_that("plot_mcml handles no inter-cluster connections", {
  mat <- matrix(0, 6, 6)
  colnames(mat) <- rownames(mat) <- LETTERS[1:6]

  # Only within-cluster edges
  mat[1, 2] <- 0.5
  mat[2, 1] <- 0.5
  mat[3, 4] <- 0.5
  mat[4, 3] <- 0.5
  mat[5, 6] <- 0.5
  mat[6, 5] <- 0.5

  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

test_that("plot_mcml handles only inter-cluster connections", {
  mat <- matrix(0, 6, 6)
  colnames(mat) <- rownames(mat) <- LETTERS[1:6]

  # Only between-cluster edges (no within-cluster)
  mat[1, 3] <- 0.5  # Cluster1 -> Cluster2
  mat[3, 5] <- 0.5  # Cluster2 -> Cluster3
  mat[5, 1] <- 0.5  # Cluster3 -> Cluster1

  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters)
  ))
})

# ============================================
# Perspective Tests
# ============================================

test_that("plot_mcml handles 90-degree skew (flat view)", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, skew_angle = 90)
  ))
})

test_that("plot_mcml handles small skew angles", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, skew_angle = 10)
  ))
})

# ============================================
# Large Network Tests
# ============================================

test_that("plot_mcml handles larger networks", {
  skip_on_cran()

  set.seed(42)
  n <- 20
  mat <- matrix(runif(n * n, 0, 0.5), n, n)
  diag(mat) <- 0
  labels <- paste0("N", 1:n)
  colnames(mat) <- rownames(mat) <- labels

  clusters <- list(
    C1 = labels[1:5],
    C2 = labels[6:10],
    C3 = labels[11:15],
    C4 = labels[16:20]
  )

  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters),
    width = 400, height = 400
  ))
})

# ============================================
# Device Compatibility Tests
# ============================================

test_that("plot_mcml works with PDF device", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_pdf(
    plot_mcml(weights, clusters)
  ))
})

test_that("plot_mcml works in nested plotting context", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png({
    old_par <- par(mfrow = c(1, 1))
    on.exit(par(old_par), add = TRUE)
    plot_mcml(weights, clusters)
  }))
})

# ============================================
# Aggregation Logic Tests
# ============================================

test_that("plot_mcml sum aggregation accumulates weights", {
  mat <- matrix(0, 4, 4)
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  # Multiple edges from cluster 1 to cluster 2
  mat[1, 3] <- 0.3
  mat[1, 4] <- 0.2
  mat[2, 3] <- 0.4
  mat[2, 4] <- 0.1

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  # Should work - sum would be 1.0 for A->B
  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters, aggregation = "sum")
  ))
})

test_that("plot_mcml mean aggregation averages weights", {
  mat <- matrix(0, 4, 4)
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  mat[1, 3] <- 0.8
  mat[1, 4] <- 0.2

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  # Mean of 0.8 and 0.2 = 0.5
  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters, aggregation = "mean")
  ))
})

test_that("plot_mcml max aggregation takes maximum weight", {
  mat <- matrix(0, 4, 4)
  colnames(mat) <- rownames(mat) <- LETTERS[1:4]

  mat[1, 3] <- 0.9
  mat[1, 4] <- 0.1

  clusters <- list(
    A = c("A", "B"),
    B = c("C", "D")
  )

  # Max should be 0.9
  expect_no_error(with_temp_png(
    plot_mcml(mat, clusters, aggregation = "max")
  ))
})

# ============================================
# Summary Layer Tests
# ============================================

test_that("plot_mcml draws summary nodes for each cluster", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Should draw top layer with summary nodes
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters)
  ))
})

test_that("plot_mcml draws inter-layer connections", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Dashed lines from detail nodes to summary nodes
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters)
  ))
})

# ============================================
# Shell Rendering Tests
# ============================================

test_that("plot_mcml draws cluster shells", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Elliptical shells around each cluster
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters)
  ))
})

# ============================================
# Integration Tests
# ============================================

test_that("plot_mcml integrates all components", {
  set.seed(123)
  n <- 8
  mat <- matrix(runif(n * n, 0, 0.6), n, n)
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- paste0("Node", 1:n)

  clusters <- list(
    Alpha = paste0("Node", 1:3),
    Beta = paste0("Node", 4:5),
    Gamma = paste0("Node", 6:8)
  )

  expect_no_error(with_temp_png(
    plot_mcml(
      mat, clusters,
      layer_spacing = 4,
      spacing = 3,
      shape_size = 1.2,
      summary_size = 4,
      skew_angle = 50,
      aggregation = "mean",
      minimum = 0.1,
      colors = c("coral", "steelblue", "seagreen"),
      legend = TRUE
    )
  ))
})

test_that("plot_mcml works in sequence", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png({
    plot_mcml(weights, clusters, aggregation = "sum")
    plot_mcml(weights, clusters, aggregation = "mean")
    plot_mcml(weights, clusters, aggregation = "max")
  }))
})

# ============================================
# mcml() Data Extraction Tests - NEW STRUCTURE
# ============================================

test_that("mcml returns cluster_summary class", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  expect_s3_class(result, "cluster_summary")
})

test_that("mcml between$weights has correct dimensions", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  expect_equal(nrow(result$macro$weights), 3)
  expect_equal(ncol(result$macro$weights), 3)
  expect_equal(rownames(result$macro$weights), c("Cluster1", "Cluster2", "Cluster3"))
  expect_equal(colnames(result$macro$weights), c("Cluster1", "Cluster2", "Cluster3"))
})

test_that("mcml between$weights diagonal is zero", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  # Diagonal contains intra-cluster retention
  expect_true(all(diag(result$macro$weights) >= 0))
})

test_that("mcml between$weights rows sum to 1 (type = tna)", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  row_sums <- rowSums(result$macro$weights)
  expect_true(all(abs(row_sums - 1) < 1e-10 | row_sums == 0))
})

test_that("mcml between$inits sums to 1", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  expect_equal(sum(result$macro$inits), 1, tolerance = 1e-10)
  expect_equal(length(result$macro$inits), 3)
  expect_equal(names(result$macro$inits), c("Cluster1", "Cluster2", "Cluster3"))
})

test_that("mcml with mean aggregation stores method", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters, aggregation = "mean")

  expect_equal(result$meta$method, "mean")
})

test_that("mcml with max aggregation stores method", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters, aggregation = "max")

  expect_equal(result$meta$method, "max")
})

test_that("mcml handles unlabeled matrix", {
  set.seed(42)
  mat <- matrix(runif(16, 0, 0.5), 4, 4)
  diag(mat) <- 0

  clusters <- list(
    C1 = c(1, 2),
    C2 = c(3, 4)
  )

  result <- mcml(mat, clusters)

  expect_equal(result$meta$n_nodes, 4)
  expect_equal(result$meta$n_clusters, 2)
})

test_that("mcml returns itself when given cluster_summary", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  data <- cluster_summary(weights, clusters)
  result <- mcml(data)

  expect_identical(data, result)
})

test_that("print.cluster_summary outputs summary", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  data <- mcml(weights, clusters)

  output <- capture.output(print(data))

  expect_true(any(grepl("Cluster Summary", output)))
  expect_true(any(grepl("Clusters:", output)))
})

test_that("mcml works with cograph_network input", {
  weights <- create_test_weights()

  net <- as_cograph(weights)
  net$nodes$cluster <- c("A", "A", "B", "B", "C", "C")

  result <- mcml(net)

  expect_s3_class(result, "cluster_summary")
  expect_equal(result$meta$n_clusters, 3)
})

test_that("mcml as_tna returns group_tna class object", {
  skip_if_not_installed("tna")
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters, as_tna = TRUE)

  expect_s3_class(result, "group_tna")
  expect_s3_class(result$macro, "tna")
  expect_true("weights" %in% names(result$macro))
  expect_true("inits" %in% names(result$macro))
  expect_true("labels" %in% names(result$macro))
})

test_that("mcml as_tna macro weights match cluster_summary", {
  skip_if_not_installed("tna")
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  cs <- mcml(weights, clusters)
  tna_obj <- mcml(weights, clusters, as_tna = TRUE)

  expect_equal(nrow(cs$macro$weights), nrow(tna_obj$macro$weights))
  expect_equal(length(cs$macro$inits), length(tna_obj$macro$inits))
})

# ============================================
# mcml() $clusters Field Tests - NEW STRUCTURE
# ============================================

test_that("mcml includes clusters field by default", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  expect_true("clusters" %in% names(result))
  expect_true(is.list(result$clusters))
  expect_equal(names(result$clusters), c("Cluster1", "Cluster2", "Cluster3"))
})

test_that("mcml clusters field contains per-cluster data", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  # Each cluster should have weights and inits
  for (cl_name in names(result$clusters)) {
    cl_data <- result$clusters[[cl_name]]
    expect_true("weights" %in% names(cl_data))
    expect_true("inits" %in% names(cl_data))
  }
})

test_that("mcml clusters weights is row-normalized", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  # Check each cluster's weights rows sum to 1 (or 0 if all zeros)
  for (cl_name in names(result$clusters)) {
    cl_w <- result$clusters[[cl_name]]$weights
    row_sums <- rowSums(cl_w)
    expect_true(all(abs(row_sums - 1) < 1e-10 | row_sums == 0))
  }
})

test_that("mcml within = FALSE skips clusters computation", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters, within = FALSE)

  expect_null(result$clusters)
  # macro should still exist
  expect_true("macro" %in% names(result))
})

test_that("mcml handles single-node clusters in clusters field", {
  set.seed(42)
  mat <- matrix(runif(9, 0, 0.5), 3, 3)
  diag(mat) <- 0
  colnames(mat) <- rownames(mat) <- LETTERS[1:3]

  clusters <- list(
    C1 = "A",
    C2 = "B",
    C3 = "C"
  )

  result <- mcml(mat, clusters)

  # Single-node clusters should have 1x1 zero matrices
  expect_equal(dim(result$clusters$C1$weights), c(1, 1))
  expect_equal(result$clusters$C1$weights[1, 1], 0)
  expect_equal(result$clusters$C1$inits, c(A = 1))
})

# ============================================
# plot_mcml() mode Parameter Tests
# ============================================

test_that("plot_mcml uses weights mode by default", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Default mode = "weights"
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters)
  ))
})

test_that("plot_mcml respects mode = 'weights'", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, mode = "weights")
  ))
})

test_that("plot_mcml respects mode = 'tna'", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, mode = "tna")
  ))
})

test_that("plot_mcml mode = 'tna' with edge labels", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Edge labels should show TNA probabilities when mode = "tna"
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, mode = "tna", summary_edge_labels = TRUE)
  ))
})

test_that("plot_mcml mode = 'tna' with within edge labels", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Within-cluster edge labels should also show TNA values
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, mode = "tna", edge_labels = TRUE)
  ))
})

test_that("plot_mcml errors on invalid mode", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  expect_error(
    with_temp_png(plot_mcml(weights, clusters, mode = "invalid")),
    "arg"
  )
})

test_that("plot_mcml mode parameter works with cluster_summary input", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # First extract data
  data <- cluster_summary(weights, clusters)

  # Then plot with mode = "tna"
  expect_no_error(with_temp_png(
    plot_mcml(data, mode = "tna", summary_edge_labels = TRUE)
  ))
})

# ============================================
# Backward Compatibility Tests
# ============================================

test_that("mcml backward compat: main fields exist", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  result <- mcml(weights, clusters)

  # Key fields should exist
  expect_true("clusters" %in% names(result))
  expect_true("macro" %in% names(result))
  expect_true("meta" %in% names(result))
})

test_that("plot_mcml backward compat: default behavior unchanged", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # This should work exactly as before - no mode parameter needed
  expect_no_error(with_temp_png(
    plot_mcml(weights, clusters, edge_labels = TRUE, summary_edge_labels = TRUE)
  ))
})

test_that("plot_mcml backward compat: cluster_summary input", {
  weights <- create_test_weights()
  clusters <- create_test_clusters()

  # Old workflow: extract then plot
  data <- cluster_summary(weights, clusters)
  expect_no_error(with_temp_png(
    result <- plot_mcml(data)
  ))

  # Should return the cluster_summary object
  expect_s3_class(result, "cluster_summary")
})

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.