# ---- Simplicial Complex Tests ---- # Helper: build a known network .make_sc_net <- function(seed = 42) { set.seed(seed) seqs <- data.frame( V1 = sample(LETTERS[1:5], 40, TRUE), V2 = sample(LETTERS[1:5], 40, TRUE), V3 = sample(LETTERS[1:5], 40, TRUE), V4 = sample(LETTERS[1:5], 40, TRUE) ) build_network(seqs, method = "relative") } # Helper: build a simple known matrix for exact verification .make_sc_mat <- function() { # 4-node complete graph => K4 clique complex mat <- matrix(0.5, 4, 4) diag(mat) <- 0 rownames(mat) <- colnames(mat) <- LETTERS[1:4] mat } # Helper: triangle matrix .make_triangle_mat <- function() { mat <- matrix(0, 3, 3) mat[1, 2] <- mat[2, 1] <- 1 mat[1, 3] <- mat[3, 1] <- 1 mat[2, 3] <- mat[3, 2] <- 1 rownames(mat) <- colnames(mat) <- c("X", "Y", "Z") mat } # ========================================================================= # build_simplicial — clique type # ========================================================================= test_that("build_simplicial clique returns correct class and structure", { mat <- .make_sc_mat() sc <- build_simplicial(mat, type = "clique") expect_s3_class(sc, "simplicial_complex") expect_equal(sc$type, "clique") expect_equal(sc$n_nodes, 4L) expect_true(sc$n_simplices > 0L) expect_true(sc$dimension >= 1L) expect_true(is.numeric(sc$density)) expect_true(is.numeric(sc$mean_dim)) expect_true(length(sc$f_vector) > 0L) expect_equal(length(sc$nodes), 4L) expect_true(is.list(sc$simplices)) }) test_that("build_simplicial clique on K4 gives complete simplex", { # K4 => 1 tetrahedron (3-simplex), 4 triangles, 6 edges, 4 vertices mat <- .make_sc_mat() sc <- build_simplicial(mat, type = "clique") expect_equal(sc$dimension, 3L) # f-vector: f0=4, f1=6, f2=4, f3=1 expect_equal(as.integer(sc$f_vector), c(4L, 6L, 4L, 1L)) expect_equal(sc$n_simplices, 4 + 6 + 4 + 1) }) test_that("build_simplicial clique with threshold filters edges", { mat <- .make_sc_mat() mat[1, 2] <- mat[2, 1] <- 0.01 # Weak edge A-B sc_full <- build_simplicial(mat, threshold = 0) sc_thresh <- build_simplicial(mat, threshold = 0.1) # Thresholded version should have fewer simplices expect_true(sc_thresh$n_simplices < sc_full$n_simplices) expect_true(sc_thresh$dimension <= sc_full$dimension) }) test_that("build_simplicial clique with max_dim limits dimension", { mat <- .make_sc_mat() sc <- build_simplicial(mat, type = "clique", max_dim = 1L) # max_dim=1 => only vertices and edges expect_lte(sc$dimension, 1L) }) test_that("build_simplicial accepts netobject input", { net <- .make_sc_net() sc <- build_simplicial(net, threshold = 0.05) expect_s3_class(sc, "simplicial_complex") expect_equal(sc$type, "clique") expect_true(sc$n_nodes > 0L) }) test_that("build_simplicial accepts tna object input", { skip_if_not_installed("tna") tna_model <- tna::tna(tna::group_regulation) sc <- build_simplicial(tna_model, threshold = 0.1) expect_s3_class(sc, "simplicial_complex") }) test_that("build_simplicial on matrix without rownames assigns V-names", { mat <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), 3, 3) sc <- build_simplicial(mat) expect_equal(sc$nodes, c("V1", "V2", "V3")) }) # ========================================================================= # build_simplicial — VR type # ========================================================================= test_that("build_simplicial VR produces correct class", { mat <- .make_sc_mat() sc <- build_simplicial(mat, type = "vr", threshold = 0.3) expect_s3_class(sc, "simplicial_complex") expect_equal(sc$type, "vr") }) test_that("build_simplicial VR symmetrizes matrix", { # Asymmetric matrix: only A->B has weight, not B->A mat <- matrix(0, 3, 3) mat[1, 2] <- 1 rownames(mat) <- colnames(mat) <- c("A", "B", "C") sc <- build_simplicial(mat, type = "vr", threshold = 0.5) # Should still detect A-B edge (symmetrized) expect_true(sc$n_simplices > sc$n_nodes) }) test_that("build_simplicial VR high threshold gives disconnected graph", { mat <- .make_sc_mat() sc <- build_simplicial(mat, type = "vr", threshold = 0.9) # All edges are 0.5 < 0.9 => no edges, only vertices expect_equal(sc$dimension, 0L) expect_equal(sc$n_simplices, 4L) # just the 4 vertices }) # ========================================================================= # build_simplicial — pathway type # ========================================================================= test_that("build_simplicial pathway from net_hon works", { trajs <- list( c("A", "B", "C", "A", "B"), c("B", "C", "A", "B", "C"), c("A", "B", "C", "B", "A"), c("C", "A", "B", "C", "A") ) hon <- build_hon(trajs, max_order = 2, min_freq = 1) sc <- build_simplicial(hon, type = "pathway") expect_s3_class(sc, "simplicial_complex") expect_equal(sc$type, "pathway") }) test_that("build_simplicial pathway with max_pathways limits input", { trajs <- list( c("A", "B", "C", "A", "B"), c("B", "C", "A", "B", "C"), c("A", "B", "C", "B", "A") ) hon <- build_hon(trajs, max_order = 2, min_freq = 1) sc_full <- build_simplicial(hon, type = "pathway") sc_limited <- build_simplicial(hon, type = "pathway", max_pathways = 2) expect_lte(sc_limited$n_simplices, sc_full$n_simplices) }) test_that("build_simplicial pathway from netobject builds HON internally", { net <- .make_sc_net() sc <- build_simplicial(net, type = "pathway", max_order = 2, min_freq = 1) expect_s3_class(sc, "simplicial_complex") expect_equal(sc$type, "pathway") }) test_that("build_simplicial pathway rejects unsupported input", { expect_error( build_simplicial(list(a = 1), type = "pathway"), "net_hon.*net_hypa.*tna.*netobject" ) }) test_that("build_simplicial pathway from hypa works", { trajs <- list( c("A", "B", "C"), c("A", "B", "C"), c("A", "B", "C"), c("A", "B", "D"), c("C", "B", "D"), c("C", "B", "A") ) h <- build_hypa(trajs, k = 2) sc <- build_simplicial(h, type = "pathway") expect_s3_class(sc, "simplicial_complex") expect_equal(sc$type, "pathway") }) # ========================================================================= # .sc_extract_matrix # ========================================================================= test_that(".sc_extract_matrix handles different input types", { # Matrix mat <- .make_sc_mat() expect_identical(.sc_extract_matrix(mat), mat) # netobject net <- .make_sc_net() expect_identical(.sc_extract_matrix(net), net$weights) # tna object skip_if_not_installed("tna") tna_model <- tna::tna(tna::group_regulation) expect_identical(.sc_extract_matrix(tna_model), tna_model$weights) # net_hon object trajs <- list(c("A", "B", "C"), c("B", "C", "A")) hon <- build_hon(trajs, max_order = 2, min_freq = 1) expect_identical(.sc_extract_matrix(hon), hon$matrix) # Unsupported expect_error(.sc_extract_matrix(data.frame(a = 1)), "Cannot extract") }) # ========================================================================= # betti_numbers # ========================================================================= test_that("betti_numbers on filled triangle gives b0=1, rest 0", { # Clique complex on K3 fills the triangle => contractible (solid triangle) mat <- .make_triangle_mat() sc <- build_simplicial(mat, threshold = 0) b <- betti_numbers(sc) expect_equal(b[["b0"]], 1L) # 1 component expect_equal(b[["b1"]], 0L) # No loop (triangle is filled by 2-simplex) }) test_that("betti_numbers on K4 gives b0=1, b_rest=0 (contractible)", { mat <- .make_sc_mat() sc <- build_simplicial(mat) b <- betti_numbers(sc) expect_equal(b[["b0"]], 1L) # K4 clique complex (tetrahedron) is contractible expect_true(all(b[-1] == 0)) }) test_that("betti_numbers on disconnected graph gives b0=n_components", { # Two disconnected edges: A-B and C-D mat <- matrix(0, 4, 4) mat[1, 2] <- mat[2, 1] <- 1 mat[3, 4] <- mat[4, 3] <- 1 rownames(mat) <- colnames(mat) <- LETTERS[1:4] sc <- build_simplicial(mat) b <- betti_numbers(sc) expect_equal(b[["b0"]], 2L) # 2 components }) test_that("betti_numbers rejects non-simplicial_complex", { expect_error(betti_numbers(list(a = 1)), "simplicial_complex") }) # ========================================================================= # euler_characteristic # ========================================================================= test_that("euler_characteristic matches Euler-Poincare theorem", { mat <- .make_triangle_mat() sc <- build_simplicial(mat) chi <- euler_characteristic(sc) b <- betti_numbers(sc) # chi = sum((-1)^k * beta_k) dims <- seq_along(b) - 1L chi_from_betti <- as.integer(sum((-1L)^dims * b)) expect_equal(chi, chi_from_betti) }) test_that("euler_characteristic of K4 is 1", { mat <- .make_sc_mat() sc <- build_simplicial(mat) # chi = f0 - f1 + f2 - f3 = 4 - 6 + 4 - 1 = 1 expect_equal(euler_characteristic(sc), 1L) }) test_that("euler_characteristic rejects non-simplicial_complex", { expect_error(euler_characteristic(list(a = 1)), "simplicial_complex") }) # ========================================================================= # simplicial_degree # ========================================================================= test_that("simplicial_degree returns correct structure", { mat <- .make_sc_mat() sc <- build_simplicial(mat) deg <- simplicial_degree(sc) expect_true(is.data.frame(deg)) expect_true("node" %in% names(deg)) expect_true("total" %in% names(deg)) expect_equal(nrow(deg), sc$n_nodes) # d0 column exists for vertices expect_true("d0" %in% names(deg)) }) test_that("simplicial_degree on K4 gives equal participation", { mat <- .make_sc_mat() sc <- build_simplicial(mat) deg <- simplicial_degree(sc) # In K4, all nodes participate equally expect_true(all(deg$total == deg$total[1])) }) test_that("simplicial_degree normalized divides by max", { mat <- .make_sc_mat() sc <- build_simplicial(mat) deg_raw <- simplicial_degree(sc, normalized = FALSE) deg_norm <- simplicial_degree(sc, normalized = TRUE) # Normalized d0 should be 1 for each node expect_true(all(deg_norm$d0 == 1)) # Normalized values <= 1 d_cols <- grep("^d[0-9]+$", names(deg_norm), value = TRUE) expect_true(all(deg_norm[, d_cols] <= 1)) }) test_that("simplicial_degree rejects non-simplicial_complex", { expect_error(simplicial_degree(list()), "simplicial_complex") }) # ========================================================================= # persistent_homology # ========================================================================= test_that("persistent_homology returns correct class and structure", { net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 10) expect_s3_class(ph, "persistent_homology") expect_true(is.data.frame(ph$betti_curve)) expect_true(is.data.frame(ph$persistence)) expect_true(is.numeric(ph$thresholds)) expect_equal(length(ph$thresholds), 10L) expect_true(all(c("threshold", "dimension", "betti") %in% names(ph$betti_curve))) expect_true(all(c("dimension", "birth", "death", "persistence") %in% names(ph$persistence))) }) test_that("persistent_homology thresholds are decreasing", { net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 15) expect_true(all(diff(ph$thresholds) < 0)) }) test_that("persistent_homology b0 increases as threshold increases", { net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 20) b0 <- ph$betti_curve[ph$betti_curve$dimension == 0, ] # At highest threshold, b0 should be large (disconnected) # At lowest threshold, b0 should be small (connected) # b0 should generally increase with threshold expect_gte(b0$betti[1], b0$betti[nrow(b0)]) }) test_that("persistent_homology fails on zero matrix", { mat <- matrix(0, 3, 3) rownames(mat) <- colnames(mat) <- c("A", "B", "C") expect_error(persistent_homology(mat), "All weights are zero") }) test_that("persistent_homology persistence >= 0", { net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 10) if (nrow(ph$persistence) > 0L) { expect_true(all(ph$persistence$persistence >= 0)) } }) test_that("persistent_homology from matrix works", { mat <- .make_sc_mat() ph <- persistent_homology(mat, n_steps = 5) expect_s3_class(ph, "persistent_homology") }) # ========================================================================= # q_analysis # ========================================================================= test_that("q_analysis returns correct class and structure", { mat <- .make_sc_mat() sc <- build_simplicial(mat) qa <- q_analysis(sc) expect_s3_class(qa, "q_analysis") expect_true(is.integer(qa$q_vector) || is.numeric(qa$q_vector)) expect_true(is.integer(qa$max_q) || is.numeric(qa$max_q)) expect_true(is.integer(qa$structure_vector) || is.numeric(qa$structure_vector)) expect_equal(length(qa$structure_vector), sc$n_nodes) }) test_that("q_analysis on K4: q_vector = 1 at all levels", { mat <- .make_sc_mat() sc <- build_simplicial(mat) qa <- q_analysis(sc) # K4 is fully connected at all q levels expect_true(all(qa$q_vector == 1L)) expect_equal(qa$max_q, 3L) # K4 has a 3-simplex }) test_that("q_analysis structure_vector gives max simplex dim per node", { mat <- .make_sc_mat() sc <- build_simplicial(mat) qa <- q_analysis(sc) # All nodes in K4 are in the 3-simplex expect_true(all(qa$structure_vector == 3L)) }) test_that("q_analysis with single maximal simplex returns 1", { # Only one maximal simplex => 1 component at all levels mat <- .make_triangle_mat() # Add a fill to make it a filled triangle (K3 = 2-simplex) mat_full <- matrix(0.5, 3, 3) diag(mat_full) <- 0 rownames(mat_full) <- colnames(mat_full) <- c("X", "Y", "Z") sc <- build_simplicial(mat_full) qa <- q_analysis(sc) expect_true(all(qa$q_vector == 1L)) }) test_that("q_analysis on disconnected graph fragments at q=0", { mat <- matrix(0, 4, 4) mat[1, 2] <- mat[2, 1] <- 1 mat[3, 4] <- mat[4, 3] <- 1 rownames(mat) <- colnames(mat) <- LETTERS[1:4] sc <- build_simplicial(mat) qa <- q_analysis(sc) # At q=0, should have at least 2 components last_q <- qa$q_vector[length(qa$q_vector)] expect_gte(last_q, 2L) }) test_that("q_analysis rejects non-simplicial_complex", { expect_error(q_analysis(list()), "simplicial_complex") }) # ========================================================================= # verify_simplicial (cross-validation with igraph) # ========================================================================= test_that("verify_simplicial matches igraph on K4", { skip_if_not_installed("igraph") mat <- .make_sc_mat() out <- capture.output(res <- verify_simplicial(mat)) expect_true(res$cliques_match) expect_equal(res$n_simplices_ours, res$n_simplices_igraph) }) test_that("verify_simplicial matches igraph on triangle", { skip_if_not_installed("igraph") mat <- .make_triangle_mat() out <- capture.output(res <- verify_simplicial(mat)) expect_true(res$cliques_match) }) test_that("verify_simplicial matches igraph with threshold", { skip_if_not_installed("igraph") mat <- .make_sc_mat() mat[1, 2] <- mat[2, 1] <- 0.01 out <- capture.output(res <- verify_simplicial(mat, threshold = 0.1)) expect_true(res$cliques_match) }) test_that("verify_simplicial Euler-Poincare holds", { skip_if_not_installed("igraph") mat <- .make_sc_mat() out <- capture.output(res <- verify_simplicial(mat)) b <- res$betti dims <- seq_along(b) - 1L euler_from_betti <- as.integer(sum((-1L)^dims * b)) expect_equal(res$euler, euler_from_betti) }) test_that("verify_simplicial on random network passes", { skip_if_not_installed("igraph") net <- .make_sc_net() out <- capture.output(res <- verify_simplicial(net$weights, threshold = 0.1)) expect_true(res$cliques_match) }) # ========================================================================= # print methods # ========================================================================= test_that("print.simplicial_complex works with non-zero Betti", { mat <- .make_triangle_mat() sc <- build_simplicial(mat) out <- capture.output(print(sc)) expect_true(any(grepl("Clique Complex", out))) expect_true(any(grepl("f-vector", out))) expect_true(any(grepl("Betti", out))) expect_true(any(grepl("Nodes:", out))) }) test_that("print.simplicial_complex shows Betti info for K4", { mat <- .make_sc_mat() sc <- build_simplicial(mat) out <- capture.output(print(sc)) expect_true(any(grepl("Betti", out))) expect_true(any(grepl("b0=1", out))) }) test_that("print.simplicial_complex suppresses nodes for large complexes", { # 20 nodes — should not print "Nodes:" n <- 20 mat <- matrix(runif(n * n), n, n) diag(mat) <- 0 rownames(mat) <- colnames(mat) <- paste0("N", seq_len(n)) sc <- build_simplicial(mat, threshold = 0.9) out <- capture.output(print(sc)) expect_false(any(grepl("Nodes:", out))) }) test_that("print.simplicial_complex shows VR label", { mat <- .make_sc_mat() sc <- build_simplicial(mat, type = "vr", threshold = 0.3) out <- capture.output(print(sc)) expect_true(any(grepl("Vietoris-Rips", out))) }) test_that("print.simplicial_complex returns invisibly", { mat <- .make_sc_mat() sc <- build_simplicial(mat) out <- capture.output(res <- print(sc)) expect_identical(res, sc) }) test_that("print.persistent_homology works", { net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 10) out <- capture.output(print(ph)) expect_true(any(grepl("Persistent Homology", out))) expect_true(any(grepl("filtration steps", out))) }) test_that("print.persistent_homology returns invisibly", { net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 5) out <- capture.output(res <- print(ph)) expect_identical(res, ph) }) test_that("print.q_analysis works for fully connected", { mat <- .make_sc_mat() sc <- build_simplicial(mat) qa <- q_analysis(sc) out <- capture.output(print(qa)) expect_true(any(grepl("Q-Analysis", out))) expect_true(any(grepl("Fully connected", out))) expect_true(any(grepl("Structure", out))) }) test_that("print.q_analysis works for fragmented graph", { # 3 disconnected pairs + 1 triangle => fragments at some q mat <- matrix(0, 6, 6) mat[1, 2] <- mat[2, 1] <- 1 mat[3, 4] <- mat[4, 3] <- 1 mat[3, 5] <- mat[5, 3] <- 1 mat[4, 5] <- mat[5, 4] <- 1 mat[5, 6] <- mat[6, 5] <- 1 rownames(mat) <- colnames(mat) <- LETTERS[1:6] sc <- build_simplicial(mat) qa <- q_analysis(sc) out <- capture.output(print(qa)) expect_true(any(grepl("Q-Analysis", out))) # Should show fragmentation info since there are disconnected components expect_true(any(grepl("Fragments|Components", out))) }) test_that("print.q_analysis returns invisibly", { mat <- .make_sc_mat() sc <- build_simplicial(mat) qa <- q_analysis(sc) out <- capture.output(res <- print(qa)) expect_identical(res, qa) }) # ========================================================================= # plot methods # ========================================================================= test_that("plot.simplicial_complex produces grob", { skip_if_not_installed("gridExtra") mat <- .make_sc_mat() sc <- build_simplicial(mat) grb <- plot(sc) expect_true(inherits(grb, "grob") || inherits(grb, "gtable")) }) test_that("plot.persistent_homology produces grob", { skip_if_not_installed("gridExtra") net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 10) # Unicode β in labels may fail in non-UTF-8 locales grb <- tryCatch(plot(ph), error = function(e) { skip("Unicode rendering not supported in this locale") }) expect_true(inherits(grb, "grob") || inherits(grb, "gtable")) }) test_that("plot.persistent_homology handles no features", { skip_if_not_installed("gridExtra") mat <- matrix(1e-6, 3, 3) mat[1, 2] <- mat[2, 1] <- 0.01 diag(mat) <- 0 rownames(mat) <- colnames(mat) <- c("A", "B", "C") ph <- persistent_homology(mat, n_steps = 5) grb <- tryCatch(plot(ph), error = function(e) { skip("Unicode rendering not supported in this locale") }) expect_true(inherits(grb, "grob") || inherits(grb, "gtable")) }) test_that("plot.q_analysis produces grob", { skip_if_not_installed("gridExtra") mat <- .make_sc_mat() sc <- build_simplicial(mat) qa <- q_analysis(sc) grb <- plot(qa) expect_true(inherits(grb, "grob") || inherits(grb, "gtable")) }) test_that("plot.simplicial_complex errors without gridExtra", { skip_if(requireNamespace("gridExtra", quietly = TRUE), "gridExtra is installed; can't test missing") mat <- .make_sc_mat() sc <- build_simplicial(mat) expect_error(plot(sc), "gridExtra") }) test_that("plot.persistent_homology errors without gridExtra", { skip_if(requireNamespace("gridExtra", quietly = TRUE), "gridExtra is installed; can't test missing") net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 5) expect_error(plot(ph), "gridExtra") }) test_that("plot.q_analysis errors without gridExtra", { skip_if(requireNamespace("gridExtra", quietly = TRUE), "gridExtra is installed; can't test missing") mat <- .make_sc_mat() sc <- build_simplicial(mat) qa <- q_analysis(sc) expect_error(plot(qa), "gridExtra") }) # ========================================================================= # Edge cases # ========================================================================= test_that("build_simplicial on single-node matrix works", { mat <- matrix(0, 1, 1) rownames(mat) <- colnames(mat) <- "A" sc <- build_simplicial(mat) expect_equal(sc$n_nodes, 1L) expect_equal(sc$n_simplices, 1L) # just the vertex expect_equal(sc$dimension, 0L) }) test_that("build_simplicial on empty network (high threshold) works", { mat <- .make_sc_mat() sc <- build_simplicial(mat, threshold = 10) # No edges above threshold expect_equal(sc$dimension, 0L) expect_equal(sc$n_simplices, 4L) # just vertices }) test_that("betti_numbers on isolated vertices gives b0=n", { mat <- matrix(0, 5, 5) rownames(mat) <- colnames(mat) <- LETTERS[1:5] sc <- build_simplicial(mat) b <- betti_numbers(sc) expect_equal(b[["b0"]], 5L) }) test_that("persistent_homology with different max_dim works", { net <- .make_sc_net() ph <- persistent_homology(net, n_steps = 5, max_dim = 1L) expect_s3_class(ph, "persistent_homology") expect_true(all(ph$betti_curve$dimension <= 1L)) }) test_that("q_analysis on single simplex returns q_vector of 1s", { mat <- matrix(0, 2, 2) mat[1, 2] <- mat[2, 1] <- 1 rownames(mat) <- colnames(mat) <- c("A", "B") sc <- build_simplicial(mat) qa <- q_analysis(sc) expect_true(all(qa$q_vector == 1L)) }) test_that("pathway complex with no higher-order edges returns empty", { trajs <- list(c("A", "B")) hon <- build_hon(trajs, max_order = 2, min_freq = 1) sc <- build_simplicial(hon, type = "pathway") expect_s3_class(sc, "simplicial_complex") }) # ========================================================================= # Coverage: HON max_pathways limiting # ========================================================================= test_that("build_simplicial pathway HON with max_pathways truncates", { # B's next-step depends on previous state => higher-order edges trajs <- list( c("A", "B", "C", "B", "D"), c("A", "B", "C", "B", "D"), c("A", "B", "C", "B", "D"), c("A", "B", "C", "B", "D"), c("A", "B", "C", "B", "D") ) hon <- build_hon(trajs, max_order = 2, min_freq = 2) ho <- hon$edges[hon$edges$from_order > 1L, ] # Ensure we have >1 higher-order edges to test truncation expect_gt(nrow(ho), 1L) sc <- build_simplicial(hon, type = "pathway", max_pathways = 1) expect_s3_class(sc, "simplicial_complex") }) test_that("build_simplicial pathway HYPA with max_pathways truncates", { trajs <- list( c("A", "B", "C"), c("A", "B", "C"), c("A", "B", "C"), c("A", "B", "D"), c("C", "B", "D"), c("C", "B", "A"), c("D", "A", "B"), c("D", "A", "B") ) h <- build_hypa(trajs, k = 2) n_anom <- sum(h$scores$anomaly != "normal") if (n_anom > 1L) { sc <- build_simplicial(h, type = "pathway", max_pathways = 1) expect_s3_class(sc, "simplicial_complex") } else { # If only 0-1 anomalous paths, max_pathways won't truncate sc <- build_simplicial(h, type = "pathway") expect_s3_class(sc, "simplicial_complex") } }) # ========================================================================= # Coverage: boundary matrix edge case (dim 0, no k-simplices/km1-simplices) # ========================================================================= test_that("betti_numbers handles dimension gap", { # Create a complex where some intermediate dimension is empty # Single edge A-B: has 0-simplices and 1-simplex mat <- matrix(0, 3, 3) mat[1, 2] <- mat[2, 1] <- 1 rownames(mat) <- colnames(mat) <- c("A", "B", "C") sc <- build_simplicial(mat) b <- betti_numbers(sc) expect_equal(b[["b0"]], 2L) # 2 components (A-B and C) }) # ========================================================================= # Coverage: empty persistence result # ========================================================================= test_that("persistent_homology with tiny network has valid persistence", { mat <- matrix(0, 2, 2) mat[1, 2] <- mat[2, 1] <- 0.5 rownames(mat) <- colnames(mat) <- c("A", "B") ph <- persistent_homology(mat, n_steps = 5) expect_s3_class(ph, "persistent_homology") expect_true(is.data.frame(ph$persistence)) expect_true(all(c("dimension", "birth", "death", "persistence") %in% names(ph$persistence))) }) test_that("persistent_homology with uniform weights yields flat betti", { # All edges same weight => nothing changes across filtration mat <- matrix(1, 3, 3) diag(mat) <- 0 rownames(mat) <- colnames(mat) <- c("A", "B", "C") ph <- persistent_homology(mat, n_steps = 3) expect_s3_class(ph, "persistent_homology") # Persistence df may be empty or have only persistent features expect_true(is.data.frame(ph$persistence)) }) test_that("build_simplicial pathway with max_dim truncation", { # Pathway with 4+ nodes should be truncated to max_dim trajs <- list( c("A", "B", "C", "B", "D"), c("A", "B", "C", "B", "D"), c("A", "B", "C", "B", "D"), c("A", "B", "C", "B", "D"), c("A", "B", "C", "B", "D") ) hon <- build_hon(trajs, max_order = 2, min_freq = 2) sc <- build_simplicial(hon, type = "pathway", max_dim = 1L) expect_s3_class(sc, "simplicial_complex") expect_lte(sc$dimension, 1L) })