diff --git a/R/community.R b/R/community.R index 901b48d9838..fb6d9f40070 100644 --- a/R/community.R +++ b/R/community.R @@ -1,4 +1,3 @@ - #' Creates a communities object. #' #' @description @@ -469,7 +468,7 @@ membership <- function(communities) { which.max(communities$modularity) ) } else { - stop("Cannot calculate community membership") + cli::cli_abort("Cannot calculate community membership") } if (igraph_opt("add.vertex.names") && !is.null(communities$names)) { names(res) <- communities$names @@ -681,7 +680,7 @@ modularity.igraph <- function(x, membership, weights = NULL, resolution = 1, dir # Argument checks ensure_igraph(x) if (is.null(membership) || (!is.numeric(membership) && !is.factor(membership))) { - stop("Membership is not a numerical vector") + cli::cli_abort("Membership is not a numerical vector") } membership <- as.numeric(membership) if (!is.null(weights)) weights <- as.numeric(weights) @@ -701,7 +700,7 @@ modularity.communities <- function(x, ...) { if (!is.null(x$modularity)) { max(x$modularity) } else { - stop("Modularity was not calculated") + cli::cli_abort("cluster algorithm was run with {.arg modularity = FALSE} and no modularity value was computed.") } } @@ -761,7 +760,7 @@ merges <- function(communities) { if (!is.null(communities$merges)) { communities$merges } else { - stop("Not a hierarchical community structure") + cli::cli_abort("Not a hierarchical community structure") } } @@ -795,10 +794,9 @@ complete.dend <- function(comm, use.modularity) { merges <- comm$merges if (nrow(merges) < comm$vcount - 1) { if (use.modularity) { - stop(paste( - "`use.modularity' requires a full dendrogram,", - "i.e. a connected graph" - )) + cli::cli_abort( + "{.arg use.modularity} requires a full dendrogram, i.e. a connected graph" + ) } miss <- seq_len(comm$vcount + nrow(merges))[-as.vector(merges)] miss <- c(miss, seq_len(length(miss) - 2) + comm$vcount + nrow(merges)) @@ -819,7 +817,7 @@ complete.dend <- function(comm, use.modularity) { as.dendrogram.communities <- function(object, hang = -1, use.modularity = FALSE, ...) { if (!is_hierarchical(object)) { - stop("Not a hierarchical community structure") + cli::cli_abort("Not a hierarchical community structure") } .memberDend <- function(x) { @@ -848,7 +846,7 @@ as.dendrogram.communities <- function(object, hang = -1, use.modularity = FALSE, } nMerge <- length(oHgt <- object$height) if (nMerge != nrow(merges)) { - stop("'merge' and 'height' do not fit!") + cli::cli_abort("'merge' and 'height' do not fit!") } hMax <- oHgt[nMerge] one <- 1L @@ -919,7 +917,7 @@ as.hclust.communities <- function(x, hang = -1, use.modularity = FALSE, as.phylo.communities <- function(x, use.modularity = FALSE, ...) { if (!is_hierarchical(x)) { - stop("Not a hierarchical community structure") + cli::cli_abort("Not a hierarchical community structure") } ## If multiple components, then we merge them in arbitrary order @@ -974,15 +972,15 @@ rlang::on_load(s3_register("ape::as.phylo", "communities")) #' @export cut_at <- function(communities, no, steps) { if (!inherits(communities, "communities")) { - stop("Not a community structure") + cli::cli_abort("Not a community structure") } if (!is_hierarchical(communities)) { - stop("Not a hierarchical communitity structure") + cli::cli_abort("Not a hierarchical communitity structure") } if ((!missing(no) && !missing(steps)) || (missing(no) && missing(steps))) { - stop("Please give either `no' or `steps' (but not both)") + cli::cli_abort("Please use either {.arg no} or {.arg steps} (but not both)") } if (!missing(steps)) { @@ -1008,10 +1006,10 @@ cut_at <- function(communities, no, steps) { #' @export show_trace <- function(communities) { if (!inherits(communities, "communities")) { - stop("Not a community structure") + cli::cli_abort("Not a community structure") } if (is.null(communities$history)) { - stop("History was not recorded") + cli::cli_abort("History was not recorded") } res <- character() @@ -1340,13 +1338,14 @@ cluster_leiden <- function(graph, objective_function = c("CPM", "modularity"), resolution_parameter = deprecated(), beta = 0.01, initial_membership = NULL, n_iterations = 2, vertex_weights = NULL) { - check_dots_empty() if (lifecycle::is_present(resolution_parameter)) { - lifecycle::deprecate_soft("2.1.0", - "cluster_leiden(resolution_parameter)", - "cluster_leiden(resolution)") + lifecycle::deprecate_soft( + "2.1.0", + "cluster_leiden(resolution_parameter)", + "cluster_leiden(resolution)" + ) resolution <- resolution_parameter } @@ -1879,7 +1878,6 @@ cluster_leading_eigen <- function(graph, steps = -1, weights = NULL, options = arpack_defaults(), callback = NULL, extra = NULL, env = parent.frame()) { - if (is.function(options)) { lifecycle::deprecate_soft( "1.6.0", @@ -2041,8 +2039,16 @@ cluster_label_prop0 <- function( if (!is.null(initial)) initial <- as.numeric(initial) if (!is.null(fixed)) fixed <- as.logical(fixed) - directed <- switch(igraph.match.arg(mode), "out" = TRUE, "in" = TRUE, "all" = FALSE) - mode <- switch(igraph.match.arg(mode), "out" = 1L, "in" = 2L, "all" = 3L) + directed <- switch(igraph.match.arg(mode), + "out" = TRUE, + "in" = TRUE, + "all" = FALSE + ) + mode <- switch(igraph.match.arg(mode), + "out" = 1L, + "in" = 2L, + "all" = 3L + ) on.exit(.Call(R_igraph_finalizer)) # Function call @@ -2828,10 +2834,10 @@ contract <- contract_vertices_impl #' @seealso [distances()] #' @examples #' -#' g <- make_lattice(c(10,10)) +#' g <- make_lattice(c(10, 10)) #' clu <- voronoi_cells(g, c(25, 43, 67)) #' groups(clu) -#' plot(g, vertex.color=clu$membership) +#' plot(g, vertex.color = clu$membership) #' #' @export #' @family community diff --git a/tests/testthat/_snaps/modularity_matrix.md b/tests/testthat/_snaps/community.md similarity index 73% rename from tests/testthat/_snaps/modularity_matrix.md rename to tests/testthat/_snaps/community.md index 3af711323fb..e01280a95f5 100644 --- a/tests/testthat/_snaps/modularity_matrix.md +++ b/tests/testthat/_snaps/community.md @@ -1,7 +1,7 @@ # modularity_matrix still accepts a membership argument for compatibility Code - x <- modularity_matrix(kar, membership = rep(1, vcount(kar))) + x <- modularity_matrix(karate, membership = rep(1, vcount(karate))) Condition Warning: The `membership` argument of `modularity_matrix()` is no longer used as of igraph 2.1.0. diff --git a/tests/testthat/test-communities.R b/tests/testthat/test-communities.R deleted file mode 100644 index 4301d339263..00000000000 --- a/tests/testthat/test-communities.R +++ /dev/null @@ -1,74 +0,0 @@ -test_that("community detection functions work", { - withr::local_seed(42) - - F <- list( - "cluster_edge_betweenness", "cluster_fast_greedy", - "cluster_label_prop", "cluster_leading_eigen", - "cluster_louvain", "cluster_spinglass", "cluster_walktrap" - ) - if (has_glpk()) F <- c(F, list("cluster_optimal")) - - karate <- make_graph("Zachary") - - for (f in F) { - f <- get(f) - comm <- f(karate) - - expect_equal( - modularity(comm), - modularity(karate, membership(comm)) - ) - - cc <- communities(comm) - expect_true(all(!duplicated(unlist(cc)))) - expect_true(all(unlist(cc) <= vcount(karate) & unlist(cc) >= 1)) - expect_equal(length(comm), max(membership(comm))) - } - - fc <- cluster_fast_greedy(karate) - m1 <- modularity(karate, cut_at(fc, no = 1)) - m2 <- modularity(karate, cut_at(fc, no = 2)) - m3 <- modularity(karate, cut_at(fc, no = 3)) - m4 <- modularity(karate, cut_at(fc, no = 4)) - expect_equal(m1, 0) - expect_equal(m2, 0.3717948718) - expect_equal(m3, 0.3806706114) - expect_equal(m4, 0.3759861933) - - cr <- crossing(fc, karate) - expect_equal(cr, c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)) -}) - -test_that("creating communities objects works", { - withr::local_seed(42) - - karate <- make_graph("Zachary") - - membership <- sample(1:2, vcount(karate), replace = TRUE) - mod <- modularity(karate, membership) - comm <- make_clusters( - algorithm = "random", membership = membership, - modularity = mod - ) - - expect_equal(as.vector(membership(comm)), membership) - expect_equal(modularity(comm), mod) - expect_equal(algorithm(comm), "random") -}) - -test_that("communities function works", { - skip_if_no_glpk() - g <- make_graph("Zachary") - oc <- cluster_optimal(g) - gr <- communities(oc) - expect_equal( - gr, - structure(list(`1` = c(1L, 2L, 3L, 4L, 8L, 12L, 13L, 14L, 18L, 20L, 22L), `2` = c(5L, 6L, 7L, 11L, 17L), `3` = c(9L, 10L, 15L, 16L, 19L, 21L, 23L, 27L, 30L, 31L, 33L, 34L), `4` = c(24L, 25L, 26L, 28L, 29L, 32L)), .Dim = 4L, .Dimnames = list(c("1", "2", "3", "4"))) - ) - - g <- make_ring(5) + make_ring(5) - V(g)$name <- letters[1:10] - oc <- cluster_optimal(g) - gr <- communities(oc) - expect_equal(gr, structure(list(`1` = letters[1:5], `2` = letters[6:10]), .Dim = 2L, .Dimnames = list(c("1", "2")))) -}) diff --git a/tests/testthat/test-community.R b/tests/testthat/test-community.R new file mode 100644 index 00000000000..69859330b1d --- /dev/null +++ b/tests/testthat/test-community.R @@ -0,0 +1,437 @@ +test_that("community detection functions work", { + withr::local_seed(42) + + cluster_algos <- list( + "cluster_edge_betweenness", "cluster_fast_greedy", + "cluster_label_prop", "cluster_leading_eigen", + "cluster_louvain", "cluster_spinglass", "cluster_walktrap" + ) + if (has_glpk()) cluster_algos <- c(cluster_algos, "cluster_optimal") + + karate <- make_graph("Zachary") + + for (algo in cluster_algos) { + karate_clustering <- do.call(algo, list(karate)) + + expect_equal( + modularity(karate_clustering), + modularity(karate, membership(karate_clustering)) + ) + + karate_comunities <- communities(karate_clustering) + flat_karate_communities <- unlist(karate_comunities) + is_vertex_in_several_clusters <- duplicated(flat_karate_communities) + expect_false(any(is_vertex_in_several_clusters)) + is_cluster_id_valid <- flat_karate_communities <= vcount(karate) & flat_karate_communities >= 1 + expect_true(all(is_cluster_id_valid)) + expect_length(karate_clustering, max(membership(karate_clustering))) + } + + karate_fgreedy <- cluster_fast_greedy(karate) + m1 <- modularity(karate, cut_at(karate_fgreedy, no = 1)) + expect_equal(m1, 0) + + m2 <- modularity(karate, cut_at(karate_fgreedy, no = 2)) + expect_equal(m2, 0.3717948718) + + m3 <- modularity(karate, cut_at(karate_fgreedy, no = 3)) + expect_equal(m3, 0.3806706114) + + m4 <- modularity(karate, cut_at(karate_fgreedy, no = 4)) + expect_equal(m4, 0.3759861933) + + cr <- crossing(karate_fgreedy, karate) + expect_equal( + cr, + c( + TRUE, TRUE, TRUE, FALSE, FALSE, + FALSE, TRUE, TRUE, FALSE, FALSE, + TRUE, TRUE, TRUE, FALSE, TRUE, TRUE, + FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, + FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE, + FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, + FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE + ) + ) +}) + +test_that("creating communities objects works", { + withr::local_seed(42) + + karate <- make_graph("Zachary") + + membership <- sample(1:2, vcount(karate), replace = TRUE) + mod <- modularity(karate, membership) + comm <- make_clusters( + algorithm = "random", membership = membership, + modularity = mod + ) + + expect_equal(membership(comm), membership) + expect_equal(modularity(comm), mod) + expect_equal(algorithm(comm), "random") +}) + +test_that("communities function works", { + skip_if_no_glpk() + karate <- make_graph("Zachary") + karate_optimal <- cluster_optimal(karate) + karate_coms <- communities(karate_optimal) + expect_equal( + karate_coms, + structure( + list( + `1` = c(1L, 2L, 3L, 4L, 8L, 12L, 13L, 14L, 18L, 20L, 22L), + `2` = c(5L, 6L, 7L, 11L, 17L), + `3` = c(9L, 10L, 15L, 16L, 19L, 21L, 23L, 27L, 30L, 31L, 33L, 34L), + `4` = c(24L, 25L, 26L, 28L, 29L, 32L) + ), + .Dim = 4L, .Dimnames = list(c("1", "2", "3", "4")) + ) + ) + + double_ring <- make_ring(5) + make_ring(5) + V(double_ring)$name <- letters[1:10] + double_ring_optimal <- cluster_optimal(double_ring) + double_ring_coms <- communities(double_ring_optimal) + expect_equal( + double_ring_coms, + structure( + list( + `1` = letters[1:5], + `2` = letters[6:10] + ), + .Dim = 2L, .Dimnames = list(c("1", "2")) + ) + ) +}) + +test_that("cluster_edge_betweenness works", { + karate <- make_graph("Zachary") + karate_ebc <- cluster_edge_betweenness(karate) + + expect_equal(max(karate_ebc$modularity), modularity(karate, karate_ebc$membership)) + expect_equal( + membership(karate_ebc), + c( + 1, 1, 2, 1, 3, 3, 3, 1, 4, 5, 3, + 1, 1, 1, 4, 4, 3, 1, 4, 1, 4, 1, + 4, 4, 2, 2, 4, 2, 2, 4, 4, 2, 4, 4 + ) + ) + expect_length(karate_ebc, 5) + expect_equal(as.numeric(sizes(karate_ebc)), c(10, 6, 5, 12, 1)) + + karate_dendro <- as.dendrogram(karate_ebc) + expect_output(print(karate_dendro), "2 branches.*34 members.*height 33") + expect_output( + print(karate_dendro[[1]]), + "2 branches.*15 members.*height 31" + ) + expect_output( + print(karate_dendro[[2]]), + "2 branches.*19 members.*height 32" + ) + m2 <- cut_at(karate_ebc, no = 3) + expect_equal( + modularity(karate, m2), + karate_ebc$modularity[length(karate_ebc$modularity) - 2] + ) +}) + +test_that("cluster_fast_greedy works", { + withr::local_seed(42) + + karate <- make_graph("Zachary") + karate_fc <- cluster_fast_greedy(karate) + + expect_equal(modularity(karate, karate_fc$membership), max(karate_fc$modularity)) + expect_equal( + membership(karate_fc), + c( + 1, 3, 3, 3, 1, 1, 1, 3, 2, 3, 1, + 1, 3, 3, 2, 2, 1, 3, 2, 1, 2, 3, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 + ) + ) + expect_length(karate_fc, 3) + expect_equal(as.numeric(sizes(karate_fc)), c(8, 17, 9)) + + karate_dendro <- as.dendrogram(karate_fc) + expect_output(print(karate_dendro), "2 branches.*34 members.*height 33") + expect_output(print(karate_dendro[[1]]), "2 branches.*17 members.*height 32") + expect_output(print(karate_dendro[[2]]), "2 branches.*17 members.*height 30") + m2 <- cut_at(karate_fc, no = 3) + expect_equal( + modularity(karate, m2), + karate_fc$modularity[length(karate_fc$modularity) - 2] + ) +}) + +test_that("label.propagation.community works", { + karate <- make_graph("Zachary") + withr::local_seed(20231029) + karate_lpc <- cluster_label_prop(karate) + expect_equal(karate_lpc$modularity, modularity(karate, karate_lpc$membership)) + + expect_in(length(karate_lpc), 1:5) + expect_in(membership(karate_lpc), seq_len(length(karate_lpc))) + expect_s3_class(sizes(karate_lpc), "table") + expect_equal(sum(sizes(karate_lpc)), vcount(karate)) + expect_identical(sizes(karate_lpc), table(membership(karate_lpc), dnn = "Community sizes")) +}) + +test_that("cluster_leading_eigen works", { + withr::local_seed(20230115) + + check_eigen_value <- function(membership, community, value, vector, multiplier, extra) { + M <- sapply(1:length(vector), function(x) { + v <- rep(0, length(vector)) + v[x] <- 1 + multiplier(v) + }) + ev <- eigen(M) + ret <- 0 + expect_equal(ev$values[1], value) + if (sign(ev$vectors[1, 1]) != sign(vector[1])) { + ev$vectors <- -ev$vectors + } + expect_equal(ev$vectors[, 1], vector) + 0 + } + + karate <- make_graph("Zachary") + karate_lc <- cluster_leading_eigen(karate, callback = check_eigen_value) + + expect_equal(karate_lc$modularity, modularity(karate, karate_lc$membership)) + expect_equal( + membership(karate_lc), + c( + 1, 3, 3, 3, 1, 1, 1, 3, 2, 2, 1, + 1, 3, 3, 2, 2, 1, 3, 2, 3, 2, 3, + 2, 4, 4, 4, 2, 4, 4, 2, 2, 4, 2, 2 + ) + ) + expect_length(karate_lc, 4) + expect_equal( + sizes(karate_lc), + structure( + c(7L, 12L, 9L, 6L), + .Dim = 4L, + .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4")), + .Names = "Community sizes" + ), class = "table" + ) + ) + + ## Check that the modularity matrix is correct + + mod_mat_caller <- function(membership, community, value, vector, multiplier, extra) { + M <- sapply(1:length(vector), function(x) { + v <- rep(0, length(vector)) + v[x] <- 1 + multiplier(v) + }) + myc <- membership == community + B <- A[myc, myc] - (deg[myc] %*% t(deg[myc])) / 2 / ec + BG <- B - diag(rowSums(B)) + + expect_equal(M, BG) + 0 + } + + A <- as_adjacency_matrix(karate, sparse = FALSE) + ec <- ecount(karate) + deg <- degree(karate) + karate_lc2 <- cluster_leading_eigen(karate, callback = mod_mat_caller) +}) +test_that("cluster_leading_eigen is deterministic", { + ## Stress-test. We skip this on R 3.4 and 3.5 because it seems like + ## the results are not entirely deterministic there. + + skip_if(getRversion() < "3.6") + + for (i in 1:100) { + g_rand <- sample_gnm(20, sample(5:40, 1)) + lec1 <- cluster_leading_eigen(g_rand) + lec2 <- cluster_leading_eigen(g_rand) + expect_equal( + membership(lec1), + membership(lec2) + ) + } +}) + +test_that("cluster_leiden works", { + withr::local_seed(42) + + karate <- make_graph("Zachary") + karate_leiden <- cluster_leiden(karate, resolution = 0.06) + + expect_equal( + membership(karate_leiden), + c( + 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, + 1, 1, 1, 2, 2, 1, 1, 2, 1, 2, 1, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 + ) + ) + expect_length(karate_leiden, 2) + expect_equal( + sizes(karate_leiden), + structure( + c(17L, 17L), + .Dim = 2L, + .Dimnames = structure(list(`Community sizes` = c("1", "2")), + .Names = "Community sizes" + ), class = "table" + ) + ) + + karate_leiden_mod <- cluster_leiden(karate, "modularity") + + expect_equal( + membership(karate_leiden_mod), + c( + 1, 1, 1, 1, 2, 2, 2, 1, 3, 3, 2, 1, 1, + 1, 3, 3, 2, 1, 3, 1, 3, 1, 3, 4, 4, 4, + 3, 4, 4, 3, 3, 4, 3, 3 + ) + ) + expect_length(karate_leiden_mod, 4) + expect_equal( + sizes(karate_leiden_mod), + structure( + c(11L, 5L, 12L, 6L), + .Dim = 4L, + .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4")), + .Names = "Community sizes" + ), class = "table" + ) + ) +}) + +test_that("modularity_matrix works", { + karate <- make_graph("zachary") + + karate_fc <- cluster_fast_greedy(karate) + + karate_m1 <- modularity(karate, membership(karate_fc)) + karate_m2 <- modularity(karate, membership(karate_fc), weights = rep(1, ecount(karate))) + expect_equal(karate_m1, karate_m2) + + karate_modmat1 <- modularity_matrix(karate) + karate_modmat2 <- modularity_matrix(karate, weights = rep(1, ecount(karate))) + + expect_equal(karate_modmat1, karate_modmat2) +}) + +test_that("modularity_matrix still accepts a membership argument for compatibility", { + karate <- make_graph("zachary") + expect_snapshot( + x <- modularity_matrix(karate, membership = rep(1, vcount(karate))) + ) +}) + +test_that("cluster_louvain works", { + withr::local_seed(20231029) + + karate <- make_graph("Zachary") + karate_mc <- cluster_louvain(karate) + + expect_in(membership(karate_mc), 1:4) + expect_equal(modularity(karate, karate_mc$membership), max(karate_mc$modularity)) + expect_in(length(karate_mc), 3:4) + expect_in(membership(karate_mc), seq_len(length(karate_mc))) + expect_s3_class(sizes(karate_mc), "table") + expect_equal(sum(sizes(karate_mc)), vcount(karate)) + expect_identical(sizes(karate_mc), table(membership(karate_mc), dnn = "Community sizes")) +}) + +test_that("cluster_optimal works", { + skip_if_no_glpk() + + karate <- make_graph("Zachary") + karate_optimal <- cluster_optimal(karate) + + expect_equal( + membership(karate_optimal), + c( + 1, 1, 1, 1, 2, 2, 2, 1, 3, 3, 2, + 1, 1, 1, 3, 3, 2, 1, 3, 1, 3, 1, + 3, 4, 4, 4, 3, 4, 4, 3, 3, 4, 3, 3 + ) + ) + expect_equal(modularity(karate, karate_optimal$membership), karate_optimal$modularity) + expect_length(karate_optimal, 4) + expect_equal( + sizes(karate_optimal), + structure( + c(11L, 5L, 12L, 6L), + .Dim = 4L, + .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4")), + .Names = "Community sizes" + ), class = "table" + ) + ) +}) + +test_that("weighted cluster_optimal works", { + skip_if_no_glpk() + local_rng_version("3.5.0") + withr::local_seed(42) + + graph_full_ring <- make_full_graph(5) + make_ring(5) + E(graph_full_ring)$weight <- sample(1:2, ecount(graph_full_ring), replace = TRUE) + + graph_full_ring_optimal <- cluster_optimal(graph_full_ring) + expect_equal(modularity(graph_full_ring_optimal), 0.4032) +}) + +test_that("cluster_walktrap works", { + withr::local_seed(42) + + karate <- make_graph("Zachary") + karate_walktrap <- cluster_walktrap(karate) + + expect_equal(modularity(karate, membership(karate_walktrap)), modularity(karate_walktrap)) + expect_equal( + membership(karate_walktrap), + c(1, 1, 2, 1, 5, 5, 5, 1, 2, 2, 5, 1, 1, 2, 3, 3, 5, 1, 3, 1, 3, 1, 3, 4, 4, 4, 3, 4, 2, 3, 2, 2, 3, 3) + ) + expect_length(karate_walktrap, 5) + expect_equal( + sizes(karate_walktrap), + structure(c(9L, 7L, 9L, 4L, 5L), + .Dim = 5L, + .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4", "5")), .Names = "Community sizes"), class = "table" + ) + ) + + karate_dendro <- as.dendrogram(karate_walktrap) + expect_output(print(karate_dendro), "2 branches.*34 members.*height 33") + expect_output(print(karate_dendro[[1]]), "2 branches.*20 members.*height 31") + expect_output(print(karate_dendro[[2]]), "2 branches.*14 members.*height 32") + m2 <- cut_at(karate_walktrap, no = 3) + expect_equal( + modularity(karate, m2), + karate_walktrap$modularity[length(karate_walktrap$modularity) - 2] + ) +}) + +test_that("split_join_distance works", { + random_sjd <- unname(split_join_distance(rep(1:2, each = 17), rep(1, 34))) + expect_equal(random_sjd, c(0, 17)) + + karate <- make_graph("Zachary") + karate_split1 <- make_clusters(karate, rep(1:2, each = 17)) + karate_split2 <- make_clusters(karate, rep(1, 34)) + com_sjd <- unname(split_join_distance(karate_split1, karate_split2)) + expect_equal(com_sjd, c(0, 17)) +}) diff --git a/tests/testthat/test-edge.betweenness.community.R b/tests/testthat/test-edge.betweenness.community.R deleted file mode 100644 index 09270468a7b..00000000000 --- a/tests/testthat/test-edge.betweenness.community.R +++ /dev/null @@ -1,28 +0,0 @@ -test_that("cluster_edge_betweenness works", { - g <- make_graph("Zachary") - ebc <- cluster_edge_betweenness(g) - - expect_equal(max(ebc$modularity), modularity(g, ebc$membership)) - expect_equal( - as.vector(membership(ebc)), - c(1, 1, 2, 1, 3, 3, 3, 1, 4, 5, 3, 1, 1, 1, 4, 4, 3, 1, 4, 1, 4, 1, 4, 4, 2, 2, 4, 2, 2, 4, 4, 2, 4, 4) - ) - expect_equal(length(ebc), 5) - expect_equal(as.numeric(sizes(ebc)), c(10, 6, 5, 12, 1)) - - d <- as.dendrogram(ebc) - expect_output(print(d), "2 branches.*34 members.*height 33") - expect_output( - print(d[[1]]), - "2 branches.*15 members.*height 31" - ) - expect_output( - print(d[[2]]), - "2 branches.*19 members.*height 32" - ) - m2 <- cut_at(ebc, no = 3) - expect_equal( - modularity(g, m2), - ebc$modularity[length(ebc$modularity) - 2] - ) -}) diff --git a/tests/testthat/test-fastgreedy.community.R b/tests/testthat/test-fastgreedy.community.R deleted file mode 100644 index 51e5aab42f3..00000000000 --- a/tests/testthat/test-fastgreedy.community.R +++ /dev/null @@ -1,24 +0,0 @@ -test_that("cluster_fast_greedy works", { - withr::local_seed(42) - - g <- make_graph("Zachary") - fc <- cluster_fast_greedy(g) - - expect_equal(modularity(g, fc$membership), max(fc$modularity)) - expect_equal( - as.vector(membership(fc)), - c(1, 3, 3, 3, 1, 1, 1, 3, 2, 3, 1, 1, 3, 3, 2, 2, 1, 3, 2, 1, 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2) - ) - expect_equal(length(fc), 3) - expect_equal(as.numeric(sizes(fc)), c(8, 17, 9)) - - d <- as.dendrogram(fc) - expect_output(print(d), "2 branches.*34 members.*height 33") - expect_output(print(d[[1]]), "2 branches.*17 members.*height 32") - expect_output(print(d[[2]]), "2 branches.*17 members.*height 30") - m2 <- cut_at(fc, no = 3) - expect_equal( - modularity(g, m2), - fc$modularity[length(fc$modularity) - 2] - ) -}) diff --git a/tests/testthat/test-label.propagation.community.R b/tests/testthat/test-label.propagation.community.R deleted file mode 100644 index 5953c33bc91..00000000000 --- a/tests/testthat/test-label.propagation.community.R +++ /dev/null @@ -1,13 +0,0 @@ -test_that("label.propagation.community works", { - g <- make_graph("Zachary") - withr::local_seed(20231029) - lpc <- cluster_label_prop(g) - expect_equal(lpc$modularity, modularity(g, lpc$membership)) - # 1 2 3 4 5 - # 29 453 431 84 3 - expect_true(length(lpc) %in% 1:5) - expect_true(all(as.vector(membership(lpc)) %in% seq_len(length(lpc)))) - expect_s3_class(sizes(lpc), "table") - expect_equal(sum(sizes(lpc)), vcount(g)) - expect_identical(sizes(lpc), table(membership(lpc), dnn = "Community sizes")) -}) diff --git a/tests/testthat/test-leading.eigenvector.community.R b/tests/testthat/test-leading.eigenvector.community.R deleted file mode 100644 index 9aadd9be082..00000000000 --- a/tests/testthat/test-leading.eigenvector.community.R +++ /dev/null @@ -1,71 +0,0 @@ -test_that("cluster_leading_eigen works", { - withr::local_seed(20230115) - - ## Check-test - - f <- function(membership, community, value, vector, multiplier, extra) { - M <- sapply(1:length(vector), function(x) { - v <- rep(0, length(vector)) - v[x] <- 1 - multiplier(v) - }) - ev <- eigen(M) - ret <- 0 - expect_equal(ev$values[1], value) - if (sign(ev$vectors[1, 1]) != sign(vector[1])) { - ev$vectors <- -ev$vectors - } - expect_equal(ev$vectors[, 1], vector) - 0 - } - - g <- make_graph("Zachary") - lc <- cluster_leading_eigen(g, callback = f) - - expect_equal(lc$modularity, modularity(g, lc$membership)) - expect_equal( - as.vector(membership(lc)), - c(1, 3, 3, 3, 1, 1, 1, 3, 2, 2, 1, 1, 3, 3, 2, 2, 1, 3, 2, 3, 2, 3, 2, 4, 4, 4, 2, 4, 4, 2, 2, 4, 2, 2) - ) - expect_equal(length(lc), 4) - expect_equal( - sizes(lc), - structure(c(7L, 12L, 9L, 6L), .Dim = 4L, .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4")), .Names = "Community sizes"), class = "table") - ) - - ## Check that the modularity matrix is correct - - f <- function(membership, community, value, vector, multiplier, extra) { - M <- sapply(1:length(vector), function(x) { - v <- rep(0, length(vector)) - v[x] <- 1 - multiplier(v) - }) - myc <- membership == community - B <- A[myc, myc] - (deg[myc] %*% t(deg[myc])) / 2 / ec - BG <- B - diag(rowSums(B)) - - expect_equal(M, BG) - 0 - } - - g <- make_graph("Zachary") - A <- as_adjacency_matrix(g, sparse = FALSE) - ec <- ecount(g) - deg <- degree(g) - lc <- cluster_leading_eigen(g, callback = f) - - ## Stress-test. We skip this on R 3.4 and 3.5 because it seems like - ## the results are not entirely deterministic there. - skip_if(getRversion() < "3.6") - - for (i in 1:100) { - g <- sample_gnm(20, sample(5:40, 1)) - lec1 <- cluster_leading_eigen(g) - lec2 <- cluster_leading_eigen(g) - expect_equal( - as.vector(membership(lec1)), - as.vector(membership(lec2)) - ) - } -}) diff --git a/tests/testthat/test-leiden.R b/tests/testthat/test-leiden.R deleted file mode 100644 index 204377254c3..00000000000 --- a/tests/testthat/test-leiden.R +++ /dev/null @@ -1,29 +0,0 @@ -test_that("cluster_leiden works", { - withr::local_seed(42) - - g <- make_graph("Zachary") - mc <- cluster_leiden(g, resolution = 0.06) - - expect_equal( - as.vector(membership(mc)), - c(1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 2, 1, 1, 2, 1, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2) - ) - expect_equal(length(mc), 2) - expect_equal( - sizes(mc), - structure(c(17L, 17L), .Dim = 2L, .Dimnames = structure(list(`Community sizes` = c("1", "2")), .Names = "Community sizes"), class = "table") - ) - - withr::local_seed(42) - mc <- cluster_leiden(g, "modularity") - - expect_equal( - as.vector(membership(mc)), - c(1, 1, 1, 1, 2, 2, 2, 1, 3, 3, 2, 1, 1, 1, 3, 3, 2, 1, 3, 1, 3, 1, 3, 4, 4, 4, 3, 4, 4, 3, 3, 4, 3, 3) - ) - expect_equal(length(mc), 4) - expect_equal( - sizes(mc), - structure(c(11L, 5L, 12L, 6L), .Dim = 4L, .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4")), .Names = "Community sizes"), class = "table") - ) -}) diff --git a/tests/testthat/test-modularity_matrix.R b/tests/testthat/test-modularity_matrix.R deleted file mode 100644 index cf7dc5ea660..00000000000 --- a/tests/testthat/test-modularity_matrix.R +++ /dev/null @@ -1,21 +0,0 @@ -test_that("modularity_matrix works", { - kar <- make_graph("zachary") - - fc <- cluster_fast_greedy(kar) - - m1 <- modularity(kar, membership(fc)) - m2 <- modularity(kar, membership(fc), weights = rep(1, ecount(kar))) - expect_equal(m1, m2) - - B1 <- modularity_matrix(kar) - B2 <- modularity_matrix(kar, weights = rep(1, ecount(kar))) - - expect_equal(B1, B2) -}) - -test_that("modularity_matrix still accepts a membership argument for compatibility", { - kar <- make_graph("zachary") - expect_snapshot( - x <- modularity_matrix(kar, membership = rep(1, vcount(kar))) - ) -}) diff --git a/tests/testthat/test-multilevel.community.R b/tests/testthat/test-multilevel.community.R deleted file mode 100644 index daea4ee6ad3..00000000000 --- a/tests/testthat/test-multilevel.community.R +++ /dev/null @@ -1,16 +0,0 @@ -test_that("cluster_louvain works", { - withr::local_seed(20231029) - - g <- make_graph("Zachary") - mc <- cluster_louvain(g) - - expect_true(all(as.vector(membership(mc)) %in% 1:4)) - expect_equal(modularity(g, mc$membership), max(mc$modularity)) - # 3 4 - # 2 998 - expect_true(length(mc) %in% 3:4) - expect_true(all(as.vector(membership(mc)) %in% seq_len(length(mc)))) - expect_s3_class(sizes(mc), "table") - expect_equal(sum(sizes(mc)), vcount(g)) - expect_identical(sizes(mc), table(membership(mc), dnn = "Community sizes")) -}) diff --git a/tests/testthat/test-optimal.community.R b/tests/testthat/test-optimal.community.R deleted file mode 100644 index 3516e9ab07c..00000000000 --- a/tests/testthat/test-optimal.community.R +++ /dev/null @@ -1,29 +0,0 @@ -test_that("cluster_optimal works", { - skip_if_no_glpk() - - g <- make_graph("Zachary") - oc <- cluster_optimal(g) - - expect_equal( - as.vector(membership(oc)), - c(1, 1, 1, 1, 2, 2, 2, 1, 3, 3, 2, 1, 1, 1, 3, 3, 2, 1, 3, 1, 3, 1, 3, 4, 4, 4, 3, 4, 4, 3, 3, 4, 3, 3) - ) - expect_equal(modularity(g, oc$membership), oc$modularity) - expect_equal(length(oc), 4) - expect_equal( - sizes(oc), - structure(c(11L, 5L, 12L, 6L), .Dim = 4L, .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4")), .Names = "Community sizes"), class = "table") - ) -}) - -test_that("weighted cluster_optimal works", { - skip_if_no_glpk() - - local_rng_version("3.5.0") - withr::local_seed(42) - g <- make_full_graph(5) + make_ring(5) - E(g)$weight <- sample(1:2, ecount(g), replace = TRUE) - - oc <- cluster_optimal(g) - expect_equal(modularity(oc), 0.4032) -}) diff --git a/tests/testthat/test-walktrap.community.R b/tests/testthat/test-walktrap.community.R deleted file mode 100644 index 57c53eef9d1..00000000000 --- a/tests/testthat/test-walktrap.community.R +++ /dev/null @@ -1,23 +0,0 @@ -test_that("cluster_walktrap works", { - g <- make_graph("Zachary") - withr::local_seed(42) - wc <- cluster_walktrap(g) - - expect_equal(modularity(g, membership(wc)), modularity(wc)) - expect_equal( - as.vector(membership(wc)), - c(1, 1, 2, 1, 5, 5, 5, 1, 2, 2, 5, 1, 1, 2, 3, 3, 5, 1, 3, 1, 3, 1, 3, 4, 4, 4, 3, 4, 2, 3, 2, 2, 3, 3) - ) - expect_equal(length(wc), 5) - expect_equal(sizes(wc), structure(c(9L, 7L, 9L, 4L, 5L), .Dim = 5L, .Dimnames = structure(list(`Community sizes` = c("1", "2", "3", "4", "5")), .Names = "Community sizes"), class = "table")) - - d <- as.dendrogram(wc) - expect_output(print(d), "2 branches.*34 members.*height 33") - expect_output(print(d[[1]]), "2 branches.*20 members.*height 31") - expect_output(print(d[[2]]), "2 branches.*14 members.*height 32") - m2 <- cut_at(wc, no = 3) - expect_equal( - modularity(g, m2), - wc$modularity[length(wc$modularity) - 2] - ) -})