# Tests for mcml.R: aggregate_weights, cluster_summary, build_mcml # ============================================ # aggregate_weights / wagg # ============================================ test_that("aggregate_weights sum method", { expect_equal(aggregate_weights(c(0.5, 0.8, 0.3), "sum"), 1.6) }) test_that("aggregate_weights mean method", { expect_equal(aggregate_weights(c(2, 4, 6), "mean"), 4) }) test_that("aggregate_weights median method", { expect_equal(aggregate_weights(c(1, 3, 5), "median"), 3) }) test_that("aggregate_weights max method", { expect_equal(aggregate_weights(c(1, 5, 3), "max"), 5) }) test_that("aggregate_weights min method", { expect_equal(aggregate_weights(c(1, 5, 3), "min"), 1) }) test_that("aggregate_weights prod method", { expect_equal(aggregate_weights(c(2, 3, 4), "prod"), 24) }) test_that("aggregate_weights density with n_possible", { expect_equal(aggregate_weights(c(1, 2, 3), "density", n_possible = 10), 0.6) }) test_that("aggregate_weights density without n_possible", { expect_equal(aggregate_weights(c(1, 2, 3), "density"), 2) }) test_that("aggregate_weights geomean method", { expect_equal(aggregate_weights(c(4, 9), "geomean"), 6, tolerance = 0.01) }) test_that("aggregate_weights removes NA and zero", { expect_equal(aggregate_weights(c(1, NA, 0, 2), "sum"), 3) }) test_that("aggregate_weights returns 0 for empty/all-zero input", { expect_equal(aggregate_weights(c(0, 0, NA), "sum"), 0) expect_equal(aggregate_weights(numeric(0), "mean"), 0) }) test_that("aggregate_weights errors on unknown method", { expect_error(aggregate_weights(c(1, 2), "bogus"), "Unknown method") }) test_that("wagg is identical to aggregate_weights", { expect_identical(wagg, aggregate_weights) }) # ============================================ # cluster_summary # ============================================ test_that("cluster_summary with vector clusters", { mat <- matrix(c(10, 2, 3, 1, 8, 4, 5, 6, 12), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) clusters <- c(A = 1, B = 1, C = 2) cs <- cluster_summary(mat, clusters) expect_s3_class(cs, "mcml") expect_equal(nrow(cs$macro$weights), 2) expect_equal(ncol(cs$macro$weights), 2) expect_equal(cs$meta$n_clusters, 2) expect_equal(cs$meta$n_nodes, 3) }) test_that("cluster_summary with named list clusters", { mat <- matrix(runif(16), 4, 4, dimnames = list(LETTERS[1:4], LETTERS[1:4])) clusters <- list(G1 = c("A", "B"), G2 = c("C", "D")) cs <- cluster_summary(mat, clusters) expect_equal(rownames(cs$macro$weights), c("G1", "G2")) expect_equal(colnames(cs$macro$weights), c("G1", "G2")) expect_equal(length(cs$clusters), 2) expect_equal(nrow(cs$clusters$G1$weights), 2) }) test_that("cluster_summary type=tna normalizes rows to 1", { mat <- matrix(c(10, 2, 3, 1, 8, 4, 5, 6, 12), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) clusters <- list(G1 = c("A", "B"), G2 = "C") cs <- cluster_summary(mat, clusters, type = "tna") row_sums <- rowSums(cs$macro$weights) expect_equal(unname(row_sums), c(1, 1), tolerance = 1e-10) }) test_that("cluster_summary type=raw keeps raw values", { mat <- matrix(c(10, 2, 3, 8), 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) clusters <- list(G1 = "A", G2 = "B") cs <- cluster_summary(mat, clusters, type = "raw", method = "sum") expect_equal(cs$macro$weights["G1", "G1"], 10) expect_equal(cs$macro$weights["G1", "G2"], 3) }) test_that("cluster_summary compute_within=FALSE skips within", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) clusters <- list(G1 = c("A", "B"), G2 = "C") cs <- cluster_summary(mat, clusters, compute_within = FALSE) expect_null(cs$clusters) }) test_that("cluster_summary inits sum to 1", { mat <- matrix(runif(16), 4, 4, dimnames = list(LETTERS[1:4], LETTERS[1:4])) clusters <- list(G1 = c("A", "B"), G2 = c("C", "D")) cs <- cluster_summary(mat, clusters) expect_equal(sum(cs$macro$inits), 1, tolerance = 1e-10) }) test_that("cluster_summary errors without clusters", { mat <- matrix(1, 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) expect_error(cluster_summary(mat), "clusters") }) test_that("cluster_summary errors on non-square matrix", { mat <- matrix(1, 2, 3) expect_error(cluster_summary(mat, c(1, 2)), "square") }) test_that("cluster_summary print method works", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C")) expect_output(print(cs)) }) test_that("csum is identical to cluster_summary", { expect_identical(csum, cluster_summary) }) test_that("cluster_summary with different methods", { mat <- matrix(c(4, 2, 3, 1, 8, 4, 5, 6, 12), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) clusters <- list(G1 = c("A", "B"), G2 = "C") cs_sum <- cluster_summary(mat, clusters, method = "sum", type = "raw") cs_mean <- cluster_summary(mat, clusters, method = "mean", type = "raw") cs_max <- cluster_summary(mat, clusters, method = "max", type = "raw") # Sum should be larger than mean for multi-node clusters expect_true(cs_sum$macro$weights["G1", "G1"] >= cs_mean$macro$weights["G1", "G1"]) # Max should be at most sum expect_true(cs_max$macro$weights["G1", "G1"] <= cs_sum$macro$weights["G1", "G1"]) }) test_that("cluster_summary within-cluster has correct dimensions", { mat <- matrix(runif(16), 4, 4, dimnames = list(LETTERS[1:4], LETTERS[1:4])) clusters <- list(G1 = c("A", "B", "C"), G2 = "D") cs <- cluster_summary(mat, clusters) expect_equal(nrow(cs$clusters$G1$weights), 3) expect_equal(ncol(cs$clusters$G1$weights), 3) expect_equal(nrow(cs$clusters$G2$weights), 1) }) # ============================================ # build_mcml # ============================================ test_that("build_mcml with sequence data", { set.seed(42) seqs <- data.frame( T1 = sample(c("A", "B", "C", "D"), 50, replace = TRUE), T2 = sample(c("A", "B", "C", "D"), 50, replace = TRUE), T3 = sample(c("A", "B", "C", "D"), 50, replace = TRUE), T4 = sample(c("A", "B", "C", "D"), 50, replace = TRUE) ) clusters <- list(G1 = c("A", "B"), G2 = c("C", "D")) cs <- build_mcml(seqs, clusters) expect_s3_class(cs, "mcml") expect_equal(nrow(cs$macro$weights), 2) expect_equal(sum(cs$macro$inits), 1, tolerance = 1e-10) }) test_that("build_mcml with edge list", { edges <- data.frame( from = c("A", "A", "B", "C", "C", "D"), to = c("B", "C", "A", "D", "D", "A"), weight = c(1, 2, 1, 3, 1, 2) ) clusters <- list(G1 = c("A", "B"), G2 = c("C", "D")) cs <- build_mcml(edges, clusters) expect_s3_class(cs, "mcml") expect_equal(nrow(cs$macro$weights), 2) }) test_that("build_mcml type=raw preserves counts", { seqs <- data.frame( T1 = c("A", "C"), T2 = c("B", "D"), T3 = c("C", "A") ) clusters <- list(G1 = c("A", "B"), G2 = c("C", "D")) cs <- build_mcml(seqs, clusters, type = "raw") expect_true(is.numeric(cs$macro$weights)) }) test_that("build_mcml returns mcml if already mcml", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C")) cs2 <- build_mcml(cs) expect_identical(cs, cs2) }) test_that("build_mcml tna type normalizes rows", { set.seed(1) seqs <- data.frame( T1 = sample(c("A", "B", "C"), 30, replace = TRUE), T2 = sample(c("A", "B", "C"), 30, replace = TRUE), T3 = sample(c("A", "B", "C"), 30, replace = TRUE) ) clusters <- list(G1 = c("A", "B"), G2 = "C") cs <- build_mcml(seqs, clusters, type = "tna") row_sums <- rowSums(cs$macro$weights) expect_equal(unname(row_sums), c(1, 1), tolerance = 1e-10) }) # ============================================================ # Coverage gap tests — mcml.R # ============================================================ # ---- aggregate_weights / wagg: geomean zero path (L43) ---- test_that("aggregate_weights geomean returns 0 when all non-positive", { # All negative: pos_w is empty → returns 0 expect_equal(aggregate_weights(c(-1, -2, -3), "geomean"), 0) }) # ---- cluster_summary: various input types ---- test_that("cluster_summary with tna object extracts weights (L300)", { skip_if_not_installed("tna") mat <- matrix(c(0, 0.6, 0.4, 0.7, 0, 0.3, 0.5, 0.5, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) tna_obj <- tna::tna(mat) cs <- cluster_summary(tna_obj, list(G1 = c("A", "B"), G2 = "C")) expect_s3_class(cs, "mcml") expect_equal(nrow(cs$macro$weights), 2) }) test_that("cluster_summary assigns sequential node names when matrix has no rownames (L313-315)", { mat <- matrix(c(0, 2, 3, 1, 0, 4, 5, 6, 0), 3, 3) # No rownames/colnames cs <- cluster_summary(mat, list(G1 = c("1", "2"), G2 = "3")) expect_s3_class(cs, "mcml") expect_equal(cs$meta$n_nodes, 3) }) test_that("cluster_summary between_inits fallback when zero matrix (L380)", { # All-zero matrix → colSums all zero → uniform inits mat <- matrix(0, 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) cs <- cluster_summary(mat, list(G1 = "A", G2 = "B"), type = "raw") expect_equal(unname(cs$macro$inits), c(0.5, 0.5), tolerance = 1e-10) }) test_that("cluster_summary within-cluster zero total produces uniform inits (L423)", { # All-zero within-cluster block mat <- matrix(0, 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C"), type = "raw") # G1 has 2 nodes, zero total → rep(0.5, 2) expect_equal(unname(cs$clusters$G1$inits), c(0.5, 0.5), tolerance = 1e-10) }) test_that("cluster_summary type=cooccurrence symmetrizes (L326,L334)", { mat <- matrix(c(0, 3, 1, 5, 0, 2, 4, 6, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C"), type = "cooccurrence", compute_within = FALSE) # Symmetrized: should be symmetric expect_true(isSymmetric(cs$macro$weights)) }) # ---- build_mcml: cograph_network input (L572) ---- test_that("build_mcml accepts cograph_network input (L572)", { mat <- matrix(c(0, 0.3, 0.7, 0.4, 0, 0.6, 0.5, 0.5, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) # Create a minimal cograph_network object net <- structure( list( weights = mat, nodes = data.frame(id = 1:3, label = c("A", "B", "C"), name = c("A", "B", "C"), x = NA_real_, y = NA_real_, stringsAsFactors = FALSE), edges = data.frame(from = integer(0), to = integer(0), weight = numeric(0)), directed = TRUE, data = NULL, meta = list(), node_groups = NULL ), class = c("cograph_network", "list") ) cs <- build_mcml(net, list(G1 = c("A", "B"), G2 = "C")) expect_s3_class(cs, "mcml") }) # ---- build_mcml: tna_data branch (L581-598) ---- test_that("build_mcml handles tna object with data (tna_data branch, L581-598)", { skip_if_not_installed("tna") seqs <- data.frame( T1 = c("A", "B", "C"), T2 = c("B", "C", "A"), T3 = c("C", "A", "B") ) # Build a tna object that contains $data (integer-encoded: 1=A, 2=B, 3=C) tna_obj <- tna::tna(seqs) if (!is.null(tna_obj$data)) { # tna encodes states as integers 1,2,3 in $data cs <- build_mcml(tna_obj, list(G1 = c("1", "2"), G2 = "3")) expect_s3_class(cs, "mcml") } else { skip("tna object has no $data field in this version") } }) test_that("build_mcml handles tna object without data (tna_matrix branch, L583-585)", { skip_if_not_installed("tna") mat <- matrix(c(0, 0.6, 0.4, 0.7, 0, 0.3, 0.5, 0.5, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) tna_obj <- tna::tna(mat) cs <- build_mcml(tna_obj, list(G1 = c("A", "B"), G2 = "C")) expect_s3_class(cs, "mcml") expect_equal(nrow(cs$macro$weights), 2) }) # ---- build_mcml: netobject_data branch (L586-599) ---- test_that("build_mcml handles netobject with sequence data (netobject_data branch, L586-599)", { set.seed(1) seqs <- data.frame( T1 = sample(c("A", "B", "C"), 20, replace = TRUE), T2 = sample(c("A", "B", "C"), 20, replace = TRUE), T3 = sample(c("A", "B", "C"), 20, replace = TRUE) ) net <- build_network(seqs, method = "relative") # net$data contains the raw sequences cs <- build_mcml(net, list(G1 = c("A", "B"), G2 = "C")) expect_s3_class(cs, "mcml") }) test_that("build_mcml handles netobject with edge list data (netobject_data edgelist, L593-595)", { edges <- data.frame( from = c("A", "A", "B", "C"), to = c("B", "C", "A", "A"), stringsAsFactors = FALSE ) net <- build_network(edges, method = "relative") # If net has $data, it should route through netobject_data if (!is.null(net$data)) { cs <- build_mcml(net, list(G1 = c("A", "B"), G2 = "C")) expect_s3_class(cs, "mcml") } else { # Falls to netobject_matrix branch — still valid test cs <- build_mcml(net, list(G1 = c("A", "B"), G2 = "C")) expect_s3_class(cs, "mcml") } }) # ---- build_mcml: netobject_matrix branch (L601-607) ---- test_that("build_mcml handles netobject without data (netobject_matrix branch, L601-607)", { mat <- matrix(c(0, 0.4, 0.6, 0.3, 0, 0.7, 0.5, 0.5, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) net <- structure( list( weights = mat, nodes = data.frame(id = 1:3, label = c("A", "B", "C"), name = c("A", "B", "C"), x = NA_real_, y = NA_real_, stringsAsFactors = FALSE), edges = data.frame(from = integer(0), to = integer(0), weight = numeric(0)), directed = TRUE, data = NULL, meta = list(), node_groups = NULL ), class = c("netobject", "cograph_network") ) cs <- build_mcml(net, list(G1 = c("A", "B"), G2 = "C")) expect_s3_class(cs, "mcml") }) test_that("build_mcml handles plain numeric matrix (matrix branch, L608-610)", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- build_mcml(mat, list(G1 = c("A", "B"), G2 = "C")) expect_s3_class(cs, "mcml") }) test_that("build_mcml errors on unknown input class (L611-612)", { expect_error(build_mcml(list(foo = 1), list(G1 = "A")), "Cannot build MCML") }) # ---- .detect_mcml_input coverage (L620-644) ---- test_that(".detect_mcml_input returns tna_data for tna with data (L620)", { skip_if_not_installed("tna") seqs <- data.frame(T1 = c("A", "B"), T2 = c("B", "A")) tna_obj <- tna::tna(seqs) if (!is.null(tna_obj$data)) { result <- Nestimate:::.detect_mcml_input(tna_obj) expect_equal(result, "tna_data") } else { skip("tna object has no $data in this version") } }) test_that(".detect_mcml_input returns tna_matrix for tna without data (L621)", { skip_if_not_installed("tna") mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.6, 0.4, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) tna_obj <- tna::tna(mat) result <- Nestimate:::.detect_mcml_input(tna_obj) expect_equal(result, "tna_matrix") }) test_that(".detect_mcml_input returns netobject_data for netobject with data (L625)", { seqs <- data.frame(T1 = c("A", "B"), T2 = c("B", "A")) net <- build_network(seqs, method = "relative") if (!is.null(net$data)) { result <- Nestimate:::.detect_mcml_input(net) expect_equal(result, "netobject_data") } else { skip("netobject has no $data in this configuration") } }) test_that(".detect_mcml_input returns netobject_matrix for netobject without data (L626)", { mat <- matrix(c(0, 0.4, 0.6, 0.7, 0, 0.3, 0.5, 0.5, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) net <- structure( list(weights = mat, nodes = data.frame(id = 1:3, label = c("A", "B", "C"), name = c("A", "B", "C"), x = NA_real_, y = NA_real_, stringsAsFactors = FALSE), edges = data.frame(from = integer(0), to = integer(0), weight = numeric(0)), directed = TRUE, data = NULL, meta = list(), node_groups = NULL), class = c("netobject", "cograph_network") ) result <- Nestimate:::.detect_mcml_input(net) expect_equal(result, "netobject_matrix") }) test_that(".detect_mcml_input returns sequence for non-square numeric matrix (L641)", { mat <- matrix(1:6, 2, 3) result <- Nestimate:::.detect_mcml_input(mat) expect_equal(result, "sequence") }) test_that(".detect_mcml_input returns unknown for unrecognized class (L644)", { result <- Nestimate:::.detect_mcml_input(42L) expect_equal(result, "unknown") }) # ---- .auto_detect_clusters coverage (L650-672) ---- test_that(".auto_detect_clusters finds cluster from nodes$cluster column (L650-656)", { mat <- matrix(0, 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) net <- structure( list( weights = mat, nodes = data.frame(id = 1:3, label = c("A", "B", "C"), name = c("A", "B", "C"), x = NA_real_, y = NA_real_, cluster = c("G1", "G1", "G2"), stringsAsFactors = FALSE), data = NULL, node_groups = NULL ), class = c("netobject", "cograph_network") ) result <- Nestimate:::.auto_detect_clusters(net) expect_equal(unname(result), c("G1", "G1", "G2")) }) test_that(".auto_detect_clusters falls back to node_groups (L660-664)", { mat <- matrix(0, 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) net <- structure( list( weights = mat, nodes = data.frame(id = 1:3, label = c("A", "B", "C"), name = c("A", "B", "C"), x = NA_real_, y = NA_real_, stringsAsFactors = FALSE), data = NULL, node_groups = data.frame(cluster = c("G1", "G1", "G2"), stringsAsFactors = FALSE) ), class = c("netobject", "cograph_network") ) result <- Nestimate:::.auto_detect_clusters(net) expect_equal(unname(result), c("G1", "G1", "G2")) }) test_that(".auto_detect_clusters errors when no cluster info found (L667-671)", { mat <- matrix(0, 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) net <- structure( list( weights = mat, nodes = data.frame(id = 1:2, label = c("A", "B"), stringsAsFactors = FALSE), data = NULL, node_groups = NULL ), class = c("netobject", "cograph_network") ) expect_error(Nestimate:::.auto_detect_clusters(net), "No clusters found") }) # ---- .build_cluster_lookup coverage (L696-725) ---- test_that(".build_cluster_lookup errors on unmapped nodes (L696-698)", { cl <- list(G1 = c("A", "B")) # all_nodes includes C, which is not in G1 expect_error( Nestimate:::.build_cluster_lookup(cl, c("A", "B", "C")), "Unmapped nodes" ) }) test_that(".build_cluster_lookup works with character membership vector (L703-711)", { all_nodes <- c("A", "B", "C") result <- Nestimate:::.build_cluster_lookup(c("G1", "G1", "G2"), all_nodes) expect_equal(unname(result), c("G1", "G1", "G2")) expect_equal(names(result), c("A", "B", "C")) }) test_that(".build_cluster_lookup errors when char vector length mismatches (L705-708)", { expect_error( Nestimate:::.build_cluster_lookup(c("G1", "G1"), c("A", "B", "C")), "Membership vector length" ) }) test_that(".build_cluster_lookup works with numeric membership vector (L714-721)", { all_nodes <- c("X", "Y", "Z") result <- Nestimate:::.build_cluster_lookup(c(1, 1, 2), all_nodes) expect_equal(unname(result), c("1", "1", "2")) expect_equal(names(result), c("X", "Y", "Z")) }) test_that(".build_cluster_lookup errors when numeric vector length mismatches (L715-718)", { expect_error( Nestimate:::.build_cluster_lookup(c(1, 2), c("A", "B", "C")), "Membership vector length" ) }) test_that(".build_cluster_lookup errors on invalid input type (L724-725)", { expect_error( Nestimate:::.build_cluster_lookup(TRUE, c("A", "B")), "clusters must be a named list" ) }) # ---- .build_from_transitions: density method and zero-inits paths ---- test_that("build_mcml with density method triggers n_possible computation (L761-764)", { seqs <- data.frame( T1 = c("A", "C", "B"), T2 = c("B", "D", "C"), T3 = c("C", "A", "D") ) clusters <- list(G1 = c("A", "B"), G2 = c("C", "D")) cs <- build_mcml(seqs, clusters, method = "density", type = "raw") expect_s3_class(cs, "mcml") expect_equal(nrow(cs$macro$weights), 2) }) test_that("build_mcml zero transitions produce uniform between_inits (L784)", { # Create edge list that has no transitions between G2 -> G1 or G2 -> G2 # Force all edges in G1 to make G2 isolated edges <- data.frame( from = c("A", "B"), to = c("B", "A"), stringsAsFactors = FALSE ) # G2 has node "C" but no transitions at all → zero col sums for G2 # Actually need G2 to have zero total in cluster # Simpler: all transitions are G1 internal, G2 isolated clusters <- list(G1 = c("A", "B"), G2 = "C") # Since "C" never appears in edges, it won't appear in all_nodes # Let's add a C transition explicitly edges2 <- data.frame( from = c("A", "B", "C"), to = c("B", "A", "C"), stringsAsFactors = FALSE ) cs <- build_mcml(edges2, clusters, type = "raw") expect_s3_class(cs, "mcml") }) # ---- Single-node within-cluster (L839-847) ---- test_that("build_mcml single-node cluster computes self-loop weight (L839-847)", { # Cluster G2 has only 1 node "C" seqs <- data.frame( T1 = c("A", "C"), T2 = c("B", "C"), T3 = c("C", "A") ) clusters <- list(G1 = c("A", "B"), G2 = "C") cs <- build_mcml(seqs, clusters, type = "raw") expect_s3_class(cs, "mcml") # G2 is a 1x1 within matrix expect_equal(dim(cs$clusters$G2$weights), c(1, 1)) expect_equal(unname(cs$clusters$G2$inits), 1) }) test_that("build_mcml single-node cluster with no self-loops returns 0 weight (L843-844)", { edges <- data.frame( from = c("A", "B"), to = c("B", "A"), stringsAsFactors = FALSE ) # G2 node "C" has no edges at all — single node, no self-loops # Add C to appear in nodes but never in edges: need it in seqs seqs <- data.frame( T1 = c("A", "C"), T2 = c("B", "A"), stringsAsFactors = FALSE ) clusters <- list(G1 = c("A", "B"), G2 = "C") cs <- build_mcml(seqs, clusters, type = "raw") # C appears once but only in T1 position, no C->C transition expect_equal(unname(cs$clusters$G2$inits), 1) }) # ---- .build_mcml_edgelist: fallback column detection (L945, L949) ---- test_that(".build_mcml_edgelist falls back to first/second columns when no named from/to (L945,L949)", { # Column names not in the standard from/to list — call .build_mcml_edgelist directly edges <- data.frame( node_from = c("A", "B", "C"), node_to = c("B", "C", "A"), stringsAsFactors = FALSE ) # Neither 'node_from' nor 'node_to' match standard aliases # so from_col and to_col fall back to 1 and 2 respectively clusters <- list(G1 = c("A", "B"), G2 = "C") cs <- Nestimate:::.build_mcml_edgelist(edges, clusters, "sum", "tna", TRUE, TRUE) expect_s3_class(cs, "mcml") }) # ---- Column-name clusters branch in edgelist (L971-989) ---- test_that("build_mcml edgelist accepts cluster column name (L971-989)", { edges <- data.frame( from = c("A", "A", "B", "C", "C", "D"), to = c("B", "C", "A", "D", "D", "A"), group = c("G1", "G1", "G1", "G2", "G2", "G2"), stringsAsFactors = FALSE ) cs <- build_mcml(edges, clusters = "group") expect_s3_class(cs, "mcml") expect_equal(nrow(cs$macro$weights), 2) }) test_that("build_mcml edgelist errors when clusters=NULL (L992-993)", { edges <- data.frame( from = c("A", "B"), to = c("B", "A"), stringsAsFactors = FALSE ) expect_error(build_mcml(edges, clusters = NULL), "clusters argument is required") }) test_that("build_mcml edgelist accepts membership vector clusters (L1000)", { edges <- data.frame( from = c("A", "B", "C"), to = c("B", "C", "A"), stringsAsFactors = FALSE ) # character membership vector for the 3 unique sorted nodes (A, B, C) clusters <- c("G1", "G1", "G2") cs <- build_mcml(edges, clusters) expect_s3_class(cs, "mcml") }) # ---- .build_mcml_sequence: matrix input, single column error, null clusters (L1017-1044) ---- test_that("build_mcml sequence builder coerces matrix input (L1017)", { mat_seq <- matrix(c("A", "B", "C", "B", "C", "A"), nrow = 3, dimnames = list(NULL, c("T1", "T2"))) clusters <- list(G1 = c("A", "B"), G2 = "C") cs <- build_mcml(mat_seq, clusters) expect_s3_class(cs, "mcml") }) test_that(".build_mcml_sequence errors on single-column data (L1023-1024)", { df <- data.frame(T1 = c("A", "B", "C"), stringsAsFactors = FALSE) clusters <- list(G1 = c("A", "B"), G2 = "C") expect_error( Nestimate:::.build_mcml_sequence(df, clusters, "sum", "tna", TRUE, TRUE), "at least 2 columns" ) }) test_that(".build_mcml_sequence errors when clusters=NULL (L1043-1044)", { df <- data.frame(T1 = c("A", "B"), T2 = c("B", "A"), stringsAsFactors = FALSE) expect_error( Nestimate:::.build_mcml_sequence(df, NULL, "sum", "tna", TRUE, TRUE), "clusters argument is required" ) }) test_that(".build_mcml_sequence calls .normalize_clusters for non-list clusters (L1050)", { df <- data.frame(T1 = c("A", "B"), T2 = c("B", "A"), stringsAsFactors = FALSE) # Pass a character membership vector (triggers .normalize_clusters path) clusters <- c("G1", "G2") # 2 nodes: A, B cs <- Nestimate:::.build_mcml_sequence(df, clusters, "sum", "tna", TRUE, TRUE) expect_s3_class(cs, "mcml") }) # ---- .process_weights: cooccurrence type (L1070) ---- test_that(".process_weights returns symmetrized matrix for cooccurrence type (L1070)", { raw <- matrix(c(1, 3, 2, 4), 2, 2, dimnames = list(c("A", "B"), c("A", "B"))) result <- Nestimate:::.process_weights(raw, "cooccurrence") expect_true(isSymmetric(result)) expect_equal(result["A", "B"], 2.5) }) # ---- as_tna generic dispatch and methods (L1226-1306) ---- test_that("as_tna dispatches correctly for mcml objects (L1226)", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C"), type = "tna") result <- as_tna(cs) expect_s3_class(result, "netobject_group") }) test_that("as_tna.mcml with raw type uses frequency method (L1234-1240)", { mat <- matrix(c(10, 2, 3, 1, 8, 4, 5, 6, 12), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C"), type = "raw") result <- as_tna(cs) expect_s3_class(result, "netobject_group") # macro network should use frequency method expect_equal(result$macro$method, "frequency") }) test_that("as_tna.mcml creates macro netobject (L1243-1244)", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C"), type = "tna") result <- as_tna(cs) expect_s3_class(result$macro, "netobject") expect_true(is.matrix(result$macro$weights)) }) test_that("as_tna.mcml skips clusters with zero-row sums (L1247-1262)", { # Cluster with all-zero rows will be excluded mat <- matrix(0, 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) mat["A", "B"] <- 0.5; mat["A", "C"] <- 0.5 # only A has outgoing cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C"), type = "tna") result <- as_tna(cs) expect_s3_class(result, "netobject_group") # macro always present expect_true("macro" %in% names(result)) }) test_that("as_tna.mcml with compute_within=FALSE returns empty cluster list (L1256-1258)", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C"), type = "tna", compute_within = FALSE) result <- as_tna(cs) expect_s3_class(result, "netobject_group") expect_true("macro" %in% names(result)) }) test_that(".wrap_netobject produces valid dual-class object (L1270-1296)", { mat <- matrix(c(0, 0.6, 0.4, 0.3, 0, 0.7, 0.5, 0.5, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) result <- Nestimate:::.wrap_netobject(mat, method = "relative", directed = TRUE) expect_s3_class(result, "netobject") expect_true(inherits(result, "cograph_network")) expect_equal(result$method, "relative") expect_equal(result$n_nodes, 3) expect_true(is.data.frame(result$nodes)) expect_equal(result$nodes$label, c("A", "B", "C")) }) test_that("as_tna.default returns tna object unchanged (L1303-1305)", { skip_if_not_installed("tna") mat <- matrix(c(0, 0.5, 0.5, 0.3, 0, 0.7, 0.6, 0.4, 0), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) tna_obj <- tna::tna(mat) result <- as_tna(tna_obj) expect_true(inherits(result, "tna")) }) test_that("as_tna.default errors for non-tna objects (L1305-1306)", { expect_error(as_tna(list(a = 1)), "Cannot convert") expect_error(as_tna("some string"), "Cannot convert") }) # ---- .normalize_clusters coverage (L1312-1362) ---- test_that(".normalize_clusters handles data.frame input (L1313-1318)", { node_names <- c("A", "B", "C", "D") clusters_df <- data.frame( node = c("A", "B", "C", "D"), group = c("G1", "G1", "G2", "G2"), stringsAsFactors = FALSE ) result <- Nestimate:::.normalize_clusters(clusters_df, node_names) expect_true(is.list(result)) expect_equal(sort(names(result)), c("G1", "G2")) }) test_that(".normalize_clusters errors on unknown nodes in list (L1325-1327)", { node_names <- c("A", "B") # C is not in node_names expect_error( Nestimate:::.normalize_clusters(list(G1 = c("A", "C")), node_names), "Unknown nodes" ) }) test_that(".normalize_clusters errors on numeric vector wrong length (L1335-1337)", { node_names <- c("A", "B", "C") expect_error( Nestimate:::.normalize_clusters(c(1, 2), node_names), "Membership vector length" ) }) test_that(".normalize_clusters handles factor cluster membership (L1348-1359)", { node_names <- c("A", "B", "C") clusters_fac <- factor(c("G1", "G1", "G2")) result <- Nestimate:::.normalize_clusters(clusters_fac, node_names) expect_true(is.list(result)) expect_equal(sort(names(result)), c("G1", "G2")) expect_true("A" %in% result$G1) }) test_that(".normalize_clusters handles character cluster membership (L1348-1359)", { node_names <- c("A", "B", "C") result <- Nestimate:::.normalize_clusters(c("G1", "G1", "G2"), node_names) expect_true(is.list(result)) expect_equal(length(result), 2) }) test_that(".normalize_clusters errors on character vector wrong length (L1350-1351)", { node_names <- c("A", "B", "C") expect_error( Nestimate:::.normalize_clusters(c("G1", "G2"), node_names), "Membership vector length" ) }) test_that(".normalize_clusters errors on invalid input type (L1362)", { expect_error( Nestimate:::.normalize_clusters(TRUE, c("A", "B")), "clusters must be a list" ) }) # ---- print.mcml with edges field (L1381-1384) ---- test_that("print.mcml shows Transitions line when edges present (L1381-1384)", { seqs <- data.frame( T1 = c("A", "B", "C"), T2 = c("B", "C", "A"), T3 = c("C", "A", "B") ) clusters <- list(G1 = c("A", "B"), G2 = "C") cs <- build_mcml(seqs, clusters) # build_mcml produces $edges — print should show Transitions line output <- capture.output(print(cs)) expect_true(any(grepl("Transitions", output))) }) test_that("print.mcml without edges shows no Transitions line (L1385-1386)", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C")) # cluster_summary does not set $edges output <- capture.output(print(cs)) expect_true(any(grepl("MCML Network", output))) }) # ---- summary.mcml (L1404) ---- test_that("summary.mcml runs and produces output (L1404)", { mat <- matrix(runif(9), 3, 3, dimnames = list(c("A", "B", "C"), c("A", "B", "C"))) cs <- cluster_summary(mat, list(G1 = c("A", "B"), G2 = "C")) expect_output(summary(cs), "MCML") }) test_that("summary.mcml on build_mcml result also works (L1404)", { seqs <- data.frame( T1 = c("A", "B"), T2 = c("B", "A"), T3 = c("A", "B") ) cs <- build_mcml(seqs, list(G1 = "A", G2 = "B")) expect_output(summary(cs)) })