diff --git a/R/community.R b/R/community.R index 352f534ba11..04ac00f5e0e 100644 --- a/R/community.R +++ b/R/community.R @@ -1241,15 +1241,44 @@ cut_at <- function(communities, no, steps) { cli::cli_abort("Please use either {.arg no} or {.arg steps} (but not both)") } + mm <- merges(communities) + + # The leading eigenvector algorithm uses a different merges format: + # merges operate on communities rather than vertices, so we need the + # dedicated igraph_le_community_to_membership function. + if (isTRUE(communities$algorithm == "leading eigenvector")) { + n_initial <- max(communities$membership) + if (!missing(steps)) { + if (steps > nrow(mm)) { + cli::cli_warn("Cannot make that many steps.") + steps <- nrow(mm) + } + } else { + min_communities <- n_initial - nrow(mm) # minimum number of communities after all merges + if (no > n_initial) { + cli::cli_warn("Cannot have that many communities.") + no <- n_initial + } else if (no < min_communities) { + cli::cli_warn("Cannot have that few communities.") + no <- min_communities + } + steps <- n_initial - no + } + res <- le_community_to_membership_impl( + merges = mm - 1L, + steps = steps, + membership = communities$membership - 1L + ) + return(res$membership + 1L) + } + if (!missing(steps)) { - mm <- merges(communities) if (steps > nrow(mm)) { cli::cli_warn("Cannot make that many steps.") steps <- nrow(mm) } community.to.membership2(mm, communities$vcount, steps) } else { - mm <- merges(communities) noc <- communities$vcount - nrow(mm) # final number of communities if (no < noc) { cli::cli_warn("Cannot have that few communities.") diff --git a/tests/testthat/test-community.R b/tests/testthat/test-community.R index a5ba5644e72..aa8e3739092 100644 --- a/tests/testthat/test-community.R +++ b/tests/testthat/test-community.R @@ -304,6 +304,49 @@ test_that("cluster_leading_eigen is deterministic", { } }) +test_that("cut_at works with cluster_leading_eigen partial dendrograms", { + g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5) + g <- add_edges(g, c(1, 6, 1, 11, 6, 11)) + lec <- cluster_leading_eigen(g) + + # The algorithm finds 3 communities, with a partial dendrogram (2 merges) + expect_equal(max(membership(lec)), 3L) + expect_equal(nrow(lec$merges), 2L) + + # cut_at with no= should return the original 3 communities + m3 <- cut_at(lec, no = 3) + expect_equal(length(unique(m3)), 3L) + expect_equal(m3, membership(lec)) + + # cut_at with no=2 should merge 2 of the 3 communities + m2 <- cut_at(lec, no = 2) + expect_equal(length(unique(m2)), 2L) + + # cut_at with no=1 should put all vertices in one community + m1 <- cut_at(lec, no = 1) + expect_equal(length(unique(m1)), 1L) + expect_true(all(m1 == m1[1])) + + # cut_at with steps= should work equivalently + expect_equal(cut_at(lec, steps = 0), cut_at(lec, no = 3)) + expect_equal(cut_at(lec, steps = 1), cut_at(lec, no = 2)) + expect_equal(cut_at(lec, steps = 2), cut_at(lec, no = 1)) + + # Asking for too many communities should warn and clamp + expect_warning( + m_excess <- cut_at(lec, no = 10), + "Cannot have that many communities" + ) + expect_equal(m_excess, membership(lec)) + + # Asking for too many steps should warn and clamp + expect_warning( + m_excess_steps <- cut_at(lec, steps = 10), + "Cannot make that many steps" + ) + expect_equal(m_excess_steps, cut_at(lec, no = 1)) +}) + test_that("cluster_leiden works", { withr::local_seed(42)