# Tests for plot_compare() and related comparison functions # Network difference visualization # ============================================ # Basic plot_compare() Tests # ============================================ test_that("plot_compare works with basic matrices", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.7, 0), 2, 2) expect_no_error(with_temp_png(cograph::plot_compare(mat1, mat2))) }) test_that("plot_compare returns invisibly", { mat1 <- matrix(c(0, 0.5, 0.3, 0), 2, 2) mat2 <- matrix(c(0, 0.2, 0.4, 0), 2, 2) result <- with_temp_png(cograph::plot_compare(mat1, mat2)) expect_type(result, "list") expect_true("weights" %in% names(result)) expect_true(is.matrix(result$weights)) }) test_that("plot_compare computes correct difference", { mat1 <- matrix(c(0, 0.6, 0.4, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.5, 0), 2, 2) result <- with_temp_png(cograph::plot_compare(mat1, mat2)) expected_diff <- mat1 - mat2 expect_equal(result$weights, expected_diff) }) test_that("plot_compare works with labeled matrices", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) mat2 <- matrix(c(0, 0.3, 0.7, 0), 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) expect_no_error(with_temp_png(cograph::plot_compare(mat1, mat2))) }) test_that("plot_compare preserves labels in output", { mat1 <- matrix(0, 3, 3, dimnames = list(LETTERS[1:3], LETTERS[1:3])) mat2 <- matrix(0, 3, 3, dimnames = list(LETTERS[1:3], LETTERS[1:3])) mat1[1, 2] <- 0.5 mat2[1, 2] <- 0.3 result <- with_temp_png(cograph::plot_compare(mat1, mat2)) expect_equal(rownames(result$weights), LETTERS[1:3]) expect_equal(colnames(result$weights), LETTERS[1:3]) }) # ============================================ # Color Parameter Tests # ============================================ test_that("plot_compare respects pos_color parameter", { mat1 <- matrix(c(0, 0.6, 0.3, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.6, 0), 2, 2) expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, pos_color = "#00FF00") )) }) test_that("plot_compare respects neg_color parameter", { mat1 <- matrix(c(0, 0.3, 0.6, 0), 2, 2) mat2 <- matrix(c(0, 0.6, 0.3, 0), 2, 2) expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, neg_color = "#FF0000") )) }) test_that("plot_compare respects both color parameters", { mat1 <- matrix(c(0, 0.5, 0.3, 0), 2, 2) mat2 <- matrix(c(0, 0.2, 0.6, 0), 2, 2) expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, pos_color = "darkgreen", neg_color = "darkred") )) }) # ============================================ # Title Parameter Tests # ============================================ test_that("plot_compare uses custom title", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, title = "Custom Title") )) }) test_that("plot_compare auto-generates title", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) # Default title should be generated expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2) )) }) # ============================================ # Labels Parameter Tests # ============================================ test_that("plot_compare respects custom labels", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, labels = c("Node1", "Node2")) )) }) # ============================================ # Input Validation Tests # ============================================ test_that("plot_compare errors when y is missing", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) expect_error( with_temp_png(cograph::plot_compare(mat1)), "y is required" ) }) test_that("plot_compare errors on dimension mismatch", { mat1 <- matrix(0, 2, 2) mat2 <- matrix(0, 3, 3) expect_error( with_temp_png(cograph::plot_compare(mat1, mat2)), "same dimensions" ) }) test_that("plot_compare errors on label mismatch", { mat1 <- matrix(0, 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) mat2 <- matrix(0, 2, 2, dimnames = list(c("X", "Y"), c("X", "Y"))) mat1[1, 2] <- 0.5 mat2[1, 2] <- 0.3 expect_error( with_temp_png(cograph::plot_compare(mat1, mat2)), "same node labels" ) }) # ============================================ # Inits/Donut Display Tests # ============================================ test_that("plot_compare works with inits_x and inits_y", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) inits1 <- c(0.6, 0.4) inits2 <- c(0.4, 0.6) result <- with_temp_png( cograph::plot_compare(mat1, mat2, inits_x = inits1, inits_y = inits2) ) expect_equal(result$inits, inits1 - inits2) }) test_that("plot_compare show_inits = FALSE hides donuts", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) inits1 <- c(0.6, 0.4) inits2 <- c(0.4, 0.6) # Should not error even with inits provided expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, inits_x = inits1, inits_y = inits2, show_inits = FALSE) )) }) test_that("plot_compare donut_inner_ratio is respected", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) inits1 <- c(0.6, 0.4) inits2 <- c(0.4, 0.6) expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, inits_x = inits1, inits_y = inits2, donut_inner_ratio = 0.5) )) }) test_that("plot_compare warns on inits length mismatch", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) inits1 <- c(0.6, 0.4, 0.5) # Wrong length inits2 <- c(0.4, 0.6) expect_warning( with_temp_png( cograph::plot_compare(mat1, mat2, inits_x = inits1, inits_y = inits2) ), "length doesn't match" ) }) # ============================================ # List Input Tests # ============================================ test_that("plot_compare works with list of matrices", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) net_list <- list(first = mat1, second = mat2) expect_no_error(with_temp_png( cograph::plot_compare(net_list) )) }) test_that("plot_compare list with i and j parameters", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) mat3 <- matrix(c(0, 0.7, 0.7, 0), 2, 2) net_list <- list(A = mat1, B = mat2, C = mat3) # Compare specific elements expect_no_error(with_temp_png( cograph::plot_compare(net_list, i = 1, j = 3) )) expect_no_error(with_temp_png( cograph::plot_compare(net_list, i = "A", j = "C") )) }) test_that("plot_compare errors on single-element list", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) net_list <- list(only = mat1) expect_error( with_temp_png(cograph::plot_compare(net_list)), "at least 2" ) }) # ============================================ # TNA Integration Tests # ============================================ test_that("plot_compare works with tna objects", { skip_if_no_tna() library(tna) data(engagement, package = "tna") # Create simple tna models from different subsets model1 <- tna(engagement[1:100, ]) model2 <- tna(engagement[101:200, ]) expect_no_error(with_temp_png( cograph::plot_compare(model1, model2) )) }) test_that("plot_compare auto-extracts inits from tna objects", { skip_if_no_tna() library(tna) data(engagement, package = "tna") model1 <- tna(engagement[1:100, ]) model2 <- tna(engagement[101:200, ]) result <- with_temp_png( cograph::plot_compare(model1, model2) ) # Should have extracted inits difference expect_true(!is.null(result$inits)) }) test_that("plot_compare works with group_tna objects", { skip_if_no_tna() library(tna) data(engagement, package = "tna") # Create artificial groups n <- nrow(engagement) groups <- rep(c("A", "B"), length.out = n) group_model <- group_tna(engagement, group = groups) # Should compare the two groups expect_no_error(with_temp_png( cograph::plot_compare(group_model) )) }) test_that("plot_compare group_tna with specific i, j", { skip_if_no_tna() library(tna) data(engagement, package = "tna") # Create artificial groups n <- nrow(engagement) groups <- rep(c("A", "B"), length.out = n) group_model <- group_tna(engagement, group = groups) expect_no_error(with_temp_png( cograph::plot_compare(group_model, i = 1, j = 2) )) }) test_that("plot_compare errors on group_tna with < 2 groups", { skip_if_no_tna() library(tna) data(engagement, package = "tna") # Single group single_group <- group_tna( engagement, group = rep("A", nrow(engagement)) ) expect_error( with_temp_png(cograph::plot_compare(single_group)), "at least 2 groups" ) }) # ============================================ # Edge Case Tests # ============================================ test_that("plot_compare handles identical matrices", { mat <- matrix(c(0, 0.5, 0.5, 0), 2, 2) result <- with_temp_png(cograph::plot_compare(mat, mat)) # All differences should be zero expect_true(all(result$weights == 0)) }) test_that("plot_compare handles zero matrices", { mat1 <- matrix(0, 3, 3) mat2 <- matrix(0, 3, 3) expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2) )) }) test_that("plot_compare handles negative differences", { mat1 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) mat2 <- matrix(c(0, 0.7, 0.7, 0), 2, 2) result <- with_temp_png(cograph::plot_compare(mat1, mat2)) # Differences should be negative expect_true(all(result$weights[result$weights != 0] < 0)) }) test_that("plot_compare handles larger networks", { skip_on_cran() n <- 10 set.seed(42) mat1 <- matrix(runif(n * n), n, n) mat2 <- matrix(runif(n * n), n, n) diag(mat1) <- 0 diag(mat2) <- 0 expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2), width = 400, height = 400 )) }) # ============================================ # plot_comparison_heatmap() Tests # ============================================ test_that("plot_comparison_heatmap works with basic matrices", { skip_if_not_installed("ggplot2") mat1 <- matrix(runif(9), 3, 3) mat2 <- matrix(runif(9), 3, 3) p <- plot_comparison_heatmap(mat1, mat2) expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap type = 'difference'", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, type = "difference") expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap type = 'x'", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) p <- plot_comparison_heatmap(mat1, type = "x") expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap type = 'y'", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, type = "y") expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap errors when y required but missing", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) expect_error( plot_comparison_heatmap(mat1, type = "difference"), "y is required" ) expect_error( plot_comparison_heatmap(mat1, type = "y"), "y is required" ) }) test_that("plot_comparison_heatmap respects color parameters", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, low_color = "green", mid_color = "yellow", high_color = "purple") expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap show_values = TRUE", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, show_values = TRUE) expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap respects custom limits", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, limits = c(-1, 1)) expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap respects name_x and name_y", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) p <- plot_comparison_heatmap(mat1, mat2, name_x = "Model A", name_y = "Model B") expect_s3_class(p, "ggplot") }) test_that("plot_comparison_heatmap with labeled matrices", { skip_if_not_installed("ggplot2") mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) p <- plot_comparison_heatmap(mat1, mat2) expect_s3_class(p, "ggplot") }) # ============================================ # Passthrough Argument Tests # ============================================ test_that("plot_compare passes additional arguments to splot", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) # Test layout passthrough expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, layout = "circle") )) # Test node_size passthrough expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2, node_size = 10) )) }) # ============================================ # TNA Styling Defaults Tests # ============================================ test_that("plot_compare applies TNA styling when inputs are tna objects", { skip_if_no_tna() library(tna) data(engagement, package = "tna") model1 <- tna(engagement[1:100, ]) model2 <- tna(engagement[101:200, ]) # Should not error — TNA defaults (edge_labels, node_fill, etc.) applied expect_no_error(with_temp_png( cograph::plot_compare(model1, model2) )) }) test_that("plot_compare TNA styling can be overridden by user args", { skip_if_no_tna() library(tna) data(engagement, package = "tna") model1 <- tna(engagement[1:100, ]) model2 <- tna(engagement[101:200, ]) # Override TNA defaults — should not error expect_no_error(with_temp_png( cograph::plot_compare(model1, model2, edge_labels = FALSE, node_fill = "gray", node_size = 5) )) }) test_that("plot_compare does not apply TNA styling for plain matrices", { mat1 <- matrix(c(0, 0.5, 0.5, 0), 2, 2) mat2 <- matrix(c(0, 0.3, 0.3, 0), 2, 2) # Plain matrices should work without TNA defaults expect_no_error(with_temp_png( cograph::plot_compare(mat1, mat2) )) }) test_that("plot_compare group_tna applies TNA styling", { skip_if_no_tna() library(tna) data(engagement, package = "tna") n <- nrow(engagement) groups <- rep(c("A", "B"), length.out = n) group_model <- group_tna(engagement, group = groups) # group_tna elements are tna objects, so TNA styling should apply expect_no_error(with_temp_png( cograph::plot_compare(group_model) )) })