# Test coverage for R/motifs.R - Additional coverage tests (43) # Targets uncovered code paths and edge cases skip_on_cran() # ============================================================================= # TEST SETUP AND HELPER FUNCTIONS # ============================================================================= # Helper: Create test matrices create_test_matrix <- function(n = 5, seed = 123, density = 0.4) { set.seed(seed) mat <- matrix(sample(0:1, n * n, replace = TRUE, prob = c(1 - density, density)), n, n) diag(mat) <- 0 rownames(mat) <- colnames(mat) <- LETTERS[1:n] mat } create_weighted_test_matrix <- function(n = 5, seed = 123, max_weight = 10) { set.seed(seed) mat <- matrix(sample(0:max_weight, n * n, replace = TRUE), n, n) diag(mat) <- 0 rownames(mat) <- colnames(mat) <- LETTERS[1:n] mat } # ============================================================================= # .draw_closed_arrow EDGE CASE TESTS # ============================================================================= test_that(".draw_closed_arrow handles zero-length vector", { draw_arrow <- cograph:::.draw_closed_arrow tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) plot(0:1, 0:1, type = "n") # Zero length should return early without error draw_arrow(0.5, 0.5, 0.5, 0.5, col = "#800020", lwd = 2) grDevices::dev.off() expect_true(file.exists(tmp)) }) test_that(".draw_closed_arrow handles both parameter TRUE", { draw_arrow <- cograph:::.draw_closed_arrow tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) plot(0:1, 0:1, type = "n") draw_arrow(0.2, 0.2, 0.8, 0.8, col = "#000080", lwd = 3, both = TRUE, head_length = 0.15, head_width = 0.1) grDevices::dev.off() expect_true(file.exists(tmp)) }) test_that(".draw_closed_arrow handles custom head dimensions", { draw_arrow <- cograph:::.draw_closed_arrow tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) plot(0:1, 0:1, type = "n") draw_arrow(0.1, 0.9, 0.9, 0.1, col = "#FF0000", lwd = 1, head_length = 0.2, head_width = 0.15) grDevices::dev.off() expect_true(file.exists(tmp)) }) # ============================================================================= # .grid_arrow EDGE CASE TESTS # ============================================================================= test_that(".grid_arrow handles zero-length path", { skip_if_not_installed("grid") grid_arrow <- cograph:::.grid_arrow tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) grid::grid.newpage() # Zero length should return early grid_arrow(0.5, 0.5, 0.5, 0.5, col = "#800020") grDevices::dev.off() expect_true(file.exists(tmp)) }) test_that(".grid_arrow handles various angles", { skip_if_not_installed("grid") grid_arrow <- cograph:::.grid_arrow tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) grid::grid.newpage() # Horizontal grid_arrow(0.8, 0.5, 0.2, 0.5, col = "#800020") # Vertical grid_arrow(0.5, 0.8, 0.5, 0.2, col = "#000080") # Diagonal grid_arrow(0.9, 0.1, 0.1, 0.9, col = "#008000") grDevices::dev.off() expect_true(file.exists(tmp)) }) # ============================================================================= # .get_motif_names ADDITIONAL TESTS # ============================================================================= test_that(".get_motif_names handles all size/directed combinations", { get_motif_names <- cograph:::.get_motif_names # Size 3 directed names_3d <- get_motif_names(3, TRUE) expect_equal(length(names_3d), 16) expect_true("030T" %in% names_3d) # Size 3 undirected names_3u <- get_motif_names(3, FALSE) expect_true("empty" %in% names_3u) expect_true("edge" %in% names_3u) expect_true("triangle" %in% names_3u) # Size 4 directed (199 motifs) names_4d <- get_motif_names(4, TRUE) expect_equal(length(names_4d), 199) expect_true(all(grepl("^M", names_4d))) # Size 4 undirected (11 motifs) names_4u <- get_motif_names(4, FALSE) expect_equal(length(names_4u), 11) # Fallback for unknown size names_other <- get_motif_names(5, TRUE) expect_true(all(grepl("^motif_", names_other))) }) # ============================================================================= # .classify_triads_vectorized ADDITIONAL TESTS # ============================================================================= test_that(".classify_triads_vectorized handles all MAN types", { classify_triads <- cograph:::.classify_triads_vectorized # Test specific MAN types # 003 - Empty expect_equal(classify_triads(0, 0, 0, 0, 0, 0), "003") # 012 - Single edge expect_equal(classify_triads(1, 0, 0, 0, 0, 0), "012") # 102 - Mutual edge expect_equal(classify_triads(1, 1, 0, 0, 0, 0), "102") # 300 - Full clique expect_equal(classify_triads(1, 1, 1, 1, 1, 1), "300") }) test_that(".classify_triads_vectorized handles vectorized input", { classify_triads <- cograph:::.classify_triads_vectorized # Multiple triads at once e_ij <- c(0, 1, 1) e_ji <- c(0, 1, 1) e_ik <- c(0, 0, 1) e_ki <- c(0, 0, 1) e_jk <- c(0, 0, 1) e_kj <- c(0, 0, 1) result <- classify_triads(e_ij, e_ji, e_ik, e_ki, e_jk, e_kj) expect_equal(length(result), 3) expect_equal(result[1], "003") # Empty expect_equal(result[2], "102") # Mutual pair expect_equal(result[3], "300") # Full clique }) # ============================================================================= # motif_census EDGE CASE TESTS # ============================================================================= test_that("motif_census handles undirected configuration method", { skip_if_not_installed("igraph") # Create symmetric matrix mat <- matrix(c(0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0), 4, 4, byrow = TRUE) rownames(mat) <- colnames(mat) <- c("A", "B", "C", "D") result <- motif_census(mat, n_random = 5, method = "configuration", seed = 42) expect_s3_class(result, "cograph_motifs") expect_false(result$directed) }) test_that("motif_census handles gnm method with undirected network", { skip_if_not_installed("igraph") mat <- matrix(c(0, 1, 0, 1, 0, 1, 0, 1, 0), 3, 3) mat <- mat + t(mat) mat[mat > 1] <- 1 rownames(mat) <- colnames(mat) <- c("A", "B", "C") result <- motif_census(mat, n_random = 5, method = "gnm", seed = 42) expect_s3_class(result, "cograph_motifs") expect_equal(result$method, "gnm") }) test_that("motif_census handles tetradic motifs (size = 4)", { skip_if_not_installed("igraph") mat <- create_test_matrix(6, seed = 456, density = 0.5) result <- motif_census(mat, size = 4, n_random = 5, seed = 42) expect_s3_class(result, "cograph_motifs") expect_equal(result$size, 4) }) test_that("motif_census auto-detects directed from asymmetric matrix", { skip_if_not_installed("igraph") # Asymmetric matrix should be detected as directed mat <- matrix(c(0, 1, 0, 0, 0, 1, 1, 0, 0), 3, 3, byrow = TRUE) rownames(mat) <- colnames(mat) <- c("A", "B", "C") result <- motif_census(mat, n_random = 5, seed = 42) expect_true(result$directed) }) # ============================================================================= # print.cograph_motifs EDGE CASE TESTS # ============================================================================= test_that("print.cograph_motifs displays over and under-represented motifs", { skip_if_not_installed("igraph") mat <- create_test_matrix(8, seed = 789, density = 0.5) result <- motif_census(mat, n_random = 30, seed = 42) output <- capture.output(print(result)) # Should have Over/Under counts expect_true(any(grepl("Over-represented|Under-represented", output))) }) # ============================================================================= # plot.cograph_motifs EDGE CASE TESTS # ============================================================================= test_that("plot.cograph_motifs handles undirected network for network type", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") # Undirected should fall back to bar plot mat <- matrix(c(0, 1, 1, 1, 0, 1, 1, 1, 0), 3, 3) rownames(mat) <- colnames(mat) <- c("A", "B", "C") result <- motif_census(mat, n_random = 5, seed = 42) tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) # Network type with undirected should message and use bar expect_message(p <- plot(result, type = "network", show_nonsig = TRUE)) grDevices::dev.off() expect_true(is.null(p) || inherits(p, "gg")) }) test_that("plot.cograph_motifs handles size != 3 for network type", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") mat <- create_test_matrix(6, seed = 123, density = 0.5) result <- motif_census(mat, size = 4, n_random = 5, seed = 42) tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) # Size 4 with network type should message and use bar expect_message(p <- plot(result, type = "network", show_nonsig = TRUE)) grDevices::dev.off() expect_true(is.null(p) || inherits(p, "gg")) }) test_that("plot.cograph_motifs handles motifs not in standard triads", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") # Create mock result with non-standard motif names mock_result <- list( counts = c(custom1 = 5, custom2 = 3), null_mean = c(custom1 = 2.5, custom2 = 1.5), null_sd = c(custom1 = 1.0, custom2 = 0.5), z_scores = c(custom1 = 2.5, custom2 = 3.0), p_values = c(custom1 = 0.01, custom2 = 0.002), significant = c(custom1 = TRUE, custom2 = TRUE), size = 3, directed = TRUE, n_random = 10, method = "configuration" ) class(mock_result) <- "cograph_motifs" tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) # Should message about no standard triads and fall back to bar expect_message(p <- plot(mock_result, type = "network")) grDevices::dev.off() expect_true(is.null(p) || inherits(p, "gg")) }) # ============================================================================= # extract_triads ADDITIONAL TESTS # ============================================================================= test_that("extract_triads handles multiple involving nodes", { skip_if_not_installed("igraph") mat <- create_weighted_test_matrix(6, seed = 123) result <- extract_triads(mat, involving = c("A", "B"), min_total = 0) if (nrow(result) > 0) { has_AB <- apply(result[, c("A", "B", "C")], 1, function(x) any(c("A", "B") %in% x)) expect_true(all(has_AB)) } }) test_that("extract_triads handles multiple type filters", { skip_if_not_installed("igraph") mat <- create_weighted_test_matrix(6, seed = 123) result <- extract_triads(mat, type = c("021D", "021U", "021C"), min_total = 0) expect_true(is.data.frame(result)) if (nrow(result) > 0) { expect_true(all(result$type %in% c("021D", "021U", "021C"))) } }) # ============================================================================= # .count_triads_matrix_vectorized EDGE CASE TESTS # ============================================================================= test_that(".count_triads_matrix_vectorized handles small matrix", { count_triads <- cograph:::.count_triads_matrix_vectorized # Too small (< 3 nodes) mat <- matrix(c(0, 1, 0, 0), 2, 2) result <- count_triads(mat, edge_method = "any", edge_threshold = 0) expect_null(result) }) test_that(".count_triads_matrix_vectorized handles all-zero matrix", { count_triads <- cograph:::.count_triads_matrix_vectorized mat <- matrix(0, 5, 5) result <- count_triads(mat, edge_method = "any", edge_threshold = 0) expect_null(result) }) test_that(".count_triads_matrix_vectorized expected method without expected_mat errors", { count_triads <- cograph:::.count_triads_matrix_vectorized mat <- create_weighted_test_matrix(5, seed = 123) # Should error without expected_mat expect_error(count_triads(mat, edge_method = "expected", edge_threshold = 1.5)) }) test_that(".count_triads_matrix_vectorized handles include and exclude together", { count_triads <- cograph:::.count_triads_matrix_vectorized mat <- create_weighted_test_matrix(5, seed = 123) result <- count_triads(mat, edge_method = "any", edge_threshold = 0, include = c("030T", "030C", "300"), exclude = c("300")) # Either NULL or data frame expect_true(is.null(result) || is.data.frame(result)) if (!is.null(result) && nrow(result) > 0) { expect_true(all(result$type %in% c("030T", "030C"))) expect_false("300" %in% result$type) } }) # ============================================================================= # extract_motifs ADDITIONAL EDGE CASES # ============================================================================= test_that("extract_motifs handles pattern 'closed'", { skip_if_not_installed("igraph") mat <- create_weighted_test_matrix(6, seed = 123) result <- extract_motifs(mat, pattern = "closed", min_transitions = 0) expect_true(is.null(result) || inherits(result, "cograph_motif_analysis")) if (!is.null(result) && nrow(result$results) > 0) { # closed excludes 003, 012, 021C, 120C expect_false(any(result$results$type %in% c("003", "012", "021C", "120C"))) } }) test_that("extract_motifs handles 'expected' edge_method", { skip_if_not_installed("igraph") mat <- create_weighted_test_matrix(5, seed = 123, max_weight = 20) result <- extract_motifs(mat, edge_method = "expected", edge_threshold = 1.0, pattern = "all", min_transitions = 0) expect_true(is.null(result) || inherits(result, "cograph_motif_analysis")) }) test_that("extract_motifs handles multiple id columns in data frame", { skip_if_not_installed("igraph") df <- data.frame( group = rep(c("X", "Y"), each = 10), person = rep(1:5, 4), from = sample(c("A", "B", "C"), 20, replace = TRUE), to = sample(c("A", "B", "C"), 20, replace = TRUE) ) result <- extract_motifs(data = df, id = c("group", "person"), pattern = "all", min_transitions = 0) expect_true(is.null(result) || inherits(result, "cograph_motif_analysis")) }) test_that("extract_motifs handles igraph without vertex names", { skip_if_not_installed("igraph") # Create igraph without names from the start n <- 5 edges <- c(1, 2, 2, 3, 3, 4, 4, 5, 1, 3, 2, 4) g <- igraph::make_graph(edges, directed = TRUE, n = n) result <- extract_motifs(g, pattern = "all", min_transitions = 0) expect_true(is.null(result) || inherits(result, "cograph_motif_analysis")) }) test_that("extract_motifs handles igraph with edge weights", { skip_if_not_installed("igraph") mat <- create_weighted_test_matrix(5, seed = 123) g <- igraph::graph_from_adjacency_matrix(mat, mode = "directed", weighted = TRUE) result <- extract_motifs(g, pattern = "all", min_transitions = 0) expect_true(is.null(result) || inherits(result, "cograph_motif_analysis")) }) test_that("extract_motifs errors on missing data columns", { skip_if_not_installed("igraph") df <- data.frame( id = 1:5, from = c("A", "B", "C", "A", "B") # missing 'to' column ) expect_error(extract_motifs(data = df, id = "id")) }) test_that("extract_motifs errors on missing id column", { skip_if_not_installed("igraph") df <- data.frame( from = c("A", "B", "C"), to = c("B", "C", "A") ) expect_error(extract_motifs(data = df, id = "nonexistent")) }) test_that("extract_motifs handles level parameter with individual data", { skip_if_not_installed("igraph") df <- data.frame( id = rep(1:3, each = 5), from = sample(c("A", "B", "C"), 15, replace = TRUE), to = sample(c("A", "B", "C"), 15, replace = TRUE) ) # Force individual level result_ind <- extract_motifs(data = df, id = "id", level = "individual", pattern = "all", min_transitions = 0) expect_true(is.null(result_ind) || result_ind$params$level == "individual") }) test_that("extract_motifs warns when individual level requested without individual data", { skip_if_not_installed("igraph") mat <- create_weighted_test_matrix(5, seed = 123) # Request individual level but provide matrix (no individual data) expect_warning( extract_motifs(mat, level = "individual", pattern = "all", min_transitions = 0), "Individual level requested but no individual data" ) }) # ============================================================================= # print.cograph_motif_analysis EDGE CASE TESTS # ============================================================================= test_that("print.cograph_motif_analysis shows threshold for non-any methods", { skip_if_not_installed("igraph") mat <- create_weighted_test_matrix(6, seed = 123) result <- extract_motifs(mat, edge_method = "percent", edge_threshold = 0.15, pattern = "all", min_transitions = 0) if (!is.null(result)) { output <- capture.output(print(result)) expect_true(any(grepl("threshold", output))) } }) test_that("print.cograph_motif_analysis handles significance results", { skip_if_not_installed("igraph") mat <- create_weighted_test_matrix(5, seed = 123) result <- extract_motifs(mat, pattern = "all", min_transitions = 0, significance = TRUE, n_perm = 5, seed = 42) if (!is.null(result) && nrow(result$results) > 0) { output <- capture.output(print(result)) expect_true(length(output) > 0) } }) # ============================================================================= # plot.cograph_motif_analysis EDGE CASE TESTS # ============================================================================= test_that("plot.cograph_motif_analysis handles triads with missing type pattern", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") mat <- create_weighted_test_matrix(5, seed = 123) result <- extract_motifs(mat, pattern = "all", min_transitions = 0) if (!is.null(result) && nrow(result$results) > 0) { # Modify result to have unknown type result$results$type[1] <- "UNKNOWN" tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp, width = 400, height = 400) plot(result, type = "triads", n = 2) grDevices::dev.off() expect_true(file.exists(tmp)) } }) test_that("plot.cograph_motif_analysis handles empty results", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") # Create mock empty result mock_result <- list( results = data.frame(triad = character(0), type = character(0), observed = numeric(0), stringsAsFactors = FALSE), type_summary = table(character(0)), params = list( level = "aggregate", edge_method = "any", pattern = "triangle", significance = FALSE ) ) class(mock_result) <- "cograph_motif_analysis" tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) expect_message(plot(mock_result, type = "triads")) grDevices::dev.off() }) test_that("plot.cograph_motif_analysis significance type without significance data", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") mat <- create_weighted_test_matrix(5, seed = 123) result <- extract_motifs(mat, pattern = "all", min_transitions = 0, significance = FALSE) if (!is.null(result) && nrow(result$results) > 0) { # Should error with informative message expect_error( plot(result, type = "significance"), "No significance data available" ) } }) test_that("plot.cograph_motif_analysis handles legend parameter", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") mat <- create_weighted_test_matrix(5, seed = 123) result <- extract_motifs(mat, pattern = "all", min_transitions = 0) if (!is.null(result) && nrow(result$results) > 0) { tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp, width = 400, height = 400) plot(result, type = "triads", n = 4, legend = TRUE) grDevices::dev.off() expect_true(file.exists(tmp)) } }) test_that("plot.cograph_motif_analysis patterns type with empty results", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") mock_result <- list( results = data.frame(triad = character(0), type = character(0), observed = numeric(0), stringsAsFactors = FALSE), type_summary = table(character(0)), params = list( level = "aggregate", edge_method = "any", pattern = "triangle", significance = FALSE ) ) class(mock_result) <- "cograph_motif_analysis" tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp) expect_message(plot(mock_result, type = "patterns")) grDevices::dev.off() }) # ============================================================================= # .plot_motif_patterns TESTS # ============================================================================= test_that(".plot_motif_patterns displays motifs with MAN types", { skip_if_not_installed("igraph") skip_if_not_installed("ggplot2") mat <- create_weighted_test_matrix(6, seed = 123) result <- extract_motifs(mat, pattern = "all", min_transitions = 0) if (!is.null(result) && length(result$type_summary) > 0) { tmp <- tempfile(fileext = ".png") on.exit(unlink(tmp), add = TRUE) grDevices::png(tmp, width = 600, height = 400) plot(result, type = "patterns", n = 6) grDevices::dev.off() expect_true(file.exists(tmp)) } })