tests/testthat/test-coverage-cluster-metrics-41.R

In cograph: Analysis and Visualization of Complex Networks

# Comprehensive coverage tests for cluster-metrics.R
# Focus on uncovered code paths from test-coverage-cluster-metrics-40.R

# ==============================================================================
# Setup Test Data
# ==============================================================================

skip_on_cran()

set.seed(456)

# Standard 8-node test matrix
n <- 8
mat8 <- matrix(runif(n * n, 0.1, 1), n, n)
diag(mat8) <- 0
rownames(mat8) <- colnames(mat8) <- paste0("N", 1:n)

# Large matrix for truncation testing (10 nodes)
large_mat <- matrix(runif(100, 0.1, 1), 10, 10)
diag(large_mat) <- 0
rownames(large_mat) <- colnames(large_mat) <- LETTERS[1:10]

# Clusters as list
clusters_list <- list(
  "Group1" = c("N1", "N2"),
  "Group2" = c("N3", "N4", "N5"),
  "Group3" = c("N6", "N7", "N8")
)

# ==============================================================================
# 1. cluster_summary: cograph_network with node_groups cluster detection
# ==============================================================================

test_that("cluster_summary detects clusters from node_groups", {
  # Create a cograph_network with node_groups containing cluster column
  net <- as_cograph(mat8)

  # Add node_groups with 'cluster' column
  net$node_groups <- data.frame(
    name = paste0("N", 1:8),
    cluster = c(1, 1, 2, 2, 2, 3, 3, 3)
  )

  # Remove any clusters from nodes to force node_groups lookup
  net$nodes$clusters <- NULL
  net$nodes$cluster <- NULL
  net$nodes$groups <- NULL
  net$nodes$group <- NULL

  result <- cluster_summary(net)

  expect_s3_class(result, "cluster_summary")
  expect_equal(result$meta$n_clusters, 3)
})

test_that("cluster_summary detects clusters from node_groups with 'group' column", {
  net <- as_cograph(mat8)

  # Add node_groups with 'group' column
  net$node_groups <- data.frame(
    name = paste0("N", 1:8),
    group = c("A", "A", "B", "B", "B", "C", "C", "C")
  )

  # Remove clusters from nodes
  net$nodes$clusters <- NULL
  net$nodes$cluster <- NULL
  net$nodes$groups <- NULL
  net$nodes$group <- NULL

  result <- cluster_summary(net)

  expect_s3_class(result, "cluster_summary")
})

test_that("cluster_summary detects clusters from node_groups with 'layer' column", {
  net <- as_cograph(mat8)

  # Add node_groups with 'layer' column
  net$node_groups <- data.frame(
    name = paste0("N", 1:8),
    layer = c(1, 1, 1, 2, 2, 2, 3, 3)
  )

  # Remove clusters from nodes
  net$nodes$clusters <- NULL
  net$nodes$cluster <- NULL
  net$nodes$groups <- NULL
  net$nodes$group <- NULL

  result <- cluster_summary(net)

  expect_s3_class(result, "cluster_summary")
})

test_that("cluster_summary errors when no clusters found in cograph_network", {
  net <- as_cograph(mat8)

  # Remove all cluster-related columns
  net$nodes$clusters <- NULL
  net$nodes$cluster <- NULL
  net$nodes$groups <- NULL
  net$nodes$group <- NULL
  net$node_groups <- NULL

  expect_error(
    cluster_summary(net),
    "No clusters found"
  )
})

test_that("cluster_summary works with tna object input", {
  skip_if_not_installed("tna")

  # Create a mock tna object
  tna_obj <- structure(
    list(
      weights = mat8,
      inits = rep(1 / 8, 8),
      labels = paste0("N", 1:8)
    ),
    class = "tna"
  )

  result <- cluster_summary(tna_obj, clusters_list, type = "raw")

  expect_s3_class(result, "cluster_summary")
  expect_equal(result$meta$n_nodes, 8)
})

test_that("cluster_summary returns cluster_summary unchanged if already cluster_summary", {
  # Create a cluster_summary first
  cs <- cluster_summary(mat8, clusters_list)

  # Pass it back to cluster_summary
  result <- cluster_summary(cs)

  expect_identical(result, cs)
})

# ==============================================================================
# 2. .process_weights: default branch (line 517)
# ==============================================================================

test_that(".process_weights returns unchanged for unknown type", {
  # The default branch is unreachable via public API due to match.arg
  # but we can call the internal function directly
  raw <- matrix(runif(9), 3, 3)

  # Test the covered types first
  result_raw <- cograph:::.process_weights(raw, "raw", TRUE)
  expect_equal(result_raw, raw)

  result_tna <- cograph:::.process_weights(raw, "tna", TRUE)
  row_sums <- rowSums(result_tna)
  expect_true(all(abs(row_sums - 1) < 1e-10 | row_sums == 0))

  result_cooc <- cograph:::.process_weights(raw, "cooccurrence", TRUE)
  expect_equal(result_cooc, t(result_cooc))

  result_semi <- cograph:::.process_weights(raw, "semi_markov", TRUE)
  row_sums_semi <- rowSums(result_semi)
  expect_true(all(abs(row_sums_semi - 1) < 1e-10 | row_sums_semi == 0))
})

# ==============================================================================
# 3. as_tna: tna package check and zero-row exclusion
# ==============================================================================

test_that("as_tna.cluster_summary handles zero-row exclusion", {
  skip_if_not_installed("tna")

  # Create a matrix where within-cluster has zero rows
  sparse_mat <- mat8
  sparse_mat[1:2, 1:2] <- 0  # Group1 has no internal edges

  cs <- cluster_summary(sparse_mat, clusters_list, type = "tna")
  tna_obj <- as_tna(cs)

  expect_s3_class(tna_obj, "group_tna")
  # Group1 has single node behavior (zero rows) - may or may not be excluded
  expect_s3_class(tna_obj$macro, "tna")
})

test_that("as_tna.cluster_summary excludes clusters with zero rowSums", {
  skip_if_not_installed("tna")

  # Create a matrix where within-clusters have some zero rows
  # but between-clusters is valid (all rows have positive values)
  test_mat <- matrix(0.1, 6, 6)
  diag(test_mat) <- 0
  # Make within-cluster A have zero rows
  test_mat[1, 2] <- 0
  test_mat[2, 1] <- 0
  rownames(test_mat) <- colnames(test_mat) <- paste0("N", 1:6)

  clusters <- list(
    A = c("N1", "N2"),
    B = c("N3", "N4"),
    C = c("N5", "N6")
  )

  cs <- cluster_summary(test_mat, clusters, type = "tna")
  tna_obj <- as_tna(cs)

  expect_s3_class(tna_obj, "group_tna")
  # Some clusters may be excluded due to zero rows
  expect_s3_class(tna_obj$macro, "tna")
})

# ==============================================================================
# 4. print.cluster_tna: entire print method
# ==============================================================================

test_that("print.group_tna works with valid group_tna object from as_tna", {
  skip_if_not_installed("tna")

  cs <- cluster_summary(mat8, clusters_list, type = "tna")
  tna_obj <- as_tna(cs)

  expect_output(print(tna_obj), "macro")
})

test_that("print.group_tna handles group_tna with only macro", {
  skip_if_not_installed("tna")

  # Create a proper group_tna with only macro element
  w <- matrix(runif(9), 3, 3)
  diag(w) <- 0
  w <- w / rowSums(w)
  rownames(w) <- colnames(w) <- c("A", "B", "C")
  mock_tna <- structure(
    list(macro = tna::tna(w, inits = c(A = 0.33, B = 0.33, C = 0.34))),
    class = "group_tna"
  )

  expect_output(print(mock_tna), "macro")
})

# ==============================================================================
# 5. .normalize_clusters: additional error cases
# ==============================================================================

test_that(".normalize_clusters validates list nodes exist in node_names", {
  node_names <- paste0("N", 1:5)
  bad_clusters <- list(
    A = c("N1", "N2"),
    B = c("N3", "MISSING_NODE", "ANOTHER_MISSING")
  )

  expect_error(
    cograph:::.normalize_clusters(bad_clusters, node_names),
    "Unknown nodes"
  )
})

test_that(".normalize_clusters handles integer vector (not just numeric)", {
  node_names <- paste0("N", 1:5)
  int_clusters <- as.integer(c(1L, 1L, 2L, 2L, 3L))

  result <- cograph:::.normalize_clusters(int_clusters, node_names)

  expect_type(result, "list")
  expect_equal(length(result), 3)
})

test_that(".normalize_clusters errors on wrong length character vector", {
  node_names <- paste0("N", 1:5)
  wrong_char <- c("A", "A", "B")  # Wrong length

  expect_error(
    cograph:::.normalize_clusters(wrong_char, node_names),
    "must equal number of nodes"
  )
})

# ==============================================================================
# 6. cluster_quality: empty cluster handling (lines 844-854)
# ==============================================================================

test_that("cluster_quality handles empty cluster (n_S = 0)", {
  # This is tricky since empty clusters aren't common
  # But we can test with very sparse data
  sparse_mat <- matrix(0, 5, 5)
  rownames(sparse_mat) <- colnames(sparse_mat) <- paste0("N", 1:5)

  clusters <- list(
    A = c("N1", "N2"),
    B = c("N3", "N4", "N5")
  )

  result <- cluster_quality(sparse_mat, clusters)

  expect_s3_class(result, "cluster_quality")
  expect_equal(nrow(result$per_cluster), 2)
})

# ==============================================================================
# 7. cluster_significance: fallback error handling
# ==============================================================================

test_that("cluster_significance handles igraph membership vector", {
  skip_if_not_installed("igraph")

  g <- igraph::make_graph("Zachary")

  # Use integer membership vector directly (not communities object)
  mem_vec <- rep(1:4, each = ceiling(igraph::vcount(g) / 4))[1:igraph::vcount(g)]

  result <- cluster_significance(g, mem_vec, n_random = 5, seed = 42)

  expect_s3_class(result, "cograph_cluster_significance")
})

test_that("cluster_significance handles general object via to_igraph", {

  skip_if_not_installed("igraph")

  # Create a cograph_network
  net <- as_cograph(mat8)
  mem <- c(1, 1, 1, 1, 2, 2, 2, 2)

  result <- cluster_significance(net, mem, n_random = 5, seed = 42)

  expect_s3_class(result, "cograph_cluster_significance")
})

# ==============================================================================
# 8. supra_adjacency: custom coupling with valid index pair
# ==============================================================================

test_that("supra_adjacency custom coupling uses correct interlayer matrix", {
  # For 2 layers, we need 1 interlayer matrix
  layers <- list(L1 = mat8, L2 = mat8 * 2)
  custom_inter_12 <- diag(8) * 0.3

  result <- supra_adjacency(
    layers,
    omega = 1,
    coupling = "custom",
    interlayer_matrices = list(custom_inter_12)
  )

  expect_s3_class(result, "supra_adjacency")

  # Check that the custom interlayer was used
  interlayer <- supra_interlayer(result, 1, 2)
  expect_equal(diag(interlayer), rep(0.3, 8))
})

# ==============================================================================
# 9. verify_with_igraph: igraph not installed case
# ==============================================================================

test_that("verify_with_igraph returns NULL message without igraph", {
  # We can't truly test without igraph if it's installed
  # But we can at least cover the basic path
  skip_if_not_installed("igraph")

  result <- verify_with_igraph(mat8, clusters_list, method = "sum")

  expect_type(result, "list")
  expect_true("matches" %in% names(result))
})

# ==============================================================================
# 10. print.cluster_summary: large matrix truncation
# ==============================================================================

test_that("print.cluster_summary truncates large between-cluster matrix", {
  # Create a large cluster summary with > 6 clusters
  large_clusters <- lapply(1:8, function(i) {
    LETTERS[i]
  })
  names(large_clusters) <- paste0("Cluster", 1:8)

  cs <- cluster_summary(large_mat,
                        clusters = c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5),
                        type = "raw")

  # Should print showing truncation message
  expect_output(print(cs), "Cluster Summary")
})

test_that("print.cluster_summary handles many within clusters", {
  # 5 clusters to test "... and X more clusters" message
  clusters_5 <- list(
    C1 = c("A", "B"),
    C2 = c("C", "D"),
    C3 = c("E", "F"),
    C4 = c("G", "H"),
    C5 = c("I", "J")
  )

  cs <- cluster_summary(large_mat, clusters_5)

  expect_output(print(cs), "more clusters")
})

# ==============================================================================
# 11. summarize_network: comprehensive testing
# ==============================================================================

test_that("summarize_network works with matrix input and cluster list", {
  clusters <- list(
    Group1 = c("N1", "N2"),
    Group2 = c("N3", "N4", "N5"),
    Group3 = c("N6", "N7", "N8")
  )

  result <- summarize_network(mat8, clusters, method = "sum")

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 3)
  expect_true("size" %in% names(result$nodes))
})

test_that("summarize_network works with cograph_network input", {
  net <- as_cograph(mat8)
  net$nodes$clusters <- c(1, 1, 2, 2, 2, 3, 3, 3)

  result <- summarize_network(net)

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 3)
})

test_that("summarize_network works with cograph_network and column name", {
  net <- as_cograph(mat8)
  net$nodes$my_groups <- c("A", "A", "B", "B", "B", "C", "C", "C")

  result <- summarize_network(net, cluster_list = "my_groups")

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 3)
})

test_that("summarize_network errors on invalid column name", {
  net <- as_cograph(mat8)
  net$nodes$clusters <- c(1, 1, 2, 2, 2, 3, 3, 3)

  expect_error(
    summarize_network(net, cluster_list = "nonexistent_column"),
    "not found in nodes"
  )
})

test_that("summarize_network errors on non-cograph with column name", {
  expect_error(
    summarize_network(mat8, cluster_list = "clusters"),
    "must be a cograph_network"
  )
})

test_that("summarize_network auto-detects 'groups' column", {
  net <- as_cograph(mat8)
  net$nodes$groups <- c("X", "X", "Y", "Y", "Y", "Z", "Z", "Z")

  expect_message(
    result <- summarize_network(net),
    "Using 'groups' column"
  )

  expect_s3_class(result, "cograph_network")
})

test_that("summarize_network auto-detects 'community' column", {
  net <- as_cograph(mat8)
  net$nodes$community <- c(1, 1, 2, 2, 2, 3, 3, 3)

  expect_message(
    result <- summarize_network(net),
    "Using 'community' column"
  )

  expect_s3_class(result, "cograph_network")
})

test_that("summarize_network auto-detects 'module' column", {
  net <- as_cograph(mat8)
  net$nodes$module <- c("M1", "M1", "M2", "M2", "M2", "M3", "M3", "M3")

  expect_message(
    result <- summarize_network(net),
    "Using 'module' column"
  )

  expect_s3_class(result, "cograph_network")
})

test_that("summarize_network errors when no clusters found", {
  net <- as_cograph(mat8)
  # No cluster column added

  expect_error(
    summarize_network(net),
    "cluster_list required"
  )
})

test_that("summarize_network works with tna object input", {
  skip_if_not_installed("tna")

  # Create a mock tna object
  tna_obj <- structure(
    list(
      weights = mat8,
      inits = rep(1 / 8, 8),
      labels = paste0("N", 1:8)
    ),
    class = "tna"
  )

  clusters <- list(
    G1 = c("N1", "N2"),
    G2 = c("N3", "N4", "N5"),
    G3 = c("N6", "N7", "N8")
  )

  result <- summarize_network(tna_obj, clusters)

  expect_s3_class(result, "cograph_network")
  expect_equal(n_nodes(result), 3)
})

test_that("summarize_network handles tna without labels", {
  skip_if_not_installed("tna")

  tna_obj <- structure(
    list(
      weights = mat8,
      inits = rep(1 / 8, 8),
      labels = NULL
    ),
    class = "tna"
  )

  clusters <- list(
    G1 = c("N1", "N2"),
    G2 = c("N3", "N4", "N5"),
    G3 = c("N6", "N7", "N8")
  )

  result <- summarize_network(tna_obj, clusters)

  expect_s3_class(result, "cograph_network")
})

test_that("summarize_network errors on invalid input type", {
  expect_error(
    summarize_network("not_valid", clusters_list),
    "must be a cograph_network, tna object, or matrix"
  )
})

test_that("summarize_network with directed = FALSE", {
  result <- summarize_network(mat8, clusters_list, directed = FALSE)

  expect_s3_class(result, "cograph_network")
})

test_that("summarize_network with different methods", {
  result_mean <- summarize_network(mat8, clusters_list, method = "mean")
  result_max <- summarize_network(mat8, clusters_list, method = "max")
  result_min <- summarize_network(mat8, clusters_list, method = "min")
  result_median <- summarize_network(mat8, clusters_list, method = "median")
  result_density <- summarize_network(mat8, clusters_list, method = "density")
  result_geomean <- summarize_network(mat8, clusters_list, method = "geomean")

  expect_s3_class(result_mean, "cograph_network")
  expect_s3_class(result_max, "cograph_network")
  expect_s3_class(result_min, "cograph_network")
  expect_s3_class(result_median, "cograph_network")
  expect_s3_class(result_density, "cograph_network")
  expect_s3_class(result_geomean, "cograph_network")
})

test_that("cluster_network and cnet are aliases for summarize_network", {
  result1 <- summarize_network(mat8, clusters_list)
  result2 <- cluster_network(mat8, clusters_list)
  result3 <- cnet(mat8, clusters_list)

  # Same structure
  expect_equal(n_nodes(result1), n_nodes(result2))
  expect_equal(n_nodes(result1), n_nodes(result3))
})

test_that("summarize_network works with unnamed matrix", {
  unnamed_mat <- matrix(runif(36), 6, 6)
  diag(unnamed_mat) <- 0

  clusters <- list(
    A = c("1", "2"),
    B = c("3", "4"),
    C = c("5", "6")
  )

  result <- summarize_network(unnamed_mat, clusters)

  expect_s3_class(result, "cograph_network")
})

test_that("summarize_network node sizes are correct", {
  result <- summarize_network(mat8, clusters_list)

  # Check sizes match cluster sizes
  expect_equal(result$nodes$size[result$nodes$label == "Group1"], 2)
  expect_equal(result$nodes$size[result$nodes$label == "Group2"], 3)
  expect_equal(result$nodes$size[result$nodes$label == "Group3"], 3)
})

# ==============================================================================
# 12. Additional edge case tests
# ==============================================================================

test_that("cluster_summary uses $weights when available in cograph_network", {
  net <- as_cograph(mat8)

  # Explicitly set weights to a different matrix
  net$weights <- mat8 * 2

  # cluster_summary should use $weights if available
  result <- cluster_summary(net, clusters_list)

  expect_s3_class(result, "cluster_summary")
})

test_that("cluster_summary handles cograph_network without $weights", {
  net <- as_cograph(mat8)

  # Remove weights to force to_matrix path
  net$weights <- NULL

  result <- cluster_summary(net, clusters_list)

  expect_s3_class(result, "cluster_summary")
})

test_that("cluster_summary integer clusters work", {
  # Integer vector clusters
  int_clusters <- as.integer(c(1, 1, 2, 2, 2, 3, 3, 3))

  result <- cluster_summary(mat8, int_clusters)

  expect_s3_class(result, "cluster_summary")
  expect_equal(result$meta$n_clusters, 3)
})

test_that("cluster_quality handles all-zero matrix", {
  zero_mat <- matrix(0, 5, 5)
  rownames(zero_mat) <- colnames(zero_mat) <- paste0("N", 1:5)

  clusters <- list(A = c("N1", "N2"), B = c("N3", "N4", "N5"))

  result <- cluster_quality(zero_mat, clusters)

  expect_s3_class(result, "cluster_quality")
  expect_true(is.na(result$global$coverage) || result$global$coverage == 0)
})

test_that("layer_similarity hamming on identical returns 0", {
  A1 <- mat8
  result <- layer_similarity(A1, A1, "hamming")
  expect_equal(result, 0)
})

test_that("supra_adjacency with 3 layers generates correct interlayer blocks", {
  layers <- list(L1 = mat8, L2 = mat8, L3 = mat8)
  result <- supra_adjacency(layers, omega = 0.5)

  # Should have 24 x 24 dimension (8 nodes * 3 layers)
  expect_equal(dim(result), c(24, 24))

  # Extract interlayer 1 -> 3
  interlayer_13 <- supra_interlayer(result, 1, 3)
  expect_equal(diag(interlayer_13), rep(0.5, 8))
})

test_that("aggregate_layers with single layer list", {
  layers <- list(L1 = mat8)
  result <- aggregate_layers(layers, method = "sum")

  expect_equal(result, mat8)
})

test_that("cluster_summary type semi_markov works", {
  result <- cluster_summary(mat8, clusters_list, type = "semi_markov")

  expect_s3_class(result, "cluster_summary")
  expect_equal(result$meta$type, "semi_markov")

  # Rows should sum to 1
  row_sums <- rowSums(result$macro$weights)
  expect_true(all(abs(row_sums - 1) < 1e-10))
})

test_that("cluster_summary handles matrix without names", {
  unnamed <- mat8
  rownames(unnamed) <- NULL
  colnames(unnamed) <- NULL

  clusters <- c(1, 1, 2, 2, 2, 3, 3, 3)

  result <- cluster_summary(unnamed, clusters)

  expect_s3_class(result, "cluster_summary")
  # Node names should be auto-generated
  expect_true(all(unlist(result$cluster_members) %in% as.character(1:8)))
})

test_that("cluster_summary handles unnamed cluster list", {
  unnamed_clusters <- list(
    c("N1", "N2"),
    c("N3", "N4", "N5"),
    c("N6", "N7", "N8")
  )

  result <- cluster_summary(mat8, unnamed_clusters)

  expect_s3_class(result, "cluster_summary")
  # Cluster names should be auto-generated
  expect_equal(names(result$clusters), c("1", "2", "3"))
})

test_that("verify_with_igraph works with mean method", {
  skip_if_not_installed("igraph")

  result <- verify_with_igraph(mat8, clusters_list, method = "mean")

  expect_type(result, "list")
})

test_that("cluster_quality returns numeric cut_ratio metrics", {
  result <- cluster_quality(mat8, clusters_list)

  # cut_ratio should be numeric
  valid_ratios <- result$per_cluster$cut_ratio[!is.na(result$per_cluster$cut_ratio)]
  expect_true(all(is.numeric(valid_ratios)))
})

test_that("cluster_summary produces valid between$inits with dense matrix", {
  # Dense matrix - all entries nonzero
  dense <- matrix(runif(64, 0.1, 1), 8, 8)
  diag(dense) <- 0
  rownames(dense) <- colnames(dense) <- paste0("N", 1:8)

  result <- cluster_summary(dense, clusters_list)

  # Inits should sum to 1
  expect_equal(sum(result$macro$inits), 1, tolerance = 1e-10)
})

test_that("cluster_summary produces uniform inits for zero-weight matrix", {
  zero_mat <- matrix(0, 8, 8)
  rownames(zero_mat) <- colnames(zero_mat) <- paste0("N", 1:8)

  result <- cluster_summary(zero_mat, clusters_list)

  # With no edges, inits should be uniform
  expect_equal(result$macro$inits, c(Group1 = 1 / 3, Group2 = 1 / 3, Group3 = 1 / 3),
               tolerance = 1e-10)
})

# ==============================================================================
# 13. print.cluster_summary edge cases
# ==============================================================================

test_that("print.cluster_summary with > 6 clusters shows truncation", {
  # Create a matrix with 7 clusters (more than 6)
  mat7 <- matrix(runif(49), 7, 7)
  diag(mat7) <- 0
  rownames(mat7) <- colnames(mat7) <- paste0("N", 1:7)

  clusters7 <- list(
    C1 = "N1", C2 = "N2", C3 = "N3", C4 = "N4",
    C5 = "N5", C6 = "N6", C7 = "N7"
  )

  cs <- cluster_summary(mat7, clusters7)

  expect_output(print(cs), "showing first 6x6 corner")
})

test_that("print.cluster_summary with exactly 6 clusters shows full matrix", {
  mat6 <- matrix(runif(36), 6, 6)
  diag(mat6) <- 0
  rownames(mat6) <- colnames(mat6) <- paste0("N", 1:6)

  clusters6 <- list(
    C1 = "N1", C2 = "N2", C3 = "N3",
    C4 = "N4", C5 = "N5", C6 = "N6"
  )

  cs <- cluster_summary(mat6, clusters6)

  # Should NOT show truncation message
  output <- capture.output(print(cs))
  expect_false(any(grepl("showing first", output)))
})

# ==============================================================================
# Summary
# ==============================================================================

cat("\n=== Cluster Metrics Coverage Tests 41 Complete ===\n")