# 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") })