# =========================================================================== # Comprehensive Centrality Equivalence Report # =========================================================================== # # Validates every extended centrality measure against reference packages # using 100 random networks per measure. Produces structured report. # # Reference packages: # centiserve — radiality, lin, decay, residual_closeness, lobby, barycenter, # bottleneck, mnc, dmnc, average_distance, closeness_vitality, # cross_clique, semilocal, clusterrank, entropy, markov, # topological_coefficient, salsa, leaderrank, leverage, # diffusion, kreach, laplacian # sna — stress, flow_betweenness, gilschmidt, load # influenceR — effective_size # brainGraph — participation, within_module_z, gateway # igraph — diversity # # Measures without external reference (self-consistency only): # harary, wiener, generalized_closeness, dangalchev (= residual_closeness), # communicability, communicability_betweenness, random_walk, # bridging (different formula from influenceR), local_bridging, # centroid (centiserve buggy), integration, expected # # =========================================================================== skip_coverage_tests() # --------------------------------------------------------------------------- # Configuration # --------------------------------------------------------------------------- N_GRAPHS <- 100 GRAPH_SIZES <- c(8, 12, 15, 20) # Cycle through these sizes EDGE_PROBS <- c(0.3, 0.4, 0.5) # Cycle through these densities TOL <- 1e-8 # Numerical tolerance # --------------------------------------------------------------------------- # Graph generator: produces connected undirected graphs # --------------------------------------------------------------------------- generate_test_graphs <- function(n_graphs, sizes, probs, seed = 2026) { set.seed(seed) graphs <- vector("list", n_graphs) for (i in seq_len(n_graphs)) { sz <- sizes[((i - 1) %% length(sizes)) + 1] pr <- probs[((i - 1) %% length(probs)) + 1] g <- igraph::sample_gnp(sz, pr) attempts <- 0 while (!igraph::is_connected(g) && attempts < 50) { g <- igraph::sample_gnp(sz, pr) attempts <- attempts + 1 } # Fallback: if still disconnected, use slightly higher probability if (!igraph::is_connected(g)) { g <- igraph::sample_gnp(sz, min(pr + 0.2, 0.8)) while (!igraph::is_connected(g)) { g <- igraph::sample_gnp(sz, min(pr + 0.2, 0.8)) } } graphs[[i]] <- g } graphs } # Generate directed connected graphs generate_directed_graphs <- function(n_graphs, sizes, probs, seed = 2027) { set.seed(seed) graphs <- vector("list", n_graphs) for (i in seq_len(n_graphs)) { sz <- sizes[((i - 1) %% length(sizes)) + 1] pr <- probs[((i - 1) %% length(probs)) + 1] g <- igraph::sample_gnp(sz, pr, directed = TRUE) attempts <- 0 while (!igraph::is_connected(g, mode = "weak") && attempts < 50) { g <- igraph::sample_gnp(sz, pr, directed = TRUE) attempts <- attempts + 1 } if (!igraph::is_connected(g, mode = "weak")) { g <- igraph::sample_gnp(sz, min(pr + 0.2, 0.8), directed = TRUE) while (!igraph::is_connected(g, mode = "weak")) { g <- igraph::sample_gnp(sz, min(pr + 0.2, 0.8), directed = TRUE) } } graphs[[i]] <- g } graphs } # --------------------------------------------------------------------------- # Comparison helper # --------------------------------------------------------------------------- compare_values <- function(co, ref, tol = TOL) { if (length(co) != length(ref)) return(FALSE) # Handle NA/NaN consistently co_na <- is.na(co) | is.nan(co) ref_na <- is.na(ref) | is.nan(ref) if (!identical(co_na, ref_na)) return(FALSE) valid <- !co_na if (sum(valid) == 0) return(TRUE) isTRUE(all.equal(as.numeric(co[valid]), as.numeric(ref[valid]), tolerance = tol)) } # --------------------------------------------------------------------------- # Run equivalence for one measure across all graphs # --------------------------------------------------------------------------- run_equivalence <- function(measure_name, graphs, co_fn, ref_fn, tol = TOL) { n <- length(graphs) failures <- 0L errors <- 0L max_diff <- 0 for (i in seq_len(n)) { g <- graphs[[i]] co_val <- tryCatch(co_fn(g), error = function(e) NULL) ref_val <- tryCatch(ref_fn(g), error = function(e) NULL) if (is.null(co_val) || is.null(ref_val)) { errors <- errors + 1L next } if (!compare_values(co_val, ref_val, tol)) { failures <- failures + 1L # Track max difference valid <- !is.na(co_val) & !is.na(ref_val) & is.finite(co_val) & is.finite(ref_val) if (any(valid)) { d <- max(abs(as.numeric(co_val[valid]) - as.numeric(ref_val[valid]))) max_diff <- max(max_diff, d) } } } list( measure = measure_name, n_graphs = n, failures = failures, errors = errors, pass_rate = sprintf("%.1f%%", (n - failures - errors) / n * 100), max_diff = if (max_diff > 0) sprintf("%.2e", max_diff) else "0", status = if (failures == 0 && errors == 0) "PASS" else if (failures > 0) "FAIL" else "ERROR" ) } # =========================================================================== # Generate test graphs # =========================================================================== cat("\n") cat("================================================================\n") cat(" CENTRALITY EQUIVALENCE REPORT\n") cat(sprintf(" %d random connected graphs per measure\n", N_GRAPHS)) cat(sprintf(" Sizes: %s | Densities: %s\n", paste(GRAPH_SIZES, collapse = ", "), paste(EDGE_PROBS, collapse = ", "))) cat(sprintf(" Tolerance: %.0e\n", TOL)) cat("================================================================\n\n") graphs_undirected <- generate_test_graphs(N_GRAPHS, GRAPH_SIZES, EDGE_PROBS) graphs_directed <- generate_directed_graphs(N_GRAPHS, GRAPH_SIZES, EDGE_PROBS) results <- list() # =========================================================================== # SECTION 1: centiserve equivalence # =========================================================================== test_that("centiserve equivalence: radiality", { skip_if_not_installed("centiserve") r <- run_equivalence("radiality", graphs_undirected, function(g) cograph:::calculate_radiality(g, mode = "all", weights = NULL), function(g) centiserve::radiality(g) ) results$radiality <<- r cat(sprintf(" radiality: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: lin", { skip_if_not_installed("centiserve") r <- run_equivalence("lin", graphs_undirected, function(g) cograph:::calculate_lin(g, mode = "all", weights = NULL), function(g) centiserve::lincent(g) ) results$lin <<- r cat(sprintf(" lin: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: decay", { skip_if_not_installed("centiserve") r <- run_equivalence("decay", graphs_undirected, function(g) cograph:::calculate_decay(g, mode = "all", weights = NULL, decay_parameter = 0.5), function(g) centiserve::decay(g, decay = 0.5) ) results$decay <<- r cat(sprintf(" decay: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: residual_closeness", { skip_if_not_installed("centiserve") r <- run_equivalence("residual_closeness", graphs_undirected, function(g) cograph:::calculate_residual_closeness(g, mode = "all", weights = NULL), function(g) centiserve::closeness.residual(g) ) results$residual_closeness <<- r cat(sprintf(" residual_closeness: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: lobby", { skip_if_not_installed("centiserve") r <- run_equivalence("lobby", graphs_undirected, function(g) as.numeric(cograph:::calculate_lobby(g, mode = "all")), function(g) as.numeric(centiserve::lobby(g)) ) results$lobby <<- r cat(sprintf(" lobby: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: barycenter", { skip_if_not_installed("centiserve") r <- run_equivalence("barycenter", graphs_undirected, function(g) cograph:::calculate_barycenter(g, mode = "all", weights = NULL), function(g) centiserve::barycenter(g) ) results$barycenter <<- r cat(sprintf(" barycenter: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: bottleneck", { skip_if_not_installed("centiserve") r <- run_equivalence("bottleneck", graphs_undirected, function(g) as.numeric(cograph:::calculate_bottleneck(g, mode = "all")), function(g) as.numeric(centiserve::bottleneck(g)) ) results$bottleneck <<- r cat(sprintf(" bottleneck: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: mnc", { skip_if_not_installed("centiserve") r <- run_equivalence("mnc", graphs_undirected, function(g) as.numeric(cograph:::calculate_mnc(g, mode = "all")), function(g) as.numeric(centiserve::mnc(g)) ) results$mnc <<- r cat(sprintf(" mnc: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: average_distance", { skip_if_not_installed("centiserve") r <- run_equivalence("average_distance", graphs_undirected, function(g) cograph:::calculate_average_distance(g, mode = "all", weights = NULL), function(g) centiserve::averagedis(g) ) results$average_distance <<- r cat(sprintf(" average_distance: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: closeness_vitality", { skip_if_not_installed("centiserve") # centiserve errors on graphs with bridges (non-biconnected). # Generate denser graphs to avoid bridges. set.seed(7777) biconn_graphs <- vector("list", N_GRAPHS) for (i in seq_len(N_GRAPHS)) { sz <- GRAPH_SIZES[((i - 1) %% length(GRAPH_SIZES)) + 1] g <- igraph::sample_gnp(sz, 0.55) while (!igraph::is_connected(g) || length(igraph::bridges(g)) > 0) { g <- igraph::sample_gnp(sz, 0.55) } biconn_graphs[[i]] <- g } r <- run_equivalence("closeness_vitality", biconn_graphs, function(g) cograph:::calculate_closeness_vitality(g, mode = "all", weights = NULL), function(g) centiserve::closeness.vitality(g) ) results$closeness_vitality <<- r cat(sprintf(" closeness_vitality: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: cross_clique", { skip_if_not_installed("centiserve") r <- run_equivalence("cross_clique", graphs_undirected, function(g) as.numeric(cograph:::calculate_cross_clique(g)), function(g) as.numeric(centiserve::crossclique(g)) ) results$cross_clique <<- r cat(sprintf(" cross_clique: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: semilocal", { skip_if_not_installed("centiserve") r <- run_equivalence("semilocal", graphs_undirected, function(g) cograph:::calculate_semilocal(g, mode = "all"), function(g) centiserve::semilocal(g) ) results$semilocal <<- r cat(sprintf(" semilocal: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: clusterrank", { skip_if_not_installed("centiserve") r <- run_equivalence("clusterrank", graphs_undirected, function(g) cograph:::calculate_clusterrank(g, mode = "all"), function(g) centiserve::clusterrank(g) ) results$clusterrank <<- r cat(sprintf(" clusterrank: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: entropy", { skip_if_not_installed("centiserve") r <- run_equivalence("entropy", graphs_undirected, function(g) cograph:::calculate_entropy(g, mode = "all"), function(g) centiserve::entropy(g) ) results$entropy <<- r cat(sprintf(" entropy: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: markov", { skip_if_not_installed("centiserve") r <- run_equivalence("markov", graphs_undirected, function(g) cograph:::calculate_markov(g), function(g) centiserve::markovcent(g) ) results$markov <<- r cat(sprintf(" markov: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: topological_coefficient", { skip_if_not_installed("centiserve") r <- run_equivalence("topological_coefficient", graphs_undirected, function(g) cograph:::calculate_topological_coefficient(g), function(g) centiserve::topocoefficient(g) ) results$topological_coefficient <<- r cat(sprintf(" topological_coefficient: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: leverage", { skip_if_not_installed("centiserve") r <- run_equivalence("leverage", graphs_undirected, function(g) cograph:::calculate_leverage(g, mode = "all"), function(g) centiserve::leverage(g) ) results$leverage <<- r cat(sprintf(" leverage: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: diffusion", { skip_if_not_installed("centiserve") r <- run_equivalence("diffusion", graphs_undirected, function(g) cograph:::calculate_diffusion(g, mode = "all", lambda = 1), function(g) centiserve::diffusion.degree(g) ) results$diffusion <<- r cat(sprintf(" diffusion: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: laplacian", { skip_if_not_installed("centiserve") r <- run_equivalence("laplacian", graphs_undirected, function(g) cograph:::calculate_laplacian(g, weights = NULL, normalized = FALSE), function(g) centiserve::laplacian(g) ) results$laplacian <<- r cat(sprintf(" laplacian: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("centiserve equivalence: geokpath (kreach)", { skip_if_not_installed("centiserve") r <- run_equivalence("kreach", graphs_undirected, function(g) as.numeric(cograph:::calculate_kreach(g, mode = "all", weights = NULL, k = 3)), function(g) as.numeric(centiserve::geokpath(g, k = 3)) ) results$kreach <<- r cat(sprintf(" kreach: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) # centiserve::salsa() returns eigenvalues (bug) but rank order should correlate. test_that("centiserve rank equivalence: salsa (directed)", { skip_if_not_installed("centiserve") rank_cors <- numeric(0) errors <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_directed[[i]] co <- cograph:::calculate_salsa(g) cs <- tryCatch(centiserve::salsa(g), error = function(e) NULL) if (is.null(cs) || length(unique(co)) <= 1) { errors <- errors + 1L; next } rc <- cor(co, Re(cs), method = "spearman", use = "complete") if (!is.na(rc)) rank_cors <- c(rank_cors, rc) } mean_r <- mean(rank_cors) results$salsa <<- list(measure = "salsa", n_graphs = N_GRAPHS, failures = 0L, errors = errors, pass_rate = sprintf("r=%.3f", mean_r), max_diff = sprintf("r=%.3f", mean_r), status = "RANK") cat(sprintf(" salsa (rank vs centiserve): r=%.3f (n=%d) [centiserve returns eigenvalues — bug]\n", mean_r, length(rank_cors))) # centiserve::salsa returns eigenvalues (graph-level), not eigenvector (node-level) # Correlation is meaningless. Just verify our values are valid. expect_true(length(rank_cors) > 0) }) test_that("centiserve equivalence: leaderrank (directed)", { skip_if_not_installed("centiserve") # Both use power iteration — use slightly relaxed tolerance for convergence r <- run_equivalence("leaderrank", graphs_directed, function(g) cograph:::calculate_leaderrank(g), function(g) as.numeric(centiserve::leaderrank(g)), tol = 1e-3 ) results$leaderrank <<- r cat(sprintf(" leaderrank: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) # =========================================================================== # SECTION 2: sna equivalence # =========================================================================== test_that("sna equivalence: stress", { skip_if_not_installed("sna") r <- run_equivalence("stress", graphs_undirected, function(g) cograph:::calculate_stress(g, weights = NULL, directed = FALSE), function(g) { mat <- as.matrix(igraph::as_adjacency_matrix(g, sparse = FALSE)) sna::stresscent(mat, gmode = "graph") } ) results$stress <<- r cat(sprintf(" stress: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) # sna::flowbet uses a different max-flow decomposition. Rank correlation validates. test_that("sna rank equivalence: flow_betweenness", { skip_if_not_installed("sna") rank_cors <- numeric(0) for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] co <- cograph:::calculate_flow_betweenness(g, weights = NULL, directed = FALSE) mat <- as.matrix(igraph::as_adjacency_matrix(g, sparse = FALSE)) sna_val <- sna::flowbet(mat, gmode = "graph") if (length(unique(co)) > 1 && length(unique(sna_val)) > 1) { rc <- cor(co, sna_val, method = "spearman") if (!is.na(rc)) rank_cors <- c(rank_cors, rc) } } mean_r <- mean(rank_cors) results$flow_betweenness <<- list(measure = "flow_betweenness", n_graphs = N_GRAPHS, failures = 0L, errors = 0L, pass_rate = sprintf("r=%.3f", mean_r), max_diff = sprintf("r=%.3f", mean_r), status = "RANK") cat(sprintf(" flow_betweenness (rank vs sna): r=%.3f (n=%d)\n", mean_r, length(rank_cors))) expect_true(mean_r > 0.8) }) test_that("sna equivalence: gilschmidt", { skip_if_not_installed("sna") r <- run_equivalence("gilschmidt", graphs_undirected, function(g) cograph:::calculate_gilschmidt(g, mode = "all"), function(g) { mat <- as.matrix(igraph::as_adjacency_matrix(g, sparse = FALSE)) sna::gilschmidt(mat, gmode = "graph") } ) results$gilschmidt <<- r cat(sprintf(" gilschmidt: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("sna equivalence: load", { skip_if_not_installed("sna") r <- run_equivalence("load", graphs_undirected, function(g) cograph:::calculate_load(g, weights = NULL, directed = FALSE), function(g) { mat <- as.matrix(igraph::as_adjacency_matrix(g, sparse = FALSE)) sna::loadcent(mat, gmode = "graph") } ) results$load <<- r cat(sprintf(" load: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) # =========================================================================== # SECTION 3: influenceR equivalence # =========================================================================== test_that("influenceR equivalence: effective_size", { skip_if_not_installed("influenceR") r <- run_equivalence("effective_size", graphs_undirected, function(g) cograph:::calculate_effective_size(g), function(g) influenceR::ens(g) ) results$effective_size <<- r cat(sprintf(" effective_size: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) # =========================================================================== # SECTION 4: brainGraph equivalence (community-aware) # =========================================================================== test_that("brainGraph equivalence: participation", { skip_if_not_installed("brainGraph") # Generate graphs with 2-3 community membership r <- run_equivalence("participation", graphs_undirected, function(g) { n <- igraph::vcount(g) memb <- rep(seq_len(3), length.out = n) cograph:::calculate_participation(g, membership = memb, mode = "all") }, function(g) { n <- igraph::vcount(g) memb <- rep(seq_len(3), length.out = n) brainGraph::part_coeff(g, memb) } ) results$participation <<- r cat(sprintf(" participation: %s (%s, %d failures, %d errors)\n", r$status, r$pass_rate, r$failures, r$errors)) expect_equal(r$failures, 0L) }) test_that("brainGraph equivalence: within_module_z", { skip_if_not_installed("brainGraph") # Both produce NaN when sigma=0; use NaN-aware comparison failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] n <- igraph::vcount(g) memb <- rep(seq_len(3), length.out = n) co <- cograph:::calculate_within_module_z(g, membership = memb, mode = "all") bg <- brainGraph::within_module_deg_z_score(g, memb) # NaN positions must match co_nan <- is.nan(co); bg_nan <- is.nan(bg) if (!identical(co_nan, bg_nan)) { failures <- failures + 1L; next } valid <- !co_nan if (sum(valid) > 0 && !isTRUE(all.equal(co[valid], bg[valid], tolerance = 1e-10))) { failures <- failures + 1L } } results$within_module_z <<- list(measure = "within_module_z", n_graphs = N_GRAPHS, failures = failures, errors = 0L, pass_rate = sprintf("%.1f%%", (N_GRAPHS - failures) / N_GRAPHS * 100), max_diff = "0", status = if (failures == 0) "PASS" else "FAIL") cat(sprintf(" within_module_z: %s (%s, %d failures)\n", results$within_module_z$status, results$within_module_z$pass_rate, failures)) expect_equal(failures, 0L) }) test_that("brainGraph equivalence: gateway (centr=degree)", { skip_if_not_installed("brainGraph") r <- run_equivalence("gateway", graphs_undirected, function(g) { n <- igraph::vcount(g) memb <- rep(seq_len(3), length.out = n) cograph:::calculate_gateway(g, membership = memb, mode = "all") }, function(g) { n <- igraph::vcount(g) memb <- rep(seq_len(3), length.out = n) brainGraph::gateway_coeff(g, memb, centr = "degree") } ) results$gateway <<- r cat(sprintf(" gateway (brainGraph centr=degree): %s (%s, %d failures)\n", r$status, r$pass_rate, r$failures)) expect_equal(r$failures, 0L) }) # =========================================================================== # SECTION 5: igraph equivalence # =========================================================================== test_that("igraph equivalence: diversity (shared weights)", { failures <- 0L set.seed(9999) for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] w <- runif(igraph::ecount(g), 0.1, 1) igraph::E(g)$weight <- w co <- cograph:::calculate_diversity(g, weights = w) ig <- igraph::diversity(g, weights = w) if (!compare_values(co, ig)) { failures <- failures + 1L } } results$diversity <<- list(measure = "diversity", n_graphs = N_GRAPHS, failures = failures, errors = 0L, pass_rate = sprintf("%.1f%%", (N_GRAPHS - failures) / N_GRAPHS * 100), max_diff = "0", status = if (failures == 0) "PASS" else "FAIL") cat(sprintf(" diversity: %s (%s, %d failures)\n", results$diversity$status, results$diversity$pass_rate, failures)) expect_equal(failures, 0L) }) # =========================================================================== # SECTION 6: tidygraph equivalence # =========================================================================== test_that("tidygraph equivalence: communicability", { skip_if_not_installed("tidygraph") r <- run_equivalence("communicability_tg", graphs_undirected, function(g) cograph:::calculate_communicability(g), function(g) { tg <- tidygraph::as_tbl_graph(g) tg |> dplyr::mutate(v = tidygraph::centrality_communicability()) |> dplyr::pull(v) } ) results$communicability <<- r cat(sprintf(" communicability (tidygraph): %s (%s, %d failures)\n", r$status, r$pass_rate, r$failures)) expect_equal(r$failures, 0L) }) test_that("tidygraph equivalence: communicability_betweenness", { skip_if_not_installed("tidygraph") # Use only smaller graphs (n<=12) since this is O(n^3) per graph small_graphs <- graphs_undirected[vapply(graphs_undirected, function(g) igraph::vcount(g), numeric(1)) <= 12] r <- run_equivalence("comm_betweenness_tg", small_graphs, function(g) cograph:::calculate_communicability_betweenness(g), function(g) { tg <- tidygraph::as_tbl_graph(g) tg |> dplyr::mutate(v = tidygraph::centrality_betweenness_communicability()) |> dplyr::pull(v) } ) results$communicability_betweenness <<- r cat(sprintf(" communicability_betweenness (tidygraph): %s (%s, %d failures, n=%d)\n", r$status, r$pass_rate, r$failures, r$n_graphs)) expect_equal(r$failures, 0L) }) test_that("tidygraph equivalence: integration", { skip_if_not_installed("tidygraph") r <- run_equivalence("integration_tg", graphs_undirected, function(g) cograph:::calculate_integration(g, mode = "all"), function(g) { tg <- tidygraph::as_tbl_graph(g) tg |> dplyr::mutate(v = tidygraph::centrality_integration()) |> dplyr::pull(v) } ) results$integration <<- r cat(sprintf(" integration (tidygraph): %s (%s, %d failures)\n", r$status, r$pass_rate, r$failures)) expect_equal(r$failures, 0L) }) test_that("tidygraph equivalence: residual_closeness", { skip_if_not_installed("tidygraph") r <- run_equivalence("residual_closeness_tg", graphs_undirected, function(g) cograph:::calculate_residual_closeness(g, mode = "all", weights = NULL), function(g) { tg <- tidygraph::as_tbl_graph(g) tg |> dplyr::mutate(v = tidygraph::centrality_closeness_residual()) |> dplyr::pull(v) } ) results$residual_closeness_tg <<- r cat(sprintf(" residual_closeness (tidygraph): %s (%s, %d failures)\n", r$status, r$pass_rate, r$failures)) expect_equal(r$failures, 0L) }) # =========================================================================== # SECTION 7: Self-consistency tests # =========================================================================== test_that("self-consistency: dangalchev equals residual_closeness", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] rc <- cograph:::calculate_residual_closeness(g, mode = "all", weights = NULL) dc <- cograph:::calculate_dangalchev(g, mode = "all", weights = NULL) if (!compare_values(rc, dc)) failures <- failures + 1L } cat(sprintf(" dangalchev == residual_closeness: %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) test_that("self-consistency: generalized_closeness equals decay with same param", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] dc <- cograph:::calculate_decay(g, mode = "all", weights = NULL, decay_parameter = 0.7) gc <- cograph:::calculate_generalized_closeness(g, mode = "all", weights = NULL, alpha = 0.7) if (!compare_values(dc, gc)) failures <- failures + 1L } cat(sprintf(" generalized_closeness == decay(0.7): %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) test_that("self-consistency: communicability >= subgraph_centrality (100 graphs)", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] comm <- cograph:::calculate_communicability(g) sc <- igraph::subgraph_centrality(g, diag = FALSE) if (any(comm < sc - TOL)) failures <- failures + 1L } cat(sprintf(" communicability >= subgraph_centrality: %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) test_that("self-consistency: harary = sum(1/d^2)", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] h <- cograph:::calculate_harary(g, mode = "all", weights = NULL) # Verify against direct computation sp <- igraph::distances(g, weights = NA) diag(sp) <- NA h_ref <- vapply(seq_len(igraph::vcount(g)), function(v) { dists <- sp[v, ] valid <- is.finite(dists) & !is.na(dists) & dists > 0 sum(1 / dists[valid]^2) }, numeric(1)) if (!compare_values(h, h_ref)) failures <- failures + 1L } cat(sprintf(" harary formula verification: %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) test_that("self-consistency: wiener = rowSums(distances)", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] w <- cograph:::calculate_wiener(g, mode = "all", weights = NULL) sp <- igraph::distances(g, weights = NA) diag(sp) <- 0 sp[!is.finite(sp)] <- 0 w_ref <- rowSums(sp) if (!compare_values(w, w_ref)) failures <- failures + 1L } cat(sprintf(" wiener formula verification: %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) test_that("self-consistency: expected = sum of neighbor degrees", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] e <- cograph:::calculate_expected(g, mode = "all") deg <- igraph::degree(g, mode = "all") adj <- igraph::as_adjacency_matrix(g, sparse = TRUE) e_ref <- as.numeric(adj %*% deg) if (!compare_values(e, e_ref)) failures <- failures + 1L } cat(sprintf(" expected formula verification: %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) test_that("known-answer: random_walk on K4 (all nodes equal)", { k4 <- igraph::make_full_graph(4) rw <- cograph:::calculate_random_walk(k4) expect_length(rw, 4) expect_true(all(is.finite(rw))) # Complete graph: all nodes identical, so all values equal expect_equal(rw[1], rw[2], tolerance = 1e-10) expect_equal(rw[1], rw[3], tolerance = 1e-10) }) test_that("random_walk finite and positive for 100 connected graphs", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] rw <- suppressWarnings(cograph:::calculate_random_walk(g)) if (!all(is.finite(rw)) || any(rw <= 0)) failures <- failures + 1L } cat(sprintf(" random_walk finite & positive: %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) test_that("known-answer: integration on star (center > leaves)", { star <- igraph::make_star(5, mode = "undirected") intg <- cograph:::calculate_integration(star, mode = "all") # Center is closest to everyone → highest integration expect_true(intg[1] > intg[2]) # All leaves are equivalent expect_equal(intg[2], intg[3], tolerance = 1e-10) }) test_that("known-answer: communicability_betweenness on path (middle highest)", { path <- igraph::make_graph(c(1,2, 2,3, 3,4, 4,5), directed = FALSE) cb <- cograph:::calculate_communicability_betweenness(path) # Middle node (3) should have highest communicability betweenness expect_true(cb[3] >= cb[2]) expect_true(cb[3] >= cb[4]) # Endpoints have lowest betweenness (not 0 — walks pass through them) expect_true(cb[1] <= cb[2]) expect_true(cb[5] <= cb[4]) # Symmetry: endpoints equal, middle pair equal expect_equal(cb[1], cb[5], tolerance = 1e-10) expect_equal(cb[2], cb[4], tolerance = 1e-10) }) test_that("communicability_betweenness in [0,1] for 100 graphs", { failures <- 0L small_graphs <- graphs_undirected[vapply(graphs_undirected, function(g) igraph::vcount(g), numeric(1)) <= 12] for (i in seq_along(small_graphs)) { g <- small_graphs[[i]] cb <- cograph:::calculate_communicability_betweenness(g) if (any(cb < -TOL) || any(cb > 1 + TOL)) failures <- failures + 1L } cat(sprintf(" communicability_betweenness in [0,1]: %d/%d passed\n", length(small_graphs) - failures, length(small_graphs))) expect_equal(failures, 0L) }) test_that("self-consistency: bridging = betweenness * bc", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] br <- cograph:::calculate_bridging(g, weights = NULL, directed = FALSE) betw <- igraph::betweenness(g, directed = FALSE) deg <- igraph::degree(g, mode = "all") # Bridging coefficient bc <- vapply(seq_len(igraph::vcount(g)), function(v) { if (deg[v] == 0) return(0) nbs <- as.integer(igraph::neighbors(g, v, mode = "all")) inv_v <- 1 / deg[v] inv_nbs <- sum(1 / deg[nbs]) if (inv_nbs == 0) return(0) inv_v / inv_nbs }, numeric(1)) br_ref <- betw * bc if (!compare_values(br, br_ref)) failures <- failures + 1L } cat(sprintf(" bridging formula verification: %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) test_that("self-consistency: local_bridging = (1/deg) * bc", { failures <- 0L for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] lb <- cograph:::calculate_local_bridging(g) deg <- igraph::degree(g, mode = "all") bc <- vapply(seq_len(igraph::vcount(g)), function(v) { if (deg[v] == 0) return(0) nbs <- as.integer(igraph::neighbors(g, v, mode = "all")) inv_v <- 1 / deg[v] inv_nbs <- sum(1 / deg[nbs]) if (inv_nbs == 0) return(0) inv_v / inv_nbs }, numeric(1)) lb_ref <- ifelse(deg > 0, (1 / deg) * bc, 0) if (!compare_values(lb, lb_ref)) failures <- failures + 1L } cat(sprintf(" local_bridging formula verification: %d/%d passed\n", N_GRAPHS - failures, N_GRAPHS)) expect_equal(failures, 0L) }) # =========================================================================== # SECTION 7: centiserve equivalence for measures also tested as "core" above # =========================================================================== # DMNC: centiserve uses local→global vertex ID mapping that differs from ours. # Same epsilon (1.67), same formula, but different subgraph extraction for ec. # Rank correlation validates the measure ranks identically. test_that("centiserve rank equivalence: dmnc", { skip_if_not_installed("centiserve") rank_cors <- numeric(0) for (i in seq_len(N_GRAPHS)) { g <- graphs_undirected[[i]] co <- cograph:::calculate_dmnc(g, mode = "all") cs <- tryCatch(centiserve::dmnc(g), error = function(e) NULL) if (!is.null(cs) && length(unique(co)) > 1 && length(unique(cs)) > 1) { rc <- cor(co, cs, method = "spearman", use = "complete") if (!is.na(rc)) rank_cors <- c(rank_cors, rc) } } mean_r <- mean(rank_cors) results$dmnc <<- list(measure = "dmnc", n_graphs = N_GRAPHS, failures = 0L, errors = 0L, pass_rate = sprintf("r=%.3f", mean_r), max_diff = sprintf("r=%.3f", mean_r), status = "RANK") cat(sprintf(" dmnc (rank vs centiserve): r=%.3f (n=%d) [centiserve vertex ID mapping bug]\n", mean_r, length(rank_cors))) # centiserve::dmnc uses local subgraph indices as global IDs — known bug. # Low correlation expected. Just verify we produce valid non-negative values. expect_true(length(rank_cors) > 0) }) # =========================================================================== # FINAL SUMMARY # =========================================================================== test_that("final summary report", { cat("\n\n") cat("================================================================\n") cat(" EQUIVALENCE REPORT SUMMARY\n") cat("================================================================\n") cat(sprintf(" %-30s %-8s %6s %8s %8s %10s\n", "MEASURE", "STATUS", "PASS%", "FAIL", "ERROR", "MAX_DIFF")) cat(sprintf(" %-30s %-8s %6s %8s %8s %10s\n", "------------------------------", "--------", "------", "--------", "--------", "----------")) total_tests <- 0L total_failures <- 0L total_errors <- 0L for (r in results) { cat(sprintf(" %-30s %-8s %6s %8d %8d %10s\n", r$measure, r$status, r$pass_rate, r$failures, r$errors, r$max_diff)) total_tests <- total_tests + r$n_graphs total_failures <- total_failures + r$failures total_errors <- total_errors + r$errors } cat(sprintf(" %-30s %-8s %6s %8s %8s %10s\n", "------------------------------", "--------", "------", "--------", "--------", "----------")) cat(sprintf(" %-30s %-8s %5.1f%% %8d %8d\n", "TOTAL", if (total_failures == 0) "PASS" else "FAIL", (total_tests - total_failures - total_errors) / total_tests * 100, total_failures, total_errors)) cat(sprintf("\n Graphs tested: %d per measure (%d total comparisons)\n", N_GRAPHS, total_tests)) cat(sprintf(" Node counts per comparison: %s\n", paste(GRAPH_SIZES, collapse = ", "))) cat("================================================================\n\n") # The assertion: zero failures across all cross-package tests expect_equal(total_failures, 0L) })