tests/testthat/test-components.R

In igraph/rigraph: Network Analysis and Visualization

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_isomorphic(largest_component(g, "strong"), strongly)

  weakly <- graph_from_literal(
    A -+ B,
    B -+ C,
    C -+ A,
    C -+ D
  )
  expect_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_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))
})