Nothing
# ═══════════════════════════════════════════════════════════════════════════════
# Comprehensive tests for centrality.R - targeting uncovered code paths
# ═══════════════════════════════════════════════════════════════════════════════
# Skip all tests if igraph is not installed
skip_on_cran()
skip_if_not_installed("igraph")
# ═══════════════════════════════════════════════════════════════════════════════
# Helper Functions and Test Fixtures
# ═══════════════════════════════════════════════════════════════════════════════
# Create test matrices for various scenarios
create_simple_matrix <- function() {
mat <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), 3, 3)
rownames(mat) <- colnames(mat) <- c("A", "B", "C")
mat
}
create_directed_matrix <- function() {
mat <- matrix(c(
0, 1, 0, 0,
0, 0, 1, 0,
1, 0, 0, 1,
0, 0, 0, 0
), 4, 4, byrow = TRUE)
rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
mat
}
create_weighted_matrix <- function() {
mat <- matrix(c(
0, 0.5, 0.3, 0,
0.5, 0, 0.8, 0.2,
0.3, 0.8, 0, 0.6,
0, 0.2, 0.6, 0
), 4, 4, byrow = TRUE)
rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
mat
}
create_disconnected_matrix <- function() {
mat <- matrix(0, 4, 4)
mat[1, 2] <- mat[2, 1] <- 1
mat[3, 4] <- mat[4, 3] <- 1
rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
mat
}
create_star_matrix <- function() {
mat <- matrix(0, 5, 5)
mat[1, 2:5] <- mat[2:5, 1] <- 1
rownames(mat) <- colnames(mat) <- c("Center", "L1", "L2", "L3", "L4")
mat
}
create_line_matrix <- function() {
mat <- matrix(0, 4, 4)
mat[1, 2] <- mat[2, 1] <- 1
mat[2, 3] <- mat[3, 2] <- 1
mat[3, 4] <- mat[4, 3] <- 1
rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
mat
}
create_loop_matrix <- function() {
mat <- matrix(c(
1, 1, 0,
1, 1, 1,
0, 1, 1
), 3, 3, byrow = TRUE)
rownames(mat) <- colnames(mat) <- c("A", "B", "C")
mat
}
create_isolated_node_matrix <- function() {
mat <- matrix(0, 4, 4)
mat[1, 2] <- mat[2, 1] <- 1
mat[2, 3] <- mat[3, 2] <- 1
# Node D is isolated
rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
mat
}
create_large_dense_matrix <- function(n = 10) {
mat <- matrix(runif(n * n), n, n)
mat <- (mat + t(mat)) / 2
diag(mat) <- 0
rownames(mat) <- colnames(mat) <- paste0("N", 1:n)
mat
}
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Error Handling and Input Validation
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality errors on invalid mode", {
mat <- create_simple_matrix()
expect_error(centrality(mat, mode = "invalid"), "should be one of")
})
test_that("centrality errors on invalid damping factor", {
mat <- create_simple_matrix()
expect_error(centrality(mat, measures = "pagerank", damping = -0.1),
"damping must be between 0 and 1")
expect_error(centrality(mat, measures = "pagerank", damping = 1.5),
"damping must be between 0 and 1")
})
test_that("centrality errors on invalid sort_by column", {
mat <- create_simple_matrix()
expect_error(centrality(mat, measures = "degree", sort_by = "nonexistent"),
"sort_by column")
})
test_that("centrality errors on unknown measures with helpful message", {
mat <- create_simple_matrix()
err <- expect_error(centrality(mat, measures = c("degree", "fake_measure")))
expect_match(as.character(err), "Unknown measures")
expect_match(as.character(err), "fake_measure")
})
test_that("edge_centrality errors on invalid measures", {
mat <- create_simple_matrix()
expect_error(edge_centrality(mat, measures = "invalid_measure"),
"Unknown edge measures")
})
test_that("edge_centrality errors on invalid sort_by column", {
mat <- create_simple_matrix()
expect_error(edge_centrality(mat, sort_by = "nonexistent"),
"sort_by column")
})
test_that("calculate_kreach errors on k <= 0", {
g <- igraph::make_ring(5)
expect_error(cograph:::calculate_kreach(g, k = 0), "k parameter must be greater than 0")
expect_error(cograph:::calculate_kreach(g, k = -1), "k parameter must be greater than 0")
})
test_that("calculate_percolation errors on mismatched states vector length", {
g <- igraph::make_ring(5)
states <- c(1, 1, 1) # Wrong length
expect_error(cograph:::calculate_percolation(g, states = states),
"states vector length must match")
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Transitivity Types
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_transitivity supports different types", {
mat <- create_simple_matrix()
# Local transitivity (default)
local <- centrality_transitivity(mat, transitivity_type = "local")
expect_length(local, 3)
# Global transitivity
global <- centrality_transitivity(mat, transitivity_type = "global")
expect_length(global, 3)
# Undirected transitivity
undirected <- centrality_transitivity(mat, transitivity_type = "undirected")
expect_length(undirected, 3)
# Barrat (weighted)
barrat <- centrality_transitivity(mat, transitivity_type = "barrat")
expect_length(barrat, 3)
})
test_that("transitivity isolates parameter works", {
mat <- create_isolated_node_matrix()
# Default - NaN for isolates
nan_result <- centrality(mat, measures = "transitivity", isolates = "nan")
expect_true(any(is.nan(nan_result$transitivity)))
# Zero for isolates
zero_result <- centrality(mat, measures = "transitivity", isolates = "zero")
expect_true(all(!is.nan(zero_result$transitivity)))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Mode Parameter for Directional Measures
# ═══════════════════════════════════════════════════════════════════════════════
test_that("mode parameter affects directional measures", {
mat <- create_directed_matrix()
# In-mode
in_result <- centrality(mat, directed = TRUE, mode = "in",
measures = c("degree", "strength", "closeness",
"harmonic", "eccentricity", "coreness"))
expect_true("degree_in" %in% names(in_result))
expect_true("strength_in" %in% names(in_result))
expect_true("closeness_in" %in% names(in_result))
expect_true("harmonic_in" %in% names(in_result))
expect_true("eccentricity_in" %in% names(in_result))
expect_true("coreness_in" %in% names(in_result))
# Out-mode
out_result <- centrality(mat, directed = TRUE, mode = "out",
measures = c("degree", "strength", "closeness",
"harmonic", "eccentricity", "coreness"))
expect_true("degree_out" %in% names(out_result))
expect_true("strength_out" %in% names(out_result))
expect_true("closeness_out" %in% names(out_result))
expect_true("harmonic_out" %in% names(out_result))
expect_true("eccentricity_out" %in% names(out_result))
expect_true("coreness_out" %in% names(out_result))
})
test_that("centrality_indegree and centrality_outdegree work", {
mat <- create_directed_matrix()
in_deg <- centrality_indegree(mat, directed = TRUE)
out_deg <- centrality_outdegree(mat, directed = TRUE)
expect_length(in_deg, 4)
expect_length(out_deg, 4)
expect_true(is.numeric(in_deg))
expect_true(is.numeric(out_deg))
})
test_that("centrality_instrength and centrality_outstrength work", {
mat <- create_weighted_matrix()
in_str <- centrality_instrength(mat, directed = TRUE)
out_str <- centrality_outstrength(mat, directed = TRUE)
expect_length(in_str, 4)
expect_length(out_str, 4)
expect_true(is.numeric(in_str))
expect_true(is.numeric(out_str))
})
test_that("centrality_incloseness and centrality_outcloseness work", {
mat <- create_directed_matrix()
in_close <- centrality_incloseness(mat, directed = TRUE)
out_close <- centrality_outcloseness(mat, directed = TRUE)
expect_length(in_close, 4)
expect_length(out_close, 4)
})
test_that("centrality_inharmonic and centrality_outharmonic work", {
mat <- create_directed_matrix()
in_harm <- centrality_inharmonic(mat, directed = TRUE)
out_harm <- centrality_outharmonic(mat, directed = TRUE)
expect_length(in_harm, 4)
expect_length(out_harm, 4)
})
test_that("centrality_ineccentricity and centrality_outeccentricity work", {
mat <- create_directed_matrix()
in_ecc <- centrality_ineccentricity(mat, directed = TRUE)
out_ecc <- centrality_outeccentricity(mat, directed = TRUE)
expect_length(in_ecc, 4)
expect_length(out_ecc, 4)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Weight Inversion for Path-Based Measures
# ═══════════════════════════════════════════════════════════════════════════════
test_that("invert_weights parameter affects path-based measures", {
mat <- create_weighted_matrix()
# Without inversion
expect_silent(
no_inv <- centrality(mat, measures = c("betweenness", "closeness"),
invert_weights = FALSE, weighted = TRUE)
)
# With inversion (should produce message)
expect_message(
with_inv <- centrality(mat, measures = c("betweenness", "closeness"),
invert_weights = TRUE, weighted = TRUE),
"Weights inverted"
)
# Results should differ
expect_false(all(no_inv$betweenness == with_inv$betweenness))
})
test_that("alpha parameter affects weight inversion", {
# Use a larger matrix with more varied weights for clearer differences
mat <- matrix(c(
0, 0.1, 0.9, 0,
0.1, 0, 0.2, 0.8,
0.9, 0.2, 0, 0.3,
0, 0.8, 0.3, 0
), 4, 4, byrow = TRUE)
rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
# alpha = 1
expect_message(
alpha1 <- centrality(mat, measures = "closeness",
invert_weights = TRUE, alpha = 1, weighted = TRUE),
"1/w\\^1"
)
# alpha = 2
expect_message(
alpha2 <- centrality(mat, measures = "closeness",
invert_weights = TRUE, alpha = 2, weighted = TRUE),
"1/w\\^2"
)
# Results should differ for closeness (path-based measure)
# Use tolerance check since floating point comparison
expect_false(isTRUE(all.equal(alpha1$closeness_all, alpha2$closeness_all)))
})
test_that("edge_centrality respects invert_weights", {
mat <- create_weighted_matrix()
# With inversion
expect_message(
ec_inv <- edge_centrality(mat, invert_weights = TRUE),
"Weights inverted"
)
expect_true(is.data.frame(ec_inv))
expect_true("betweenness" %in% names(ec_inv))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Loops and Simplify Parameters
# ═══════════════════════════════════════════════════════════════════════════════
test_that("loops parameter removes self-loops", {
mat <- create_loop_matrix()
# With loops (default)
with_loops <- centrality(mat, measures = "degree", loops = TRUE)
# Without loops
without_loops <- centrality(mat, measures = "degree", loops = FALSE)
# Should have different degree values
expect_true(any(with_loops$degree_all != without_loops$degree_all))
})
test_that("simplify parameter handles multiple edges", {
# Create igraph with multiple edges
g <- igraph::make_empty_graph(n = 3, directed = FALSE)
g <- igraph::add_edges(g, c(1, 2, 1, 2, 2, 3)) # Two edges between 1-2
igraph::E(g)$weight <- c(0.5, 0.3, 0.8)
igraph::V(g)$name <- c("A", "B", "C")
# Sum (default)
sum_result <- centrality(g, measures = "strength", simplify = "sum")
# Mean
mean_result <- centrality(g, measures = "strength", simplify = "mean")
# Max
max_result <- centrality(g, measures = "strength", simplify = "max")
# Min
min_result <- centrality(g, measures = "strength", simplify = "min")
# Results should differ based on simplification method
expect_true(is.data.frame(sum_result))
expect_true(is.data.frame(mean_result))
expect_true(is.data.frame(max_result))
expect_true(is.data.frame(min_result))
})
test_that("simplify = FALSE keeps multiple edges", {
g <- igraph::make_empty_graph(n = 3, directed = FALSE)
g <- igraph::add_edges(g, c(1, 2, 1, 2, 2, 3))
igraph::V(g)$name <- c("A", "B", "C")
result <- centrality(g, measures = "degree", simplify = FALSE)
expect_true(is.data.frame(result))
})
test_that("simplify = 'none' is equivalent to FALSE", {
g <- igraph::make_empty_graph(n = 3, directed = FALSE)
g <- igraph::add_edges(g, c(1, 2, 1, 2, 2, 3))
igraph::V(g)$name <- c("A", "B", "C")
result_false <- centrality(g, measures = "degree", simplify = FALSE)
result_none <- centrality(g, measures = "degree", simplify = "none")
expect_equal(result_false, result_none)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Cutoff Parameter
# ═══════════════════════════════════════════════════════════════════════════════
test_that("cutoff parameter limits path length", {
# Use smaller matrix for faster testing
mat <- matrix(c(
0, 1, 1, 0, 0, 0,
1, 0, 1, 1, 0, 0,
1, 1, 0, 1, 1, 0,
0, 1, 1, 0, 1, 1,
0, 0, 1, 1, 0, 1,
0, 0, 0, 1, 1, 0
), 6, 6, byrow = TRUE)
rownames(mat) <- colnames(mat) <- LETTERS[1:6]
# With cutoff
with_cutoff <- centrality(mat, measures = c("betweenness", "closeness"),
cutoff = 2)
# Without cutoff
without_cutoff <- centrality(mat, measures = c("betweenness", "closeness"),
cutoff = -1)
expect_true(is.data.frame(with_cutoff))
expect_true(is.data.frame(without_cutoff))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: PageRank Parameters
# ═══════════════════════════════════════════════════════════════════════════════
test_that("damping parameter affects pagerank", {
# Use a larger asymmetric network where damping has more effect
mat <- matrix(c(
0, 1, 0, 0, 0,
0, 0, 1, 0, 0,
1, 0, 0, 1, 0,
0, 0, 0, 0, 1,
0, 1, 0, 0, 0
), 5, 5, byrow = TRUE)
rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D", "E")
pr_85 <- centrality_pagerank(mat, damping = 0.85, directed = TRUE)
pr_50 <- centrality_pagerank(mat, damping = 0.50, directed = TRUE)
expect_length(pr_85, 5)
expect_length(pr_50, 5)
# Results should differ (use tolerance comparison)
expect_false(isTRUE(all.equal(pr_85, pr_50)))
})
test_that("personalized pagerank works", {
mat <- create_simple_matrix()
# Standard PageRank
standard <- centrality_pagerank(mat)
# Personalized PageRank
personalized_vec <- c(A = 0.5, B = 0.3, C = 0.2)
personalized <- centrality_pagerank(mat, personalized = personalized_vec)
expect_length(personalized, 3)
# Results should differ
expect_false(all(standard == personalized))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Diffusion Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_diffusion works with different modes", {
mat <- create_directed_matrix()
# All modes
diff_all <- centrality_diffusion(mat, mode = "all", directed = TRUE)
expect_length(diff_all, 4)
# For undirected
mat_un <- create_simple_matrix()
diff_un <- centrality_diffusion(mat_un)
expect_length(diff_un, 3)
})
test_that("lambda parameter affects diffusion", {
mat <- create_simple_matrix()
diff_1 <- centrality_diffusion(mat, lambda = 1)
diff_2 <- centrality_diffusion(mat, lambda = 2)
expect_false(all(diff_1 == diff_2))
})
test_that("calculate_diffusion handles empty graph", {
g <- igraph::make_empty_graph(n = 0, directed = FALSE)
result <- cograph:::calculate_diffusion(g)
expect_length(result, 0)
})
test_that("calculate_diffusion handles directed graph modes", {
mat <- create_directed_matrix()
g <- igraph::graph_from_adjacency_matrix(mat, mode = "directed")
# Out mode
out_result <- cograph:::calculate_diffusion(g, mode = "out")
expect_length(out_result, 4)
# In mode
in_result <- cograph:::calculate_diffusion(g, mode = "in")
expect_length(in_result, 4)
# All mode
all_result <- cograph:::calculate_diffusion(g, mode = "all")
expect_length(all_result, 4)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Leverage Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_leverage works", {
mat <- create_simple_matrix()
lev <- centrality_leverage(mat)
expect_length(lev, 3)
expect_true(is.numeric(lev))
})
test_that("leverage returns NaN for isolated nodes", {
mat <- create_isolated_node_matrix()
lev <- centrality_leverage(mat)
expect_true(is.nan(lev["D"]))
})
test_that("calculate_leverage handles empty graph", {
g <- igraph::make_empty_graph(n = 0, directed = FALSE)
result <- cograph:::calculate_leverage(g)
expect_length(result, 0)
})
test_that("leverage handles directed graph modes", {
mat <- create_directed_matrix()
g <- igraph::graph_from_adjacency_matrix(mat, mode = "directed")
# In mode
in_result <- cograph:::calculate_leverage(g, mode = "in")
expect_length(in_result, 4)
# Out mode
out_result <- cograph:::calculate_leverage(g, mode = "out")
expect_length(out_result, 4)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: K-Reach Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_kreach works with different k values", {
mat <- create_line_matrix()
k1 <- centrality_kreach(mat, k = 1)
k2 <- centrality_kreach(mat, k = 2)
k3 <- centrality_kreach(mat, k = 3)
expect_length(k1, 4)
expect_length(k2, 4)
expect_length(k3, 4)
# Higher k should reach more nodes (or same)
expect_true(all(k2 >= k1))
expect_true(all(k3 >= k2))
})
test_that("calculate_kreach handles empty graph", {
g <- igraph::make_empty_graph(n = 0, directed = FALSE)
result <- cograph:::calculate_kreach(g, k = 3)
expect_length(result, 0)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Laplacian Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_laplacian works", {
mat <- create_simple_matrix()
lap <- centrality_laplacian(mat)
expect_length(lap, 3)
expect_true(is.numeric(lap))
expect_true(all(lap >= 0))
})
test_that("calculate_laplacian handles edge cases", {
# Empty graph
g <- igraph::make_empty_graph(n = 0)
result_empty <- cograph:::calculate_laplacian(g)
expect_length(result_empty, 0)
# Single node
g1 <- igraph::make_empty_graph(n = 1)
result_single <- cograph:::calculate_laplacian(g1)
expect_equal(result_single, 0)
})
test_that("laplacian normalized option works", {
g <- igraph::make_ring(5)
result <- cograph:::calculate_laplacian(g, normalized = TRUE)
expect_true(max(result) == 1)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Load Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_load works", {
mat <- create_simple_matrix()
load_cent <- centrality_load(mat)
expect_length(load_cent, 3)
expect_true(is.numeric(load_cent))
})
test_that("calculate_load handles edge cases", {
# Empty graph
g <- igraph::make_empty_graph(n = 0)
result_empty <- cograph:::calculate_load(g)
expect_length(result_empty, 0)
# Single node
g1 <- igraph::make_empty_graph(n = 1)
result_single <- cograph:::calculate_load(g1)
expect_equal(result_single, 0)
})
test_that("load centrality works for directed graphs", {
mat <- create_directed_matrix()
g <- igraph::graph_from_adjacency_matrix(mat, mode = "directed")
result <- cograph:::calculate_load(g, directed = TRUE)
expect_length(result, 4)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Current Flow Closeness
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_current_flow_closeness works", {
mat <- create_simple_matrix()
cfc <- centrality_current_flow_closeness(mat)
expect_length(cfc, 3)
expect_true(is.numeric(cfc))
})
test_that("current_flow_closeness returns NA for disconnected graphs", {
mat <- create_disconnected_matrix()
expect_warning(
cfc <- centrality_current_flow_closeness(mat),
"not connected"
)
expect_true(all(is.na(cfc)))
})
test_that("calculate_current_flow_closeness handles edge cases", {
# Empty graph
g <- igraph::make_empty_graph(n = 0)
result_empty <- cograph:::calculate_current_flow_closeness(g)
expect_length(result_empty, 0)
# Single node
g1 <- igraph::make_empty_graph(n = 1)
result_single <- cograph:::calculate_current_flow_closeness(g1)
expect_true(is.na(result_single))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Current Flow Betweenness
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_current_flow_betweenness works", {
mat <- create_simple_matrix()
cfb <- centrality_current_flow_betweenness(mat)
expect_length(cfb, 3)
expect_true(is.numeric(cfb))
})
test_that("current_flow_betweenness returns NA for disconnected graphs", {
mat <- create_disconnected_matrix()
expect_warning(
cfb <- centrality_current_flow_betweenness(mat),
"not connected"
)
expect_true(all(is.na(cfb)))
})
test_that("calculate_current_flow_betweenness handles edge cases", {
# Empty graph
g <- igraph::make_empty_graph(n = 0)
result_empty <- cograph:::calculate_current_flow_betweenness(g)
expect_length(result_empty, 0)
# Two nodes
g2 <- igraph::make_full_graph(2)
result_small <- cograph:::calculate_current_flow_betweenness(g2)
expect_equal(result_small, c(0, 0))
})
test_that("current_flow_betweenness works with weights", {
mat <- create_weighted_matrix()
g <- igraph::graph_from_adjacency_matrix(mat, mode = "undirected", weighted = TRUE)
result <- cograph:::calculate_current_flow_betweenness(g, weights = igraph::E(g)$weight)
expect_length(result, 4)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: VoteRank
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_voterank works", {
mat <- create_simple_matrix()
vr <- centrality_voterank(mat)
expect_length(vr, 3)
expect_true(is.numeric(vr))
expect_true(all(vr >= 0 & vr <= 1))
})
test_that("calculate_voterank handles edge cases", {
# Empty graph
g <- igraph::make_empty_graph(n = 0)
result_empty <- cograph:::calculate_voterank(g)
expect_length(result_empty, 0)
# Single node
g1 <- igraph::make_empty_graph(n = 1)
result_single <- cograph:::calculate_voterank(g1)
expect_equal(result_single, 1)
})
test_that("voterank handles directed graph", {
mat <- create_directed_matrix()
g <- igraph::graph_from_adjacency_matrix(mat, mode = "directed")
result <- cograph:::calculate_voterank(g, directed = TRUE)
expect_length(result, 4)
})
test_that("voterank handles zero degree graph", {
g <- igraph::make_empty_graph(n = 3)
igraph::V(g)$name <- c("A", "B", "C")
result <- cograph:::calculate_voterank(g, directed = FALSE)
expect_length(result, 3)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Percolation Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_percolation works", {
mat <- create_simple_matrix()
perc <- centrality_percolation(mat)
expect_length(perc, 3)
expect_true(is.numeric(perc))
})
test_that("percolation with custom states works", {
mat <- create_simple_matrix()
states <- c(A = 0.5, B = 1.0, C = 0.2)
perc <- centrality_percolation(mat, states = states)
expect_length(perc, 3)
expect_true(is.numeric(perc))
})
test_that("calculate_percolation handles edge cases", {
# Empty graph
g <- igraph::make_empty_graph(n = 0)
result_empty <- cograph:::calculate_percolation(g)
expect_length(result_empty, 0)
# Two nodes
g2 <- igraph::make_full_graph(2)
result_small <- cograph:::calculate_percolation(g2)
expect_equal(result_small, c(0, 0))
})
test_that("percolation handles all-zero states", {
mat <- create_simple_matrix()
g <- igraph::graph_from_adjacency_matrix(mat, mode = "undirected")
states <- rep(0, 3)
result <- cograph:::calculate_percolation(g, states = states)
expect_true(all(result == 0))
})
test_that("percolation clamps states to [0, 1]", {
mat <- create_simple_matrix()
# States outside [0, 1] should be clamped
states <- c(A = -0.5, B = 1.5, C = 0.5)
# Should not error
perc <- centrality_percolation(mat, states = states)
expect_length(perc, 3)
})
test_that("percolation fills NA states with 1.0", {
mat <- create_simple_matrix()
states <- c(A = 0.5, B = NA, C = 0.8)
perc <- centrality_percolation(mat, states = states)
expect_length(perc, 3)
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Alpha and Power Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_alpha works", {
mat <- create_simple_matrix()
alpha <- centrality_alpha(mat)
expect_length(alpha, 3)
expect_true(is.numeric(alpha))
})
test_that("centrality_power works", {
mat <- create_simple_matrix()
power <- centrality_power(mat)
expect_length(power, 3)
expect_true(is.numeric(power))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Authority and Hub
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_authority works", {
mat <- create_directed_matrix()
auth <- centrality_authority(mat)
expect_length(auth, 4)
expect_true(is.numeric(auth))
})
test_that("centrality_hub works", {
mat <- create_directed_matrix()
hub <- centrality_hub(mat)
expect_length(hub, 4)
expect_true(is.numeric(hub))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Constraint Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_constraint works", {
mat <- create_simple_matrix()
const <- centrality_constraint(mat)
expect_length(const, 3)
expect_true(is.numeric(const))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Coreness
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_coreness works", {
mat <- create_simple_matrix()
core <- centrality_coreness(mat)
expect_length(core, 3)
expect_true(is.numeric(core))
expect_true(all(core >= 0))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Subgraph Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality_subgraph works", {
mat <- create_simple_matrix()
sub <- centrality_subgraph(mat)
expect_length(sub, 3)
expect_true(is.numeric(sub))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Edge Centrality
# ═══════════════════════════════════════════════════════════════════════════════
test_that("edge_centrality returns correct structure", {
mat <- create_simple_matrix()
result <- edge_centrality(mat)
expect_true(is.data.frame(result))
expect_true("from" %in% names(result))
expect_true("to" %in% names(result))
expect_true("weight" %in% names(result))
expect_true("betweenness" %in% names(result))
})
test_that("edge_centrality with specific measures", {
mat <- create_simple_matrix()
# Just betweenness
bet_only <- edge_centrality(mat, measures = "betweenness")
expect_true("betweenness" %in% names(bet_only))
expect_false("weight" %in% names(bet_only))
# Just weight
weight_only <- edge_centrality(mat, measures = "weight")
expect_true("weight" %in% names(weight_only))
expect_false("betweenness" %in% names(weight_only))
})
test_that("edge_centrality sorting works", {
mat <- create_star_matrix()
sorted <- edge_centrality(mat, sort_by = "betweenness")
expect_true(is.data.frame(sorted))
# Should be in descending order
expect_true(all(diff(sorted$betweenness) <= 0))
})
test_that("edge_centrality digits rounding works", {
mat <- create_weighted_matrix()
rounded <- edge_centrality(mat, digits = 2)
expect_true(is.data.frame(rounded))
})
test_that("edge_betweenness convenience function works", {
mat <- create_simple_matrix()
eb <- edge_betweenness(mat)
expect_true(is.numeric(eb))
expect_true(!is.null(names(eb)))
})
test_that("edge_centrality handles unweighted graphs", {
mat <- create_simple_matrix()
result <- edge_centrality(mat, weighted = FALSE)
expect_true(is.data.frame(result))
# Weight should be 1 for all edges
expect_true(all(result$weight == 1))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Normalization
# ═══════════════════════════════════════════════════════════════════════════════
test_that("normalization works for various measures", {
mat <- create_simple_matrix()
result <- centrality(mat, normalized = TRUE,
measures = c("degree", "betweenness", "strength",
"eigenvector", "pagerank"))
# All normalized values should be <= 1
expect_true(all(result$degree_all <= 1))
expect_true(all(result$betweenness <= 1, na.rm = TRUE))
expect_true(all(result$strength_all <= 1))
expect_true(all(result$eigenvector <= 1))
expect_true(all(result$pagerank <= 1))
})
test_that("normalization handles max value of 0", {
# Create graph where all betweenness is 0
mat <- matrix(c(0, 1, 0, 1, 0, 0, 0, 0, 0), 3, 3)
rownames(mat) <- colnames(mat) <- c("A", "B", "C")
result <- centrality(mat, measures = "betweenness", normalized = TRUE)
expect_true(all(result$betweenness == 0))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Graph Without Node Names
# ═══════════════════════════════════════════════════════════════════════════════
test_that("centrality works with unnamed matrix", {
mat <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), 3, 3)
# No row/column names
result <- centrality(mat)
expect_true(is.data.frame(result))
expect_equal(result$node, c("1", "2", "3"))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Unweighted Mode
# ═══════════════════════════════════════════════════════════════════════════════
test_that("weighted = FALSE ignores weights", {
# Use binary matrix for cleaner comparison
mat <- matrix(c(
0, 1, 1, 0,
1, 0, 1, 1,
1, 1, 0, 1,
0, 1, 1, 0
), 4, 4, byrow = TRUE)
rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D")
# Add weights to create weighted version
mat_weighted <- mat * runif(16, 0.1, 0.9)
mat_weighted <- (mat_weighted + t(mat_weighted)) / 2
mat_weighted[mat == 0] <- 0
# Test that weighted results differ from unweighted
weighted_result <- centrality(mat_weighted, measures = "strength", weighted = TRUE)
unweighted_result <- centrality(mat_weighted, measures = "strength", weighted = FALSE)
# Weighted strength should differ from unweighted (which should match structure)
expect_true(is.data.frame(weighted_result))
expect_true(is.data.frame(unweighted_result))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: All Measures Combined
# ═══════════════════════════════════════════════════════════════════════════════
test_that("calculating all measures works", {
# Use smaller fixed matrix to run faster
mat <- matrix(c(
0, 1, 1, 0, 0,
1, 0, 1, 1, 0,
1, 1, 0, 1, 1,
0, 1, 1, 0, 1,
0, 0, 1, 1, 0
), 5, 5, byrow = TRUE)
rownames(mat) <- colnames(mat) <- LETTERS[1:5]
# Only test a subset of measures to keep test fast
result <- centrality(mat, measures = c("degree", "betweenness", "closeness",
"eigenvector", "pagerank", "harmonic"))
expect_true(is.data.frame(result))
expect_true(nrow(result) == 5)
expect_true(ncol(result) >= 6) # node + 6 measures
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Star Network Properties
# ═══════════════════════════════════════════════════════════════════════════════
test_that("star network has expected centrality properties", {
mat <- create_star_matrix()
result <- centrality(mat, measures = c("degree", "betweenness", "closeness"))
# Center node should have highest degree
center_idx <- which(result$node == "Center")
expect_equal(result$degree_all[center_idx], max(result$degree_all))
# Center should have highest betweenness
expect_equal(result$betweenness[center_idx], max(result$betweenness))
# Center should have highest closeness
expect_equal(result$closeness_all[center_idx], max(result$closeness_all))
})
# ═══════════════════════════════════════════════════════════════════════════════
# Test: Line Network Properties
# ═══════════════════════════════════════════════════════════════════════════════
test_that("line network has expected centrality properties", {
mat <- create_line_matrix()
result <- centrality(mat, measures = c("degree", "betweenness", "closeness"))
# Middle nodes (B, C) should have highest betweenness
middle_bet <- result$betweenness[result$node %in% c("B", "C")]
edge_bet <- result$betweenness[result$node %in% c("A", "D")]
expect_true(all(middle_bet > edge_bet))
# Endpoints should have degree 1
endpoints <- result$degree_all[result$node %in% c("A", "D")]
expect_true(all(endpoints == 1))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.