# ---- Tests for centrality_stability() ---- test_that("basic structure is correct", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 50, measures = c("InStrength", "OutStrength"), seed = 42) expect_s3_class(cs, "net_stability") expect_named(cs, c("cs", "correlations", "measures", "drop_prop", "threshold", "certainty", "iter", "method")) expect_equal(cs$iter, 50L) expect_equal(cs$threshold, 0.7) expect_equal(cs$certainty, 0.95) expect_equal(cs$method, "pearson") expect_equal(cs$measures, c("InStrength", "OutStrength")) }) test_that("CS coefficients are valid values from drop_prop", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 50, measures = c("InStrength"), seed = 42) expect_true(cs$cs["InStrength"] %in% c(0, cs$drop_prop)) }) test_that("correlation matrices have correct dimensions", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") dp <- seq(0.1, 0.5, by = 0.1) cs <- centrality_stability(net, iter = 30, measures = c("InStrength", "OutStrength"), drop_prop = dp, seed = 42) for (m in cs$measures) { expect_equal(nrow(cs$correlations[[m]]), 30) expect_equal(ncol(cs$correlations[[m]]), length(dp)) } }) test_that("correlation values are between -1 and 1", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 50, measures = c("InStrength"), seed = 42) vals <- cs$correlations[["InStrength"]] vals <- vals[!is.na(vals)] expect_true(all(vals >= -1 & vals <= 1)) }) test_that("seed produces reproducible results", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs1 <- centrality_stability(net, iter = 50, measures = c("InStrength"), seed = 99) cs2 <- centrality_stability(net, iter = 50, measures = c("InStrength"), seed = 99) expect_equal(cs1$correlations, cs2$correlations) expect_equal(cs1$cs, cs2$cs) }) test_that("betweenness works with centrality_fn", { skip_if_not_installed("tna") skip_if_not_installed("igraph") net <- build_network(tna::group_regulation, method = "relative") my_fn <- function(mat) { g <- igraph::graph_from_adjacency_matrix(mat, mode = "directed", weighted = TRUE) w_inv <- 1 / igraph::E(g)$weight list(Betweenness = igraph::betweenness(g, weights = w_inv)) } cs <- centrality_stability(net, iter = 30, measures = c("Betweenness"), centrality_fn = my_fn, seed = 42) expect_s3_class(cs, "net_stability") expect_true("Betweenness" %in% names(cs$cs)) }) test_that("betweenness works without centrality_fn (built-in)", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 30, measures = c("Betweenness"), seed = 42) expect_s3_class(cs, "net_stability") expect_true("Betweenness" %in% names(cs$cs)) }) test_that("closeness measures work with centrality_fn", { skip_if_not_installed("tna") skip_if_not_installed("igraph") net <- build_network(tna::group_regulation, method = "relative") my_fn <- function(mat) { g <- igraph::graph_from_adjacency_matrix(mat, mode = "directed", weighted = TRUE) w_inv <- 1 / igraph::E(g)$weight list( InCloseness = igraph::closeness(g, mode = "in", weights = w_inv), OutCloseness = igraph::closeness(g, mode = "out", weights = w_inv) ) } cs <- centrality_stability(net, iter = 30, measures = c("InCloseness", "OutCloseness"), centrality_fn = my_fn, seed = 42) expect_s3_class(cs, "net_stability") expect_length(cs$cs, 2) }) test_that("frequency method works", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "frequency") cs <- centrality_stability(net, iter = 30, measures = c("InStrength", "OutStrength"), seed = 42) expect_s3_class(cs, "net_stability") }) test_that("loops = TRUE includes diagonal", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs_no <- centrality_stability(net, iter = 50, measures = c("OutStrength"), loops = FALSE, seed = 42) cs_yes <- centrality_stability(net, iter = 50, measures = c("OutStrength"), loops = TRUE, seed = 42) # With loops = TRUE on relative, OutStrength = 1 always → zero variance # → CS should be 0 expect_equal(cs_yes$cs["OutStrength"], c(OutStrength = 0)) # Without loops, OutStrength has variance → CS > 0 expect_true(cs_no$cs["OutStrength"] > 0) }) test_that("custom drop_prop works", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") dp <- c(0.25, 0.5, 0.75) cs <- centrality_stability(net, iter = 30, measures = c("InStrength"), drop_prop = dp, seed = 42) expect_equal(cs$drop_prop, dp) expect_equal(ncol(cs$correlations[["InStrength"]]), 3) }) test_that("custom threshold and certainty work", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 50, measures = c("InStrength"), threshold = 0.5, certainty = 0.90, seed = 42) expect_equal(cs$threshold, 0.5) expect_equal(cs$certainty, 0.90) }) test_that("spearman method works", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 30, measures = c("InStrength"), method = "spearman", seed = 42) expect_equal(cs$method, "spearman") }) test_that("input validation catches bad arguments", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") expect_error(centrality_stability("not_a_netobject"), "must be a netobject") expect_error(centrality_stability(net, iter = 0), "iter >= 2") expect_error(centrality_stability(net, threshold = 2), "threshold <= 1") expect_error(centrality_stability(net, certainty = -0.1), "certainty >= 0") expect_error(centrality_stability(net, measures = c("FakeMeasure")), "Unknown measures") expect_error(centrality_stability(net, method = "invalid"), "should be one of") }) test_that("engagement dataset matches tna", { skip_if_not_installed("tna") net_e <- build_network(tna::engagement, method = "relative") m_e <- tna::tna(tna::engagement) cs <- centrality_stability(net_e, iter = 200, measures = c("InStrength", "OutStrength"), seed = 42) tcs <- tna:::estimate_cs(m_e, iter = 200, measures = c("InStrength", "OutStrength")) # CS coefficients should match expect_equal(cs$cs["InStrength"], tcs$InStrength$cs_coefficient, ignore_attr = TRUE) expect_equal(cs$cs["OutStrength"], tcs$OutStrength$cs_coefficient, ignore_attr = TRUE) }) test_that("print method works", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 30, measures = c("InStrength"), seed = 42) out <- capture.output(print(cs)) expect_true(any(grepl("Centrality Stability", out))) expect_true(any(grepl("InStrength", out))) }) test_that("summary method returns correct data frame", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 30, measures = c("InStrength", "OutStrength"), seed = 42) s <- summary(cs) expect_s3_class(s, "data.frame") expect_named(s, c("measure", "drop_prop", "mean_cor", "sd_cor", "prop_above")) expect_equal(nrow(s), 2 * length(cs$drop_prop)) }) test_that("plot method returns ggplot", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 30, measures = c("InStrength", "OutStrength"), seed = 42) p <- plot(cs) expect_s3_class(p, "ggplot") }) # ---- missing $data error (L81-82) ---- test_that("centrality_stability errors when $data is NULL", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") net$data <- NULL expect_error(centrality_stability(net, iter = 10L), "does not contain \\$data") }) # ---- zero-variance warning and early return (L124-140) ---- test_that("centrality_stability warns and returns zeros when all measures have zero variance", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") # Force weights to a constant value (all rows identical → all centralities identical) n <- nrow(net$weights) net$weights[] <- 1 / n # OutStrength for relative = 1 always (zero variance); InStrength constant too expect_warning( cs <- centrality_stability(net, iter = 20L, measures = c("InStrength", "OutStrength"), seed = 1), "zero variance" ) expect_s3_class(cs, "net_stability") expect_true(all(cs$cs == 0)) # Correlation matrices should be all NA expect_true(all(is.na(cs$correlations[["InStrength"]]))) }) # ---- association path setup (L156-161) ---- test_that("centrality_stability works for cor (association) method", { set.seed(5) df <- as.data.frame(matrix(rpois(100 * 5, 10), nrow = 100)) colnames(df) <- paste0("V", 1:5) net <- build_network(df, method = "cor") cs <- centrality_stability(net, iter = 20L, measures = c("InStrength", "OutStrength"), drop_prop = c(0.2, 0.4), seed = 5) expect_s3_class(cs, "net_stability") expect_true(all(cs$cs %in% c(0, cs$drop_prop))) }) # ---- association build_matrix function (L181-197) ---- test_that("centrality_stability association path tolerates estimator errors gracefully", { set.seed(9) df <- as.data.frame(matrix(rpois(60 * 4, 10), nrow = 60)) colnames(df) <- paste0("V", 1:4) net <- build_network(df, method = "pcor") cs <- centrality_stability(net, iter = 20L, measures = c("InStrength"), drop_prop = c(0.3, 0.6), seed = 9) expect_s3_class(cs, "net_stability") # CS should be 0 or a valid drop_prop value expect_true(cs$cs["InStrength"] %in% c(0, cs$drop_prop)) }) # ---- single-measure storage path (L216 and L222) ---- test_that("centrality_stability handles single measure correctly", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cs <- centrality_stability(net, iter = 30L, measures = "InStrength", drop_prop = c(0.1, 0.3, 0.5), seed = 77) expect_s3_class(cs, "net_stability") expect_equal(cs$measures, "InStrength") expect_equal(ncol(cs$correlations[["InStrength"]]), 3L) expect_equal(nrow(cs$correlations[["InStrength"]]), 30L) # CS value must be 0 or in drop_prop expect_true(cs$cs["InStrength"] %in% c(0, cs$drop_prop)) }) # ---- CS-coefficient computation (L296-297) ---- test_that(".calculate_cs returns 0 when no prop_above meets certainty", { # Build a correlation matrix where certainty is never met iter <- 10L n_prop <- 3L corr_mat <- matrix(0, nrow = iter, ncol = n_prop) # all zeros < threshold result <- Nestimate:::.calculate_cs(corr_mat, threshold = 0.7, certainty = 0.95, drop_prop = c(0.1, 0.3, 0.5)) expect_equal(result, 0) }) test_that(".calculate_cs returns max valid drop_prop when certainty is met", { iter <- 20L n_prop <- 3L corr_mat <- matrix(1, nrow = iter, ncol = n_prop) # all ones >= threshold result <- Nestimate:::.calculate_cs(corr_mat, threshold = 0.7, certainty = 0.95, drop_prop = c(0.1, 0.3, 0.5)) expect_equal(result, 0.5) }) # ---- cograph_network input (L76) ---- test_that("centrality_stability accepts cograph_network input", { skip_if_not_installed("tna") net <- build_network(tna::group_regulation, method = "relative") cograph_net <- net class(cograph_net) <- "cograph_network" cs <- centrality_stability(cograph_net, iter = 20L, measures = "InStrength", seed = 1) expect_s3_class(cs, "net_stability") }) # ---- centrality() generic (centrality_measures.R) ---- test_that("centrality.netobject returns correct directed defaults (L163-177)", { seqs <- data.frame( V1 = c("A","B","A","C","B","A"), V2 = c("B","C","B","A","C","B"), V3 = c("C","A","C","B","A","C") ) net <- build_network(seqs, method = "relative") c1 <- centrality(net) expect_true(is.data.frame(c1)) expect_equal(nrow(c1), 3) expect_true(all(c("InStrength", "OutStrength", "Betweenness") %in% names(c1))) }) test_that("centrality.netobject returns correct undirected defaults (L163-177)", { set.seed(42) panel <- data.frame(V1 = rnorm(50), V2 = rnorm(50), V3 = rnorm(50)) net_ud <- build_network(panel, method = "cor") c2 <- centrality(net_ud) expect_true(is.data.frame(c2)) expect_true(all(c("Closeness", "Betweenness") %in% names(c2))) }) test_that("centrality.netobject_group returns list of data frames (L185-188)", { seqs <- data.frame( V1 = c("A","B","A","C","B","A"), V2 = c("B","C","B","A","C","B"), V3 = c("C","A","C","B","A","C"), grp = c("X","X","X","Y","Y","Y") ) nets <- build_network(seqs, method = "relative", group = "grp") c3 <- centrality(nets) expect_true(is.list(c3)) expect_equal(length(c3), 2) expect_true(all(vapply(c3, is.data.frame, logical(1)))) }) test_that(".betweenness returns zeros for n < 3 (L53)", { W <- matrix(c(0, 1, 1, 0), nrow = 2, dimnames = list(c("A","B"), c("A","B"))) btw <- Nestimate:::.betweenness(W, directed = TRUE) expect_equal(unname(btw), c(0, 0)) expect_equal(names(btw), c("A", "B")) }) test_that(".compute_centralities handles external centrality_fn (L325-340)", { seqs <- data.frame( V1 = c("A","B","A","C"), V2 = c("B","C","B","A"), V3 = c("C","A","C","B") ) net <- build_network(seqs, method = "relative") custom_fn <- function(mat) { list(MyMeasure = setNames(rowSums(abs(mat)), rownames(mat))) } c4 <- centrality(net, measures = c("InStrength", "MyMeasure"), centrality_fn = custom_fn) expect_true("MyMeasure" %in% names(c4)) expect_true(is.data.frame(c4)) }) test_that(".compute_centralities errors when external measure lacks centrality_fn (L325-329)", { seqs <- data.frame( V1 = c("A","B","A"), V2 = c("B","C","B"), V3 = c("C","A","C") ) net <- build_network(seqs, method = "relative") expect_error( centrality(net, measures = c("InStrength", "BadMeasure")), "centrality_fn is required" ) })