test: merged and refactored components.R tests

R/components.R

@@ -319,9 +319,7 @@ is_biconnected <- is_biconnected_impl
 #' @rdname components
 #' @export
 largest_component <- function(graph, mode = c("weak", "strong")) {
-  if (!is_igraph(graph)) {
-    stop("Not a graph object")
-  }
+  ensure_igraph(graph)
 
   comps <- components(graph, mode = mode)
 

tests/testthat/test-community.R

@@ -435,3 +435,15 @@ test_that("split_join_distance works", {
   com_sjd <- unname(split_join_distance(karate_split1, karate_split2))
   expect_equal(com_sjd, c(0, 17))
 })
+
+test_that("groups works", {
+  g <- make_ring(10) + make_full_graph(5)
+  gr <- groups(components(g))
+
+  expect_equal(gr, structure(list(`1` = 1:10, `2` = 11:15), .Dim = 2L, .Dimnames = list(c("1", "2"))))
+
+  V(g)$name <- letters[1:15]
+  gr <- groups(components(g))
+
+  expect_equal(gr, structure(list(`1` = letters[1:10], `2` = letters[11:15]), .Dim = 2L, .Dimnames = list(c("1", "2"))))
+})

tests/testthat/test-components.R

@@ -0,0 +1,219 @@
+test_that("components works", {
+  withr::local_seed(42)
+
+  random_largest_component <- function(n) {
+    largest_component(sample_gnp(n, 1 / n))
+  }
+
+  random_lg_list <- lapply(1:30, function(x) random_largest_component(sample(100, 1)))
+  lg_size <- sapply(random_lg_list, vcount)
+
+  dis_union <- disjoint_union(random_lg_list)
+  clu <- components(dis_union)
+
+  expect_equal(as.numeric(table(clu$membership)), clu$csize)
+  expect_equal(sort(clu$csize), sort(lg_size))
+  expect_equal(clu$no, length(random_lg_list))
+})
+
+test_that("components names results", {
+  g <- make_ring(10) + make_full_graph(5)
+  V(g)$name <- letters[1:15]
+
+  clu <- components(g)
+  expect_named(clu$membership, letters[1:15])
+})
+
+test_that("is_connected works", {
+  ring <- make_ring(10)
+  expect_true(is_connected(ring))
+
+  g <- make_ring(10) + make_full_graph(5)
+  expect_false(is_connected(g))
+})
+
+test_that("is_connected returns FALSE for the null graph", {
+  empty <- make_empty_graph(0)
+  expect_false(is_connected(empty))
+})
+
+test_that("decompose works", {
+  gnp <- sample_gnp(1000, 1 / 1500)
+  gnp_decomposed <- decompose(gnp)
+  gnp_comps <- components(gnp)
+  Gsizes <- sapply(gnp_decomposed, vcount)
+  expect_equal(sort(gnp_comps$csize), sort(Gsizes))
+})
+
+test_that("decompose works for many components", {
+  large_empty <- make_empty_graph(5001)
+  large_empty_decompose <- decompose(large_empty)
+  expect_length(large_empty_decompose, 5001)
+})
+
+test_that("decompose works for many components and attributes", {
+  large_empty <- make_empty_graph(5001)
+  V(large_empty)$name <- seq_len(vcount(large_empty))
+  large_empty_decompose <- decompose(large_empty)
+  expect_length(large_empty_decompose, 5001)
+})
+
+test_that("decompose keeps attributes", {
+  g <- make_ring(10) + make_ring(5)
+  V(g)$name <- letters[1:(10 + 5)]
+  E(g)$name <- apply(as_edgelist(g), 1, paste, collapse = "-")
+  g_decompose <- decompose(g)
+  g_decompose <- g_decompose[order(sapply(g_decompose, vcount))]
+
+  expect_length(g_decompose, 2)
+  expect_equal(sapply(g_decompose, vcount), c(5, 10))
+  expect_equal(V(g_decompose[[1]])$name, letters[1:5 + 10])
+  expect_equal(V(g_decompose[[2]])$name, letters[1:10])
+  e1 <- apply(as_edgelist(g_decompose[[1]]), 1, paste, collapse = "-")
+  e2 <- apply(as_edgelist(g_decompose[[2]]), 1, paste, collapse = "-")
+  expect_equal(E(g_decompose[[1]])$name, e1)
+  expect_equal(E(g_decompose[[2]])$name, e2)
+})
+
+test_that("component_distribution() finds correct distribution", {
+  g <- graph_from_literal(
+    A,
+    B - C,
+    D - E - F,
+    G - H
+  )
+
+  ref <- c(0.00, 0.25, 0.50, 0.25)
+
+  expect_equal(component_distribution(g), ref)
+})
+
+test_that("largest component is actually the largest", {
+  star <- make_star(20, "undirected")
+  ring <- make_ring(10)
+
+  dis_union <- disjoint_union(star, ring)
+
+  expect_isomorphic(largest_component(dis_union), star)
+})
+
+test_that("largest strongly and weakly components are correct", {
+  g <- graph_from_literal(
+    A - +B,
+    B - +C,
+    C - +A,
+    C - +D,
+    E
+  )
+
+  strongly <- graph_from_literal(
+    A - +B,
+    B - +C,
+    C - +A
+  )
+  expect_true(isomorphic(largest_component(g, "strong"), strongly))
+
+  weakly <- graph_from_literal(
+    A - +B,
+    B - +C,
+    C - +A,
+    C - +D
+  )
+  expect_true(isomorphic(largest_component(g, "weak"), weakly))
+})
+
+test_that("the largest component of a null graph is a valid null graph", {
+  nullgraph <- make_empty_graph(0)
+
+  expect_true(isomorphic(largest_component(make_empty_graph(0)), nullgraph))
+})
+
+test_that("articulation_points works", {
+  g <- make_full_graph(5) + make_full_graph(5)
+  g_comps <- components(g)$membership
+  g <- add_edges(g, c(match(1, g_comps), match(2, g_comps)))
+
+  ap <- as.vector(articulation_points(g))
+  deg <- degree(g)
+  expect_equal(sort(which(deg == max(deg))), sort(ap))
+})
+
+test_that("bridges works", {
+  kite <- make_graph("krackhardt_kite")
+  expect_equal(sort(as.vector(bridges(kite))), (ecount(kite) - 1):(ecount(kite)))
+})
+
+test_that("biconnected_components works", {
+  g <- make_full_graph(5) + make_full_graph(5)
+  g_comps <- components(g)$membership
+  g <- add_edges(g, c(match(1, g_comps), match(2, g_comps)))
+
+  sortlist <- function(list) {
+    list <- lapply(list, sort)
+    list <- lapply(list, as.vector)
+    list[order(sapply(list, paste, collapse = "x"))]
+  }
+
+  bc <- biconnected_components(g)
+  expect_equal(bc$no, 3)
+  expect_equal(sortlist(bc$tree_edges), list(c(11, 15, 18, 20), c(1, 5, 8, 10), 21))
+  expect_equal(sortlist(bc$component_edges), list(11:20, 1:10, 21))
+  expect_equal(sortlist(bc$components), list(1:5, c(1, 6), 6:10))
+  expect_equal(sort(as.vector(bc$articulation_points)), c(1, 6))
+
+  expect_equal(sort(names(bc)), c(
+    "articulation_points",
+    "component_edges",
+    "components",
+    "no",
+    "tree_edges"
+  ))
+  expect_s3_class(bc$articulation_points, "igraph.vs")
+  expect_s3_class(bc$components[[1]], "igraph.vs")
+  expect_s3_class(bc$component_edges[[1]], "igraph.es")
+})
+
+test_that("biconnected_components works without igraph.vs.es", {
+  local_igraph_options(return.vs.es = FALSE)
+
+  g <- make_full_graph(5) + make_full_graph(5)
+  clu <- components(g)$membership
+  g <- add_edges(g, c(match(1, clu), match(2, clu)))
+
+  sortlist <- function(list) {
+    list <- lapply(list, sort)
+    list[order(sapply(list, paste, collapse = "x"))]
+  }
+
+  bc <- biconnected_components(g)
+  expect_equal(bc$no, 3)
+  expect_equal(sortlist(bc$tree_edges), list(c(11, 15, 18, 20), c(1, 5, 8, 10), 21))
+  expect_equal(sortlist(bc$component_edges), list(11:20, 1:10, 21))
+  expect_equal(sortlist(bc$components), list(1:5, c(1, 6), 6:10))
+  expect_equal(sort(bc$articulation_points), c(1, 6))
+
+  expect_equal(sort(names(bc)), c(
+    "articulation_points",
+    "component_edges",
+    "components",
+    "no",
+    "tree_edges"
+  ))
+})
+
+test_that("is_biconnected works", {
+  g <- make_full_graph(0)
+  expect_false(is_biconnected(g))
+
+  g <- make_full_graph(1)
+  expect_false(is_biconnected(g))
+
+  g <- make_full_graph(2)
+  expect_true(is_biconnected(g))
+
+  g <- make_full_graph(3)
+  expect_true(is_biconnected(g))
+
+  g <- make_graph(c(1, 2, 2, 3, 3, 1, 1, 4, 4, 4))
+  expect_false(is_biconnected(g))
+})