# Comprehensive coverage tests for plot-compare.R # Targets UNCOVERED code paths to achieve higher coverage # Run: devtools::test(filter = "coverage-plot-compare-40") # ============================================ # Helper: Create mock group_tna object # ============================================ # Create a mock group_tna-like object for testing create_mock_group_tna <- function(n_groups = 2, n_nodes = 3) { groups <- vector("list", n_groups) group_names <- LETTERS[1:n_groups] for (i in seq_len(n_groups)) { set.seed(100 + i) mat <- matrix(runif(n_nodes * n_nodes), n_nodes, n_nodes) diag(mat) <- 0 rownames(mat) <- colnames(mat) <- paste0("N", 1:n_nodes) groups[[i]] <- list( weights = mat, inits = runif(n_nodes) ) groups[[i]]$inits <- groups[[i]]$inits / sum(groups[[i]]$inits) class(groups[[i]]) <- c("tna", "list") } names(groups) <- group_names class(groups) <- c("group_tna", "list") groups } # Create mock tna object create_mock_tna <- function(n_nodes = 3, seed = 42) { set.seed(seed) mat <- matrix(runif(n_nodes * n_nodes), n_nodes, n_nodes) diag(mat) <- 0 rownames(mat) <- colnames(mat) <- paste0("S", 1:n_nodes) inits <- runif(n_nodes) inits <- inits / sum(inits) obj <- list( weights = mat, inits = inits ) class(obj) <- c("tna", "list") obj } # ============================================ # Test: group_tna with single group error # ============================================ # SKIP: test_that("plot_compare errors on group_tna with single group", { # SKIP: single_group <- create_mock_group_tna(n_groups = 1) # SKIP: # SKIP: expect_error( # SKIP: with_temp_png(cograph::plot_compare(single_group)), # SKIP: "at least 2 groups" # SKIP: ) # SKIP: }) # ============================================ # Test: group_tna with exactly 2 groups auto-compare # ============================================ # SKIP: test_that("plot_compare auto-compares 2-group group_tna", { # SKIP: two_groups <- create_mock_group_tna(n_groups = 2) # SKIP: # SKIP: result <- with_temp_png(cograph::plot_compare(two_groups)) # SKIP: # SKIP: expect_type(result, "list") # SKIP: expect_true("weights" %in% names(result)) # SKIP: expect_true(is.matrix(result$weights)) # SKIP: }) # ============================================ # Test: group_tna with >2 groups (all pairs) # ============================================ # SKIP: test_that("plot_compare plots all pairs for 3-group group_tna", { # SKIP: three_groups <- create_mock_group_tna(n_groups = 3) # SKIP: # SKIP: result <- with_temp_png(cograph::plot_compare(three_groups)) # SKIP: # SKIP: # Should return a list with one entry per pair (3 pairs for 3 groups) # SKIP: expect_type(result, "list") # SKIP: expect_equal(length(result), 3) # C(3,2) = 3 pairs # SKIP: }) # SKIP: # SKIP: test_that("plot_compare plots all pairs for 4-group group_tna", { # SKIP: four_groups <- create_mock_group_tna(n_groups = 4) # SKIP: # SKIP: result <- with_temp_png(cograph::plot_compare(four_groups)) # SKIP: # SKIP: # Should return a list with one entry per pair (6 pairs for 4 groups) # SKIP: expect_type(result, "list") # SKIP: expect_equal(length(result), 6) # C(4,2) = 6 pairs # SKIP: }) # ============================================ # Test: group_tna with >4 groups requires force # ============================================ test_that("plot_compare errors on >4 groups without force", { five_groups <- create_mock_group_tna(n_groups = 5) # Use cograph::plot_compare explicitly to avoid tna masking expect_error( with_temp_png(cograph::plot_compare(five_groups)), "force = TRUE" ) }) test_that("plot_compare works with >4 groups when force = TRUE", { five_groups <- create_mock_group_tna(n_groups = 5) # Use cograph::plot_compare explicitly to avoid tna masking result <- with_temp_png(cograph::plot_compare(five_groups, force = TRUE)) # Should return a list with 10 pairs for 5 groups expect_type(result, "list") expect_equal(length(result), 10) # C(5,2) = 10 pairs }) # ============================================ # Test: group_tna default i when only j specified # ============================================ test_that("plot_compare defaults i=1 when only j specified", { three_groups <- create_mock_group_tna(n_groups = 3) # Use cograph::plot_compare explicitly to avoid tna masking result <- with_temp_png(cograph::plot_compare(three_groups, j = 3)) expect_type(result, "list") expect_true("weights" %in% names(result)) }) test_that("plot_compare defaults j=2 when only i specified", { three_groups <- create_mock_group_tna(n_groups = 3) # Use cograph::plot_compare explicitly to avoid tna masking result <- with_temp_png(cograph::plot_compare(three_groups, i = 1)) expect_type(result, "list") expect_true("weights" %in% names(result)) }) # ============================================ # Test: group_tna invalid indices error # ============================================ test_that("plot_compare errors on invalid group indices", { two_groups <- create_mock_group_tna(n_groups = 2) # The error occurs as subscript out of bounds before custom check # Use cograph::plot_compare explicitly to avoid tna masking expect_error( with_temp_png(cograph::plot_compare(two_groups, i = 1, j = 5)) ) }) test_that("plot_compare errors on invalid character index", { two_groups <- create_mock_group_tna(n_groups = 2) # The error occurs as subscript out of bounds before custom check # Use cograph::plot_compare explicitly to avoid tna masking expect_error( with_temp_png(cograph::plot_compare(two_groups, i = "A", j = "Z")) ) }) # ============================================ # Test: group_tna auto title from names # ============================================ test_that("plot_compare generates title from group names", { two_groups <- create_mock_group_tna(n_groups = 2) names(two_groups) <- c("Control", "Treatment") # Should not error and should use group names in title expect_no_error( with_temp_png(cograph::plot_compare(two_groups)) ) }) test_that("plot_compare uses character indices for title", { three_groups <- create_mock_group_tna(n_groups = 3) names(three_groups) <- c("Low", "Medium", "High") # Using character indices expect_no_error( with_temp_png(cograph::plot_compare(three_groups, i = "Low", j = "High")) ) }) # ============================================ # Test: Plain list of networks # ============================================ test_that("plot_compare works with plain named list", { mat1 <- matrix(runif(9), 3, 3) mat2 <- matrix(runif(9), 3, 3) mat3 <- matrix(runif(9), 3, 3) diag(mat1) <- diag(mat2) <- diag(mat3) <- 0 net_list <- list(A = mat1, B = mat2, C = mat3) # Default to first two result <- with_temp_png(cograph::plot_compare(net_list)) expect_type(result, "list") expect_true("weights" %in% names(result)) }) test_that("plot_compare list with character indices", { mat1 <- matrix(runif(9), 3, 3) mat2 <- matrix(runif(9), 3, 3) mat3 <- matrix(runif(9), 3, 3) net_list <- list(first = mat1, second = mat2, third = mat3) expect_no_error( with_temp_png(cograph::plot_compare(net_list, i = "first", j = "third")) ) }) test_that("plot_compare list errors on invalid indices", { mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) net_list <- list(A = mat1, B = mat2) # The error occurs as subscript out of bounds before custom check expect_error( with_temp_png(cograph::plot_compare(net_list, i = 1, j = 10)) ) }) test_that("plot_compare list errors when single element", { mat1 <- matrix(runif(4), 2, 2) net_list <- list(only = mat1) expect_error( with_temp_png(cograph::plot_compare(net_list)), "at least 2" ) }) test_that("plot_compare list generates title from names", { mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) net_list <- list(Morning = mat1, Evening = mat2) expect_no_error( with_temp_png(cograph::plot_compare(net_list)) ) }) # ============================================ # Test: Unnamed list defaults # ============================================ test_that("plot_compare handles unnamed list", { mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) net_list <- list(mat1, mat2) # No names result <- with_temp_png(cograph::plot_compare(net_list)) expect_type(result, "list") expect_true("weights" %in% names(result)) }) # ============================================ # Test: Labels fallback to numeric sequence # ============================================ test_that("plot_compare uses numeric labels when no rownames", { mat1 <- matrix(runif(9), 3, 3) mat2 <- matrix(runif(9), 3, 3) # No rownames/colnames result <- with_temp_png(cograph::plot_compare(mat1, mat2)) expect_type(result, "list") }) # ============================================ # Test: .extract_weights with various types # ============================================ test_that(".extract_weights handles matrix", { mat <- matrix(runif(9), 3, 3) result <- cograph:::.extract_weights(mat) expect_true(is.matrix(result)) expect_equal(dim(result), c(3, 3)) }) test_that(".extract_weights handles tna object", { tna_obj <- create_mock_tna() result <- cograph:::.extract_weights(tna_obj) expect_true(is.matrix(result)) }) test_that(".extract_weights handles list with $weights", { obj <- list(weights = matrix(runif(4), 2, 2)) result <- cograph:::.extract_weights(obj) expect_true(is.matrix(result)) }) test_that(".extract_weights errors on unsupported type", { expect_error( cograph:::.extract_weights("invalid"), "must be a matrix" ) }) test_that(".extract_weights errors on list without weights", { obj <- list(data = 1:5) expect_error( cograph:::.extract_weights(obj), "must be a matrix" ) }) # ============================================ # Test: .extract_inits with various types # ============================================ test_that(".extract_inits handles tna object", { tna_obj <- create_mock_tna() result <- cograph:::.extract_inits(tna_obj) expect_true(is.numeric(result)) expect_equal(length(result), 3) }) test_that(".extract_inits handles list with $inits", { obj <- list(inits = c(0.3, 0.3, 0.4)) result <- cograph:::.extract_inits(obj) expect_equal(result, c(0.3, 0.3, 0.4)) }) test_that(".extract_inits returns NULL for plain matrix", { mat <- matrix(runif(9), 3, 3) result <- cograph:::.extract_inits(mat) expect_null(result) }) test_that(".extract_inits returns NULL for list without inits", { obj <- list(weights = matrix(1, 2, 2)) result <- cograph:::.extract_inits(obj) expect_null(result) }) # ============================================ # Test: .plot_compare_all_pairs # ============================================ test_that(".plot_compare_all_pairs handles unnamed groups", { groups <- create_mock_group_tna(n_groups = 3) names(groups) <- NULL # Remove names result <- with_temp_png( cograph:::.plot_compare_all_pairs( groups, pos_color = "#009900", neg_color = "#C62828", labels = NULL, show_inits = NULL, donut_inner_ratio = 0.8 ) ) expect_type(result, "list") expect_equal(length(result), 3) }) test_that(".plot_compare_all_pairs with custom labels", { groups <- create_mock_group_tna(n_groups = 2, n_nodes = 3) result <- with_temp_png( cograph:::.plot_compare_all_pairs( groups, pos_color = "#009900", neg_color = "#C62828", labels = c("X", "Y", "Z"), # Custom labels show_inits = TRUE, donut_inner_ratio = 0.7 ) ) expect_type(result, "list") }) test_that(".plot_compare_all_pairs with show_inits = FALSE", { groups <- create_mock_group_tna(n_groups = 2) result <- with_temp_png( cograph:::.plot_compare_all_pairs( groups, pos_color = "#009900", neg_color = "#C62828", labels = NULL, show_inits = FALSE, # Disable inits donut_inner_ratio = 0.8 ) ) expect_type(result, "list") }) test_that(".plot_compare_all_pairs passes extra args to splot", { groups <- create_mock_group_tna(n_groups = 2, n_nodes = 3) result <- with_temp_png( cograph:::.plot_compare_all_pairs( groups, pos_color = "#009900", neg_color = "#C62828", labels = NULL, show_inits = NULL, donut_inner_ratio = 0.8, node_size = 12 # Extra arg ) ) expect_type(result, "list") }) # ============================================ # Test: plot_comparison_heatmap uncovered paths # ============================================ test_that("plot_comparison_heatmap dimension mismatch error", { skip_if_not_installed("ggplot2") mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(9), 3, 3) expect_error( plot_comparison_heatmap(mat1, mat2), "same dimensions" ) }) test_that("plot_comparison_heatmap with unlabeled matrices uses numeric", { skip_if_not_installed("ggplot2") mat1 <- matrix(runif(4), 2, 2) # No rownames/colnames mat2 <- matrix(runif(4), 2, 2) p <- plot_comparison_heatmap(mat1, mat2) expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap with custom title", { skip_if_not_installed("ggplot2") mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, title = "My Custom Title") expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap with custom axis labels", { skip_if_not_installed("ggplot2") mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, xlab = "To State", ylab = "From State") expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap value_size parameter", { skip_if_not_installed("ggplot2") mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, show_values = TRUE, value_size = 5) expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap digits parameter", { skip_if_not_installed("ggplot2") mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, show_values = TRUE, digits = 3) expect_s3_class(p, "ggplot") }) # ============================================ # Test: Inits processing edge cases # ============================================ test_that("plot_compare with inits length mismatch for both", { mat1 <- matrix(runif(9), 3, 3) mat2 <- matrix(runif(9), 3, 3) inits1 <- c(0.5, 0.5) # Wrong length inits2 <- c(0.5, 0.5) # Wrong length expect_warning( with_temp_png(cograph::plot_compare(mat1, mat2, inits_x = inits1, inits_y = inits2)), "length doesn't match" ) }) test_that("plot_compare with inits_y length mismatch only", { mat1 <- matrix(runif(9), 3, 3) mat2 <- matrix(runif(9), 3, 3) inits1 <- c(0.33, 0.33, 0.34) # Correct inits2 <- c(0.5, 0.5) # Wrong length expect_warning( with_temp_png(cograph::plot_compare(mat1, mat2, inits_x = inits1, inits_y = inits2)), "length doesn't match" ) }) test_that("plot_compare show_inits TRUE without inits available", { mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) # show_inits = TRUE but no inits provided - should still work # Use cograph::plot_compare explicitly to avoid tna masking result <- with_temp_png( cograph::plot_compare(mat1, mat2, show_inits = TRUE) ) expect_type(result, "list") expect_null(result$inits) }) # ============================================ # Test: Edge colors based on difference direction # ============================================ test_that("plot_compare handles all-positive differences", { mat1 <- matrix(c(0, 1, 1, 0), 2, 2) mat2 <- matrix(c(0, 0.1, 0.1, 0), 2, 2) result <- with_temp_png(cograph::plot_compare(mat1, mat2)) # All non-zero differences should be positive nonzero <- result$weights[result$weights != 0] expect_true(all(nonzero > 0)) }) test_that("plot_compare handles all-negative differences", { mat1 <- matrix(c(0, 0.1, 0.1, 0), 2, 2) mat2 <- matrix(c(0, 1, 1, 0), 2, 2) result <- with_temp_png(cograph::plot_compare(mat1, mat2)) # All non-zero differences should be negative nonzero <- result$weights[result$weights != 0] expect_true(all(nonzero < 0)) }) test_that("plot_compare handles mixed positive/negative differences", { mat1 <- matrix(c(0, 0.8, 0.2, 0), 2, 2) mat2 <- matrix(c(0, 0.2, 0.8, 0), 2, 2) result <- with_temp_png(cograph::plot_compare(mat1, mat2)) # Should have both positive and negative expect_true(any(result$weights > 0)) expect_true(any(result$weights < 0)) }) # ============================================ # Test: donut_fill capping at 1 # ============================================ test_that("plot_compare caps donut_fill at 1 for large diffs", { mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) inits1 <- c(1.0, 0.0) # Large difference inits2 <- c(0.0, 1.0) # Use cograph::plot_compare explicitly to avoid tna masking result <- with_temp_png( cograph::plot_compare(mat1, mat2, inits_x = inits1, inits_y = inits2) ) expect_type(result, "list") expect_equal(result$inits, inits1 - inits2) }) # ============================================ # Test: User args override defaults # ============================================ test_that("plot_compare user args override donut settings", { mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) inits1 <- c(0.6, 0.4) inits2 <- c(0.4, 0.6) # Override node_shape even when donut would be set # Use cograph::plot_compare explicitly to avoid tna masking result <- with_temp_png( cograph::plot_compare(mat1, mat2, inits_x = inits1, inits_y = inits2, node_shape = "circle") # Override donut ) expect_type(result, "list") }) test_that("plot_compare edge_width passthrough", { mat1 <- matrix(runif(4), 2, 2) mat2 <- matrix(runif(4), 2, 2) # Use cograph::plot_compare explicitly to avoid tna masking expect_no_error( with_temp_png( cograph::plot_compare(mat1, mat2, edge_width = 5) ) ) }) # ============================================ # Test: CographNetwork input # ============================================ test_that(".extract_weights handles CographNetwork R6", { skip_if_not_installed("R6") mat <- matrix(c(0, 0.5, 0.5, 0, 0.5, 0, 0, 0.5, 0), 3, 3) rownames(mat) <- colnames(mat) <- c("A", "B", "C") net <- CographNetwork$new(mat) # CographNetwork uses weights, not get_adjacency # The .extract_weights should handle it expect_error( cograph:::.extract_weights(net) ) }) # ============================================ # Test: igraph input # ============================================ test_that(".extract_weights handles weighted igraph object", { skip_if_not_installed("igraph") # Create weighted graph g <- igraph::make_ring(5) igraph::E(g)$weight <- runif(igraph::ecount(g)) result <- cograph:::.extract_weights(g) expect_true(is.matrix(result)) expect_equal(dim(result), c(5, 5)) }) test_that("plot_compare works with weighted igraph objects", { skip_if_not_installed("igraph") g1 <- igraph::make_ring(4) g2 <- igraph::make_star(4) # Add weights igraph::E(g1)$weight <- runif(igraph::ecount(g1)) igraph::E(g2)$weight <- runif(igraph::ecount(g2)) result <- with_temp_png(cograph::plot_compare(g1, g2)) expect_type(result, "list") expect_true(is.matrix(result$weights)) }) # ============================================ # Test: Label preservation in multi-pair comparison # ============================================ test_that(".plot_compare_all_pairs uses labels from matrix rownames", { groups <- create_mock_group_tna(n_groups = 2, n_nodes = 3) # Each group's weights has rownames rownames(groups[[1]]$weights) <- c("X", "Y", "Z") colnames(groups[[1]]$weights) <- c("X", "Y", "Z") rownames(groups[[2]]$weights) <- c("X", "Y", "Z") colnames(groups[[2]]$weights) <- c("X", "Y", "Z") result <- with_temp_png( cograph:::.plot_compare_all_pairs( groups, pos_color = "#009900", neg_color = "#C62828", labels = NULL, # Should extract from rownames show_inits = FALSE, donut_inner_ratio = 0.8 ) ) expect_type(result, "list") }) # ============================================ # Test: Inits in multi-pair comparison # ============================================ test_that(".plot_compare_all_pairs handles inits correctly", { groups <- create_mock_group_tna(n_groups = 2, n_nodes = 3) result <- with_temp_png( cograph:::.plot_compare_all_pairs( groups, pos_color = "#009900", neg_color = "#C62828", labels = NULL, show_inits = TRUE, # Enable donut_inner_ratio = 0.8 ) ) # Each pair should have inits in result expect_true(!is.null(result[[1]]$inits)) }) test_that(".plot_compare_all_pairs handles missing inits gracefully", { groups <- create_mock_group_tna(n_groups = 2, n_nodes = 3) # Remove inits from one group groups[[1]]$inits <- NULL result <- with_temp_png( cograph:::.plot_compare_all_pairs( groups, pos_color = "#009900", neg_color = "#C62828", labels = NULL, show_inits = TRUE, # Request inits but not available donut_inner_ratio = 0.8 ) ) # Should still work, inits will be NULL expect_type(result, "list") }) # ============================================ # Test: Layout parameter passthrough # ============================================ test_that("plot_compare respects layout = 'circle'", { mat1 <- matrix(runif(16), 4, 4) mat2 <- matrix(runif(16), 4, 4) expect_no_error( with_temp_png(cograph::plot_compare(mat1, mat2, layout = "circle")) ) }) test_that("plot_compare respects layout = 'spring'", { mat1 <- matrix(runif(16), 4, 4) mat2 <- matrix(runif(16), 4, 4) expect_no_error( with_temp_png(cograph::plot_compare(mat1, mat2, layout = "spring")) ) }) # ============================================ # Test: Larger networks # ============================================ test_that("plot_compare handles 10-node networks", { set.seed(123) mat1 <- matrix(runif(100), 10, 10) mat2 <- matrix(runif(100), 10, 10) diag(mat1) <- diag(mat2) <- 0 rownames(mat1) <- colnames(mat1) <- LETTERS[1:10] rownames(mat2) <- colnames(mat2) <- LETTERS[1:10] # Use cograph::plot_compare explicitly to avoid tna masking result <- with_temp_png( cograph::plot_compare(mat1, mat2), width = 400, height = 400 ) expect_type(result, "list") expect_equal(dim(result$weights), c(10, 10)) }) # ============================================ # Test: Single node network edge case # ============================================ test_that("plot_compare handles 1x1 matrices", { mat1 <- matrix(0, 1, 1) mat2 <- matrix(0, 1, 1) result <- with_temp_png(cograph::plot_compare(mat1, mat2)) expect_type(result, "list") expect_equal(dim(result$weights), c(1, 1)) }) # ============================================ # Test: Very small differences # ============================================ test_that("plot_compare handles tiny differences", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.5 + 1e-10, 0.5 - 1e-10, 0), 2, 2) result <- with_temp_png(cograph::plot_compare(mat1, mat2)) expect_type(result, "list") }) # ============================================ # Test: Sparse matrices (many zeros) # ============================================ test_that("plot_compare handles sparse differences", { mat1 <- matrix(0, 5, 5) mat2 <- matrix(0, 5, 5) mat1[1, 2] <- 0.5 # Single edge mat2[1, 2] <- 0.3 result <- with_temp_png(cograph::plot_compare(mat1, mat2)) expect_type(result, "list") # Only one non-zero difference expect_equal(sum(result$weights != 0), 1) })