test_that("automorphisms works", { ring <- make_ring(10) expect_equal(count_automorphisms(ring)$group_size, "20") full <- make_full_graph(4) expect_equal(count_automorphisms(full)$group_size, "24") }) test_that("automorphisms works with colored graphs", { g <- make_full_graph(4) expect_equal(count_automorphisms(g, colors = c(1, 2, 1, 2))$group_size, "4") V(g)$color <- c(1, 2, 1, 2) expect_equal(count_automorphisms(g)$group_size, "4") expect_equal(count_automorphisms(g, colors = NULL)$group_size, "24") }) test_that("automorphism_group works", { ring <- make_ring(10) aut_ring <- lapply(automorphism_group(ring), as.vector) aut_ring <- aut_ring[order(sapply(aut_ring, "[[", 1))] expect_equal(aut_ring, list(c(1, 10:2), c(2:10, 1))) full <- make_full_graph(4) aut_full <- lapply(automorphism_group(full), as.vector) aut_full <- aut_full[order(sapply(aut_full, "[[", 1))] expect_equal(aut_full, list(c(1, 2, 4, 3), c(1, 3, 2, 4), c(2, 1, 3, 4))) }) test_that("automorphism_group works with colored graphs", { full <- make_full_graph(4) aut_full <- lapply( automorphism_group(full, colors = c(1, 2, 1, 2)), as.vector ) aut_full <- aut_full[order(sapply(aut_full, "[[", 1))] expect_equal(aut_full, list(c(1, 4, 3, 2), c(3, 2, 1, 4))) V(full)$color <- c(1, 2, 1, 2) aut_full_col <- lapply(automorphism_group(full), as.vector) aut_full_col <- aut_full_col[order(sapply(aut_full_col, "[[", 1))] expect_equal(aut_full_col, list(c(1, 4, 3, 2), c(3, 2, 1, 4))) }) test_that("isomorphisms() works", { motif <- make_empty_graph(directed = FALSE) + vertices("D1", "D2", type = c("type1", "type1")) + edges("D1", "D2", type = c("type2")) motif_iso <- isomorphisms( motif, motif, method = "vf2", vertex.color1 = 2:1, vertex.color2 = 1:2 ) expect_length(motif_iso, 1) expect_equal(as.numeric(motif_iso[[1]]), 2:1) }) test_that("subgraph_isomorphisms works", { motif <- make_empty_graph(directed = FALSE) + vertices("D1", "D2", type = c("type1", "type1")) + edges("D1", "D2", type = c("type2")) out <- subgraph_isomorphisms( target = motif, pattern = motif, method = "vf2", vertex.color1 = 2:1, vertex.color2 = 1:2 ) expect_length(out, 1) expect_equal(as.numeric(out[[1]]), 2:1) }) test_that("graph.get.subisomorphisms.vf2() works even if the graph has a vertex attribute named x", { g <- make_full_graph(4) V(g)$x <- 1:4 subs <- graph.get.subisomorphisms.vf2(g, make_ring(4)) expect_equal(length(subs), 24) }) test_that("VF2 isomorphism considers colors", { full <- make_full_graph(3) path <- make_ring(3, circular = FALSE) V(full)$color <- c(1, 1, 2) V(path)$color <- c(1, 2, 1) n <- count_subgraph_isomorphisms(path, full, method = "vf2") expect_equal(n, 2) }) test_that("canonical_permutation works", { g1 <- sample_gnm(10, 20) cp1 <- canonical_permutation(g1) cf1 <- permute(g1, cp1$labeling) ## Do the same with a random permutation of it g2 <- permute(g1, sample(vcount(g1))) cp2 <- canonical_permutation(g2) cf2 <- permute(g2, cp2$labeling) ## Check that they are the same el1 <- as_edgelist(cf1) el2 <- as_edgelist(cf2) el1 <- el1[order(el1[, 1], el1[, 2]), ] el2 <- el2[order(el2[, 1], el2[, 2]), ] expect_equal(el1, el2) }) test_that("isomorphism_class works", { g_iso10 <- graph_from_isomorphism_class(3, 10) g_iso11 <- graph_from_isomorphism_class(3, 11) expect_equal(isomorphism_class(g_iso10), 10) expect_equal(isomorphism_class(g_iso11), 11) g_iso10_1 <- add_vertices(g_iso10, 3) expect_equal(graph.isoclass.subgraph(g_iso10_1, 1:3), 10) expect_equal(graph.isoclass.subgraph(g_iso10_1 %du% g_iso11, 1:3), 10) expect_equal(graph.isoclass.subgraph(g_iso10_1 %du% g_iso11, 7:9), 11) }) test_that("graph.subisomorphic, method = 'lad' works", { pattern <- graph_from_literal( 1:2:3:4:5, 1 - 2:5, 2 - 1:5:3, 3 - 2:4, 4 - 3:5, 5 - 4:2:1 ) target <- graph_from_literal( 1:2:3:4:5:6:7:8:9, 1 - 2:5:7, 2 - 1:5:3, 3 - 2:4, 4 - 3:5:6:8:9, 5 - 1:2:4:6:7, 6 - 7:5:4:9, 7 - 1:5:6, 8 - 4:9, 9 - 6:4:8 ) domains <- list( `1` = c(1, 3, 9), `2` = c(5, 6, 7, 8), `3` = c(2, 4, 6, 7, 8, 9), `4` = c(1, 3, 9), `5` = c(2, 4, 8, 9) ) sub_iso1 <- subgraph_isomorphic(pattern, target, method = "lad") sub_iso2 <- subgraph_isomorphic( pattern, target, induced = TRUE, method = "lad" ) sub_iso3 <- subgraph_isomorphic( pattern, target, domains = domains, method = "lad" ) expect_true(sub_iso1) expect_true(sub_iso2) expect_true(sub_iso3) }) test_that("LAD stress test", { local_rng_version("3.5.0") withr::local_seed(42) N <- 100 for (i in 1:N) { target <- sample_gnp(20, .5) pn <- sample(4:18, 1) pattern <- induced_subgraph(target, sample(vcount(target), pn)) iso <- subgraph_isomorphic(pattern, target, induced = TRUE, method = "lad") expect_true(iso) } withr::local_seed(42) for (i in 1:N) { target <- sample_gnp(20, 1 / 20) pn <- sample(5:18, 1) pattern <- sample_gnp(pn, .6) iso <- subgraph_isomorphic(pattern, target, induced = TRUE, method = "lad") expect_false(iso) } }) test_that("graph.subisomorphic.vf2 works", { withr::local_seed(42) gnp1 <- sample_gnp(20, 6 / 20) gnp2 <- sample_gnp(20, 6 / 20) g <- gnp1 %du% gnp2 g1_iso <- graph.subisomorphic.vf2(g, gnp1) expect_true(g1_iso$iso) expect_equal(g1_iso$map12, c(1:vcount(gnp1), rep(0, vcount(gnp2)))) expect_equal(g1_iso$map21, 1:vcount(gnp1)) g2_iso <- graph.subisomorphic.vf2(g, gnp2) expect_true(g2_iso$iso) expect_equal(g2_iso$map12, c(rep(0, vcount(gnp1)), 1:vcount(gnp2))) expect_equal(g2_iso$map21, 1:vcount(gnp2) + vcount(gnp1)) }) test_that("isomorphic", { g1 <- graph_from_literal(A - B - C - A) expect_isomorphic(g1, g1) expect_isomorphic(g1, g1, method = "direct") expect_isomorphic(g1, g1, method = "vf2") expect_isomorphic(g1, g1, method = "bliss") g2 <- graph_from_literal(A - B - C) expect_not_isomorphic(g1, g2) expect_not_isomorphic(g1, g2, method = "direct") expect_not_isomorphic(g1, g2, method = "vf2") expect_not_isomorphic(g1, g2, method = "bliss") }) test_that("subgraph_isomorphic", { g1 <- graph_from_literal(A - B - C - D - E - A) g2 <- graph_from_literal(A - B - C - D) expect_true(subgraph_isomorphic(g2, g1)) expect_true(subgraph_isomorphic(g2, g1, method = "vf2")) expect_true(subgraph_isomorphic(g2, g1, method = "lad")) g3 <- graph_from_literal(A - B - C - A) expect_false(subgraph_isomorphic(g3, g1)) expect_false(subgraph_isomorphic(g3, g1, method = "vf2")) expect_false(subgraph_isomorphic(g3, g1, method = "lad")) }) test_that("count_isomorphisms", { g1 <- graph_from_literal(A - B - C - D - A) expect_equal(count_isomorphisms(g1, g1), 8) g2 <- graph_from_literal(A - B - C - A) expect_equal(count_isomorphisms(g1, g2), 0) }) test_that("count_isomorphisms_with_colors", { expect_equal( count_isomorphisms( make_ring(3), make_ring(3), edge.color1 = c(2, 2, 2), edge.color2 = c(2, 2, 2), vertex.color1 = c(3, 3, 3), vertex.color2 = c(3, 3, 3), method = "vf2" ), 6 ) expect_equal( count_isomorphisms( make_ring(3), make_ring(3), edge.color1 = c(2, 2, 2), edge.color2 = c(2, 2, 2), vertex.color1 = c(1, 2, 3), vertex.color2 = c(1, 2, 3), method = "vf2" ), 1 ) expect_equal( count_isomorphisms( make_ring(3), make_ring(3), edge.color1 = c(2, 2, 3), edge.color2 = c(3, 2, 2), vertex.color1 = c(3, 3, 3), vertex.color2 = c(3, 3, 3), method = "vf2" ), 2 ) }) test_that("count_subgraph_isomorphisms", { g1 <- graph_from_literal(A - B - C - D - A) g2 <- graph_from_literal(A - B - C - D) expect_equal(count_subgraph_isomorphisms(g2, g1, method = "lad"), 8) expect_equal(count_subgraph_isomorphisms(g2, g1, method = "vf2"), 8) g3 <- graph_from_literal(A - B - C - A) expect_equal(count_subgraph_isomorphisms(g3, g1, method = "lad"), 0) expect_equal(count_subgraph_isomorphisms(g3, g1, method = "vf2"), 0) }) test_that("isomorphisms", { g1 <- graph_from_literal(A - B - C - D - A) g2 <- graph_from_literal(W - X - Y - Z - W) res <- list( V(g2)[1, 2, 3, 4], V(g2)[1, 4, 3, 2], V(g2)[2, 1, 4, 3], V(g2)[2, 3, 4, 1], V(g2)[3, 2, 1, 4], V(g2)[3, 4, 1, 2], V(g2)[4, 1, 2, 3], V(g2)[4, 3, 2, 1] ) expect_equal(ignore_attr = TRUE, isomorphisms(g1, g2), res) g3 <- graph_from_literal(X - Y - Z - X) expect_equal(isomorphisms(g1, g3), list()) }) test_that("subgraph_isomorphisms, lad", { g1 <- graph_from_literal(A - B - C - D - A) g2 <- graph_from_literal(Z - X - Y) res <- list( V(g1)[1, 4, 3], V(g1)[1, 2, 3], V(g1)[2, 1, 4], V(g1)[2, 3, 4], V(g1)[3, 2, 1], V(g1)[3, 4, 1], V(g1)[4, 3, 2], V(g1)[4, 1, 2] ) expect_equal( ignore_attr = TRUE, subgraph_isomorphisms(g2, g1, method = "lad"), res ) g3 <- graph_from_literal(X - Y - Z - X) expect_equal(subgraph_isomorphisms(g3, g1, method = "lad"), list()) }) test_that("subgraph_isomorphisms, vf2", { g1 <- graph_from_literal(A - B - C - D - A) g2 <- graph_from_literal(Z - X - Y) res <- list( V(g1)[1, 2, 3], V(g1)[1, 4, 3], V(g1)[2, 1, 4], V(g1)[2, 3, 4], V(g1)[3, 2, 1], V(g1)[3, 4, 1], V(g1)[4, 1, 2], V(g1)[4, 3, 2] ) expect_equal( ignore_attr = TRUE, subgraph_isomorphisms(g2, g1, method = "vf2"), res ) g3 <- graph_from_literal(X - Y - Z - X) expect_equal(subgraph_isomorphisms(g3, g1, method = "vf2"), list()) })