# test-coverage-splot-params-41.R - Comprehensive tests for splot-params.R # Tests for splot parameter vectorization helpers skip_on_os("windows") # Load internal functions for testing resolve_edge_colors <- cograph:::resolve_edge_colors resolve_edge_widths <- cograph:::resolve_edge_widths resolve_node_sizes <- cograph:::resolve_node_sizes resolve_centrality_sizes <- cograph:::resolve_centrality_sizes resolve_label_sizes <- cograph:::resolve_label_sizes resolve_node_colors <- cograph:::resolve_node_colors resolve_labels <- cograph:::resolve_labels resolve_edge_labels <- cograph:::resolve_edge_labels resolve_shapes <- cograph:::resolve_shapes resolve_loop_rotation <- cograph:::resolve_loop_rotation filter_edges_by_weight <- cograph:::filter_edges_by_weight get_edge_order <- cograph:::get_edge_order get_node_order <- cograph:::get_node_order recycle_to_length <- cograph:::recycle_to_length get_scale_constants <- cograph:::get_scale_constants # ============================================ # RESOLVE_EDGE_COLORS TESTS # ============================================ test_that("resolve_edge_colors returns empty vector for zero edges", { edges <- data.frame(from = integer(0), to = integer(0)) result <- resolve_edge_colors(edges) expect_equal(length(result), 0) expect_type(result, "character") }) test_that("resolve_edge_colors uses user-specified single color", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.5, 0.3, 0.7)) result <- resolve_edge_colors(edges, edge.color = "blue") expect_equal(result, rep("blue", 3)) }) test_that("resolve_edge_colors recycles user-specified color vector", { edges <- data.frame(from = c(1, 2, 3, 4), to = c(2, 3, 4, 1)) result <- resolve_edge_colors(edges, edge.color = c("red", "blue")) expect_equal(result, c("red", "blue", "red", "blue")) }) test_that("resolve_edge_colors colors by weight sign - positive", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.5, 0.8)) result <- resolve_edge_colors(edges, posCol = "#00FF00", negCol = "#FF0000") expect_equal(result, c("#00FF00", "#00FF00")) }) test_that("resolve_edge_colors colors by weight sign - negative", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(-0.5, -0.8)) result <- resolve_edge_colors(edges, posCol = "#00FF00", negCol = "#FF0000") expect_equal(result, c("#FF0000", "#FF0000")) }) test_that("resolve_edge_colors colors by weight sign - mixed", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.5, -0.3, 0)) result <- resolve_edge_colors(edges, posCol = "green", negCol = "red", default_col = "gray") expect_equal(result, c("green", "red", "gray")) }) test_that("resolve_edge_colors uses default when no weights", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1)) result <- resolve_edge_colors(edges, default_col = "purple") expect_equal(result, rep("purple", 3)) }) test_that("resolve_edge_colors handles NA weights", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(NA, 0.5)) result <- resolve_edge_colors(edges, posCol = "green", negCol = "red", default_col = "gray") # NA weights should be handled gracefully expect_equal(length(result), 2) }) # ============================================ # RESOLVE_EDGE_WIDTHS TESTS # ============================================ test_that("resolve_edge_widths returns empty vector for zero edges", { edges <- data.frame(from = integer(0), to = integer(0)) result <- resolve_edge_widths(edges) expect_equal(length(result), 0) expect_type(result, "double") }) test_that("resolve_edge_widths treats 'weight' string as weight-based scaling", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.3, 0.8)) result <- resolve_edge_widths(edges, edge.width = "weight") expect_equal(length(result), 2) expect_true(result[2] > result[1]) # Heavier weight = thicker line }) test_that("resolve_edge_widths uses explicit numeric widths", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.5, 0.5, 0.5)) result <- resolve_edge_widths(edges, edge.width = 2.5) expect_equal(result, rep(2.5, 3)) }) test_that("resolve_edge_widths recycles numeric width vector", { edges <- data.frame(from = c(1, 2, 3, 4), to = c(2, 3, 4, 1)) result <- resolve_edge_widths(edges, edge.width = c(1, 2)) expect_equal(result, c(1, 2, 1, 2)) }) test_that("resolve_edge_widths uses scale constants for edge_width_range", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.2, 1.0)) # Not specifying edge_width_range should use scale constants default result <- resolve_edge_widths(edges) scale <- get_scale_constants("default") expect_true(all(result >= scale$edge_width_range[1])) expect_true(all(result <= scale$edge_width_range[2])) }) test_that("resolve_edge_widths uses scale constants for edge_scale_mode", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.1, 1.0)) # Should use default scale mode from constants result_default <- resolve_edge_widths(edges) result_sqrt <- resolve_edge_widths(edges, edge_scale_mode = "sqrt") # Different modes should produce different results expect_false(all(result_default == result_sqrt)) }) test_that("resolve_edge_widths handles edges without weight column", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1)) result <- resolve_edge_widths(edges) scale <- get_scale_constants("default") expect_equal(result, rep(scale$edge_width_default, 3)) }) test_that("resolve_edge_widths respects custom edge_width_range", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.1, 1.0)) result <- resolve_edge_widths(edges, edge_width_range = c(0.5, 10)) expect_true(all(result >= 0.5)) expect_true(all(result <= 10)) }) test_that("resolve_edge_widths works with legacy scaling", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.3, 0.9)) result_default <- resolve_edge_widths(edges, scaling = "default") result_legacy <- resolve_edge_widths(edges, scaling = "legacy") # Legacy has different range defaults expect_true(length(result_legacy) == 2) }) test_that("resolve_edge_widths respects n_nodes for adaptive sizing", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.5, 0.5)) # More nodes should produce thinner default edges result_few <- resolve_edge_widths(edges, n_nodes = 5) result_many <- resolve_edge_widths(edges, n_nodes = 100) # Both should work without error expect_equal(length(result_few), 2) expect_equal(length(result_many), 2) }) test_that("resolve_edge_widths handles directed parameter", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.5, 0.5)) result_undirected <- resolve_edge_widths(edges, directed = FALSE) result_directed <- resolve_edge_widths(edges, directed = TRUE) # Both should work expect_equal(length(result_undirected), 2) expect_equal(length(result_directed), 2) }) # ============================================ # RESOLVE_NODE_SIZES TESTS # ============================================ test_that("resolve_node_sizes uses default size when vsize is NULL", { result <- resolve_node_sizes(NULL, n = 5) scale <- get_scale_constants("default") expected <- rep(scale$node_default * scale$node_factor, 5) expect_equal(result, expected) }) test_that("resolve_node_sizes applies scale factor to vsize", { result <- resolve_node_sizes(vsize = 10, n = 3) scale <- get_scale_constants("default") expected <- rep(10 * scale$node_factor, 3) expect_equal(result, expected) }) test_that("resolve_node_sizes recycles vsize vector", { result <- resolve_node_sizes(vsize = c(5, 10), n = 4) scale <- get_scale_constants("default") expected <- c(5, 10, 5, 10) * scale$node_factor expect_equal(result, expected) }) test_that("resolve_node_sizes uses custom default_size", { result <- resolve_node_sizes(NULL, n = 3, default_size = 8) scale <- get_scale_constants("default") expected <- rep(8 * scale$node_factor, 3) expect_equal(result, expected) }) test_that("resolve_node_sizes uses custom scale_factor", { result <- resolve_node_sizes(vsize = 5, n = 2, scale_factor = 0.1) expected <- rep(5 * 0.1, 2) expect_equal(result, expected) }) test_that("resolve_node_sizes works with legacy scaling", { result_default <- resolve_node_sizes(vsize = 5, n = 2, scaling = "default") result_legacy <- resolve_node_sizes(vsize = 5, n = 2, scaling = "legacy") # Legacy has different factor scale_def <- get_scale_constants("default") scale_leg <- get_scale_constants("legacy") expect_equal(result_default, rep(5 * scale_def$node_factor, 2)) expect_equal(result_legacy, rep(5 * scale_leg$node_factor, 2)) }) # ============================================ # RESOLVE_CENTRALITY_SIZES TESTS # ============================================ test_that("resolve_centrality_sizes returns NULL when scale_by is NULL", { mat <- create_test_matrix(4) result <- resolve_centrality_sizes(mat, scale_by = NULL) expect_null(result) }) test_that("resolve_centrality_sizes calculates degree centrality", { mat <- create_test_matrix(5, density = 0.6) result <- resolve_centrality_sizes(mat, scale_by = "degree") expect_type(result, "list") expect_true("sizes" %in% names(result)) expect_true("values" %in% names(result)) expect_equal(length(result$sizes), 5) }) test_that("resolve_centrality_sizes calculates strength centrality", { mat <- create_test_matrix(5, weighted = TRUE) result <- resolve_centrality_sizes(mat, scale_by = "strength") expect_equal(length(result$sizes), 5) expect_true(all(result$sizes > 0)) }) test_that("resolve_centrality_sizes calculates betweenness centrality", { mat <- create_test_matrix(5, density = 0.7) result <- resolve_centrality_sizes(mat, scale_by = "betweenness") expect_equal(length(result$sizes), 5) }) test_that("resolve_centrality_sizes accepts list with measure and params", { mat <- create_test_matrix(5, weighted = TRUE) result <- resolve_centrality_sizes(mat, scale_by = list(measure = "degree")) expect_equal(length(result$sizes), 5) expect_equal(result$measure, "degree") }) test_that("resolve_centrality_sizes uses size_range parameter", { mat <- create_test_matrix(5) result <- resolve_centrality_sizes(mat, scale_by = "degree", size_range = c(1, 5)) scale <- get_scale_constants("default") # Sizes should be within range (before factor applied) scaled_range <- c(1, 5) * scale$node_factor expect_true(all(result$sizes >= scaled_range[1] - 0.01)) expect_true(all(result$sizes <= scaled_range[2] + 0.01)) }) test_that("resolve_centrality_sizes handles constant centrality values", { # Create a complete graph where all nodes have same degree mat <- create_test_topology("complete", n = 4) result <- resolve_centrality_sizes(mat, scale_by = "degree", size_range = c(2, 8)) # All sizes should be equal (mean of range) expect_true(all(abs(result$sizes - result$sizes[1]) < 0.01)) }) test_that("resolve_centrality_sizes errors for invalid measure", { mat <- create_test_matrix(5) expect_error( resolve_centrality_sizes(mat, scale_by = "invalid_measure"), "'arg' should be one of" ) }) test_that("resolve_centrality_sizes errors for invalid scale_by type", { mat <- create_test_matrix(5) expect_error( resolve_centrality_sizes(mat, scale_by = 123), "scale_nodes_by must be a character string or list" ) }) test_that("resolve_centrality_sizes works with legacy scaling", { mat <- create_test_matrix(5) result_default <- resolve_centrality_sizes(mat, scale_by = "degree", scaling = "default") result_legacy <- resolve_centrality_sizes(mat, scale_by = "degree", scaling = "legacy") # Sizes should differ due to different scale factors expect_false(all(result_default$sizes == result_legacy$sizes)) }) test_that("resolve_centrality_sizes handles NaN/NA in centrality values", { # Single node with no edges - some centrality measures may return NaN mat <- matrix(0, 3, 3) mat[1, 2] <- 1; mat[2, 1] <- 1 # Node 3 is isolated result <- resolve_centrality_sizes(mat, scale_by = "degree") expect_equal(length(result$sizes), 3) expect_false(any(is.na(result$sizes))) }) # ============================================ # DIRECTIONAL SHORTHANDS TESTS # ============================================ test_that("resolve_centrality_sizes accepts directional shorthand 'instrength'", { mat <- matrix(c(0, 0.5, 0, 0.3, 0, 0.7, 0.2, 0, 0), 3, 3) result <- resolve_centrality_sizes(mat, scale_by = "instrength") expect_equal(result$measure, "strength") expect_equal(length(result$sizes), 3) }) test_that("resolve_centrality_sizes accepts directional shorthand 'outstrength'", { mat <- matrix(c(0, 0.5, 0, 0.3, 0, 0.7, 0.2, 0, 0), 3, 3) result <- resolve_centrality_sizes(mat, scale_by = "outstrength") expect_equal(result$measure, "strength") expect_equal(length(result$sizes), 3) }) test_that("resolve_centrality_sizes accepts directional shorthand 'indegree'", { mat <- matrix(c(0, 1, 0, 0, 0, 1, 1, 0, 0), 3, 3) result <- resolve_centrality_sizes(mat, scale_by = "indegree") expect_equal(result$measure, "degree") }) test_that("resolve_centrality_sizes accepts directional shorthand 'outdegree'", { mat <- matrix(c(0, 1, 0, 0, 0, 1, 1, 0, 0), 3, 3) result <- resolve_centrality_sizes(mat, scale_by = "outdegree") expect_equal(result$measure, "degree") }) test_that("resolve_centrality_sizes directional shorthands are case-insensitive", { mat <- matrix(c(0, 0.5, 0, 0.3, 0, 0.7, 0.2, 0, 0), 3, 3) result <- resolve_centrality_sizes(mat, scale_by = "InStrength") expect_equal(result$measure, "strength") }) test_that("resolve_centrality_sizes: all directional shorthands resolve correctly", { mat <- matrix(c(0, 0.5, 0, 0.3, 0, 0.7, 0.2, 0, 0), 3, 3) shorthands <- c("incloseness", "outcloseness", "inharmonic", "outharmonic", "ineccentricity", "outeccentricity") expected_measures <- c("closeness", "closeness", "harmonic", "harmonic", "eccentricity", "eccentricity") vapply(seq_along(shorthands), function(i) { result <- resolve_centrality_sizes(mat, scale_by = shorthands[i]) expect_equal(result$measure, expected_measures[i], info = paste("Shorthand:", shorthands[i])) TRUE }, logical(1)) }) # ============================================ # SCALE_EXP (scale_nodes_scale) TESTS # ============================================ test_that("resolve_centrality_sizes: scale_exp = 1 is default (linear)", { mat <- matrix(c(0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0), 4, 4) result_default <- resolve_centrality_sizes(mat, scale_by = "degree") result_exp1 <- resolve_centrality_sizes(mat, scale_by = "degree", scale_exp = 1) expect_equal(result_default$sizes, result_exp1$sizes) }) test_that("resolve_centrality_sizes: scale_exp != 1 changes intermediate sizes", { mat <- matrix(c(0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0), 4, 4) result_linear <- resolve_centrality_sizes(mat, scale_by = "degree", scale_exp = 1) result_sqrt <- resolve_centrality_sizes(mat, scale_by = "degree", scale_exp = 0.5) result_sq <- resolve_centrality_sizes(mat, scale_by = "degree", scale_exp = 2) # Raw values are identical expect_equal(result_linear$values, result_sqrt$values) expect_equal(result_linear$values, result_sq$values) # Sizes differ for non-extreme nodes when exp != 1 expect_false(all(result_linear$sizes == result_sqrt$sizes)) expect_false(all(result_linear$sizes == result_sq$sizes)) }) test_that("resolve_centrality_sizes: scale_exp works with constant values", { mat <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), 3, 3) result <- resolve_centrality_sizes(mat, scale_by = "degree", scale_exp = 0.5) # All nodes have same degree -> should use middle of range regardless of exp expect_equal(length(unique(result$sizes)), 1) }) # ============================================ # RESOLVE_LABEL_SIZES TESTS # ============================================ test_that("resolve_label_sizes uses explicit label_size", { result <- resolve_label_sizes(label_size = 1.5, node_size_usr = rep(0.1, 3), n = 3) expect_equal(result, rep(1.5, 3)) }) test_that("resolve_label_sizes recycles label_size vector", { result <- resolve_label_sizes(label_size = c(0.8, 1.2), node_size_usr = rep(0.1, 4), n = 4) expect_equal(result, c(0.8, 1.2, 0.8, 1.2)) }) test_that("resolve_label_sizes uses default independent size in default scaling", { result <- resolve_label_sizes(label_size = NULL, node_size_usr = rep(0.1, 3), n = 3, scaling = "default") scale <- get_scale_constants("default") expect_equal(result, rep(scale$label_default, 3)) }) test_that("resolve_label_sizes couples to node size in legacy mode", { node_sizes <- c(0.05, 0.1, 0.15) result <- resolve_label_sizes(label_size = NULL, node_size_usr = node_sizes, n = 3, scaling = "legacy") # Legacy mode: vsize_usr * 8, capped at 1 expected <- pmin(1, node_sizes * 8) expect_equal(result, expected) }) test_that("resolve_label_sizes caps at 1 in legacy mode", { # Large node sizes should cap label size at 1 node_sizes <- c(0.2, 0.3, 0.5) # 0.2*8=1.6, 0.3*8=2.4, 0.5*8=4 result <- resolve_label_sizes(label_size = NULL, node_size_usr = node_sizes, n = 3, scaling = "legacy") expect_true(all(result <= 1)) }) # ============================================ # RESOLVE_NODE_COLORS TESTS # ============================================ test_that("resolve_node_colors uses explicit single color", { result <- resolve_node_colors("red", n = 4) expect_equal(result, rep("red", 4)) }) test_that("resolve_node_colors recycles color vector", { result <- resolve_node_colors(c("red", "blue"), n = 5) expect_equal(result, c("red", "blue", "red", "blue", "red")) }) test_that("resolve_node_colors colors by groups", { groups <- c("A", "A", "B", "B", "C") result <- resolve_node_colors(NULL, n = 5, groups = groups) expect_equal(length(result), 5) # Same group should have same color expect_equal(result[1], result[2]) expect_equal(result[3], result[4]) # Different groups should have different colors expect_false(result[1] == result[3]) }) test_that("resolve_node_colors uses colors from node data", { nodes <- data.frame(label = c("A", "B", "C"), color = c("#FF0000", "#00FF00", "#0000FF")) result <- resolve_node_colors(NULL, n = 3, nodes = nodes) expect_equal(result, c("#FF0000", "#00FF00", "#0000FF")) }) test_that("resolve_node_colors uses default when no color info", { result <- resolve_node_colors(NULL, n = 3, default_col = "steelblue") expect_equal(result, rep("steelblue", 3)) }) test_that("resolve_node_colors prioritizes explicit color over groups", { groups <- c("A", "B", "C") result <- resolve_node_colors("orange", n = 3, groups = groups) expect_equal(result, rep("orange", 3)) }) # ============================================ # RESOLVE_LABELS TESTS # ============================================ test_that("resolve_labels returns NULL for NULL input", { result <- resolve_labels(NULL, nodes = NULL, n = 5) expect_null(result) }) test_that("resolve_labels returns NULL for FALSE input", { result <- resolve_labels(FALSE, nodes = NULL, n = 5) expect_null(result) }) test_that("resolve_labels uses node data labels for TRUE", { nodes <- data.frame(label = c("Alpha", "Beta", "Gamma")) result <- resolve_labels(TRUE, nodes = nodes, n = 3) expect_equal(result, c("Alpha", "Beta", "Gamma")) }) test_that("resolve_labels uses indices when TRUE but no node labels", { result <- resolve_labels(TRUE, nodes = NULL, n = 4) expect_equal(result, c("1", "2", "3", "4")) }) test_that("resolve_labels uses TRUE with nodes without label column", { nodes <- data.frame(x = c(1, 2, 3)) result <- resolve_labels(TRUE, nodes = nodes, n = 3) expect_equal(result, c("1", "2", "3")) }) test_that("resolve_labels uses user-provided labels", { result <- resolve_labels(c("X", "Y", "Z"), nodes = NULL, n = 3) expect_equal(result, c("X", "Y", "Z")) }) test_that("resolve_labels recycles user labels", { result <- resolve_labels(c("A", "B"), nodes = NULL, n = 4) expect_equal(result, c("A", "B", "A", "B")) }) test_that("resolve_labels converts labels to character", { result <- resolve_labels(1:3, nodes = NULL, n = 3) expect_type(result, "character") expect_equal(result, c("1", "2", "3")) }) # ============================================ # RESOLVE_EDGE_LABELS TESTS # ============================================ test_that("resolve_edge_labels returns NULL for NULL input", { result <- resolve_edge_labels(NULL, edges = NULL, m = 5) expect_null(result) }) test_that("resolve_edge_labels returns NULL for FALSE input", { result <- resolve_edge_labels(FALSE, edges = NULL, m = 5) expect_null(result) }) test_that("resolve_edge_labels uses weights for TRUE", { edges <- data.frame(from = c(1, 2), to = c(2, 3), weight = c(0.456, 0.789)) result <- resolve_edge_labels(TRUE, edges = edges, m = 2) expect_equal(result, c("0.46", "0.79")) }) test_that("resolve_edge_labels returns empty strings when TRUE but no weights", { edges <- data.frame(from = c(1, 2), to = c(2, 3)) result <- resolve_edge_labels(TRUE, edges = edges, m = 2) expect_equal(result, c("", "")) }) test_that("resolve_edge_labels uses user-provided labels", { result <- resolve_edge_labels(c("low", "high"), edges = NULL, m = 2) expect_equal(result, c("low", "high")) }) test_that("resolve_edge_labels recycles user labels", { result <- resolve_edge_labels(c("a", "b"), edges = NULL, m = 4) expect_equal(result, c("a", "b", "a", "b")) }) test_that("resolve_edge_labels converts labels to character", { result <- resolve_edge_labels(c(1, 2, 3), edges = NULL, m = 3) expect_type(result, "character") expect_equal(result, c("1", "2", "3")) }) # ============================================ # RESOLVE_SHAPES TESTS # ============================================ test_that("resolve_shapes uses circle as default", { result <- resolve_shapes(NULL, n = 3) expect_equal(result, rep("circle", 3)) }) test_that("resolve_shapes uses explicit shape", { result <- resolve_shapes("square", n = 3) expect_equal(result, rep("square", 3)) }) test_that("resolve_shapes recycles shape vector", { result <- resolve_shapes(c("circle", "square"), n = 5) expect_equal(result, c("circle", "square", "circle", "square", "circle")) }) # ============================================ # RESOLVE_LOOP_ROTATION TESTS # ============================================ test_that("resolve_loop_rotation returns empty for zero edges", { edges <- data.frame(from = integer(0), to = integer(0)) result <- resolve_loop_rotation(NULL, edges) expect_equal(length(result), 0) }) test_that("resolve_loop_rotation uses default pi/2 when no layout", { edges <- data.frame(from = c(1, 1), to = c(1, 2)) # First is self-loop result <- resolve_loop_rotation(NULL, edges) expect_equal(result[1], pi/2) expect_equal(result[2], pi/2) }) test_that("resolve_loop_rotation calculates rotation from layout", { edges <- data.frame(from = c(1, 2), to = c(1, 2)) # Both self-loops # Node 1 at (-1, 0), Node 2 at (1, 0), center at (0, 0) layout <- matrix(c(-1, 1, 0, 0), ncol = 2) result <- resolve_loop_rotation(NULL, edges, layout = layout) # Node 1 should point left (pi), Node 2 should point right (0) expect_equal(result[1], pi, tolerance = 0.01) expect_equal(result[2], 0, tolerance = 0.01) }) test_that("resolve_loop_rotation uses explicit rotation when provided", { edges <- data.frame(from = c(1, 2), to = c(1, 2)) result <- resolve_loop_rotation(c(0, pi/4), edges) expect_equal(result, c(0, pi/4)) }) test_that("resolve_loop_rotation recycles explicit rotation", { edges <- data.frame(from = c(1, 2, 3, 4), to = c(1, 2, 3, 4)) result <- resolve_loop_rotation(c(0, pi), edges) expect_equal(result, c(0, pi, 0, pi)) }) # ============================================ # FILTER_EDGES_BY_WEIGHT TESTS # ============================================ test_that("filter_edges_by_weight returns all edges when minimum is 0", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.1, 0.5, 0.9)) result <- filter_edges_by_weight(edges, minimum = 0) expect_equal(nrow(result), 3) }) test_that("filter_edges_by_weight returns all edges when no weight column", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1)) result <- filter_edges_by_weight(edges, minimum = 0.5) expect_equal(nrow(result), 3) }) test_that("filter_edges_by_weight removes edges below threshold", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.1, 0.5, 0.9)) result <- filter_edges_by_weight(edges, minimum = 0.3) expect_equal(nrow(result), 2) expect_true(all(abs(result$weight) >= 0.3)) }) test_that("filter_edges_by_weight uses absolute values", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(-0.8, 0.2, -0.1)) result <- filter_edges_by_weight(edges, minimum = 0.5) expect_equal(nrow(result), 1) expect_equal(result$weight, -0.8) }) test_that("filter_edges_by_weight preserves row names", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.1, 0.5, 0.9)) rownames(edges) <- c("e1", "e2", "e3") result <- filter_edges_by_weight(edges, minimum = 0.4) expect_equal(nrow(result), 2) }) # ============================================ # GET_EDGE_ORDER TESTS # ============================================ test_that("get_edge_order returns empty for zero edges", { edges <- data.frame(from = integer(0), to = integer(0)) result <- get_edge_order(edges) expect_equal(length(result), 0) }) test_that("get_edge_order orders by weight (weakest first)", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.9, 0.1, 0.5)) result <- get_edge_order(edges) # Edge 2 (0.1), then edge 3 (0.5), then edge 1 (0.9) expect_equal(result, c(2, 3, 1)) }) test_that("get_edge_order returns sequential order when no weights", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1)) result <- get_edge_order(edges) expect_equal(result, c(1, 2, 3)) }) test_that("get_edge_order uses priority as primary sort key", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.9, 0.1, 0.5)) priority <- c(2, 1, 3) # Edge 2 lowest, edge 3 highest result <- get_edge_order(edges, priority = priority) # Sort by priority first: edge 2 (pri=1), edge 1 (pri=2), edge 3 (pri=3) expect_equal(result[1], 2) expect_equal(result[3], 3) }) test_that("get_edge_order breaks priority ties with weight", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1), weight = c(0.9, 0.1, 0.5)) priority <- c(1, 1, 2) # Edges 1 and 2 have same priority result <- get_edge_order(edges, priority = priority) # Within priority 1: edge 2 (weight 0.1) before edge 1 (weight 0.9) expect_equal(result[1], 2) expect_equal(result[2], 1) expect_equal(result[3], 3) }) test_that("get_edge_order handles priority without weights", { edges <- data.frame(from = c(1, 2, 3), to = c(2, 3, 1)) priority <- c(3, 1, 2) result <- get_edge_order(edges, priority = priority) expect_equal(result[1], 2) # Lowest priority expect_equal(result[3], 1) # Highest priority }) # ============================================ # GET_NODE_ORDER TESTS # ============================================ test_that("get_node_order orders largest to smallest", { sizes <- c(5, 10, 3, 8) result <- get_node_order(sizes) # Largest (10) first, then 8, 5, 3 expect_equal(result, c(2, 4, 1, 3)) }) test_that("get_node_order handles equal sizes", { sizes <- c(5, 5, 5) result <- get_node_order(sizes) expect_equal(length(result), 3) expect_true(all(result %in% 1:3)) }) test_that("get_node_order handles single node", { sizes <- c(10) result <- get_node_order(sizes) expect_equal(result, 1) }) # ============================================ # INTEGRATION TESTS # ============================================ test_that("resolve functions work together for complete workflow", { # Create test network edges <- data.frame( from = c(1, 2, 3, 1), to = c(2, 3, 1, 3), weight = c(0.8, 0.3, 0.5, 0.6) ) nodes <- data.frame( label = c("A", "B", "C"), color = c("red", "green", "blue") ) n <- 3 m <- nrow(edges) # Test all resolve functions colors <- resolve_edge_colors(edges) expect_equal(length(colors), m) widths <- resolve_edge_widths(edges) expect_equal(length(widths), m) node_sizes <- resolve_node_sizes(NULL, n = n) expect_equal(length(node_sizes), n) label_sizes <- resolve_label_sizes(NULL, node_sizes, n) expect_equal(length(label_sizes), n) node_colors <- resolve_node_colors(NULL, n, nodes) expect_equal(node_colors, c("red", "green", "blue")) labels <- resolve_labels(TRUE, nodes, n) expect_equal(labels, c("A", "B", "C")) edge_labels <- resolve_edge_labels(TRUE, edges, m) expect_equal(length(edge_labels), m) shapes <- resolve_shapes(NULL, n) expect_equal(shapes, rep("circle", n)) # Filter and order filtered <- filter_edges_by_weight(edges, minimum = 0.4) expect_true(nrow(filtered) < m) order <- get_edge_order(edges) expect_equal(length(order), m) }) test_that("resolve_centrality_sizes integrates with splot workflow", { skip_if_no_igraph() mat <- create_test_matrix(6, density = 0.5) # Test different centrality measures work for (measure in c("degree", "strength", "betweenness", "closeness")) { result <- tryCatch( resolve_centrality_sizes(mat, scale_by = measure), error = function(e) NULL ) if (!is.null(result)) { expect_equal(length(result$sizes), 6) expect_true(all(result$sizes > 0)) } } })