From 077c2fbe547bb9430075208934aae36e2bd74787 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Wed, 19 Feb 2025 15:52:28 +0100 Subject: [PATCH 1/5] test: create and use `expect_vcount()` --- tests/testthat/helper.R | 4 ++++ tests/testthat/test-coloring.R | 2 +- tests/testthat/test-games.R | 30 +++++++++++++++--------------- tests/testthat/test-interface.R | 2 +- tests/testthat/test-make.R | 10 +++++----- tests/testthat/test-operators.R | 12 ++++++------ tests/testthat/test-operators3.R | 2 +- tests/testthat/test-trees.R | 24 ++++++++++++------------ 8 files changed, 45 insertions(+), 41 deletions(-) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index c3c79d0af9f..da881ef7405 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -23,3 +23,7 @@ local_rng_version <- function(version, .local_envir = parent.frame()) { expect_isomorphic <- function(g1, g2) { expect_true(isomorphic(g1, g2)) } + +expect_vcount <- function(graph, expected, ...) { + expect_equal(object = vcount(graph), expected = expected, ...) +} diff --git a/tests/testthat/test-coloring.R b/tests/testthat/test-coloring.R index 80351c86ddc..d4da698d7e5 100644 --- a/tests/testthat/test-coloring.R +++ b/tests/testthat/test-coloring.R @@ -27,7 +27,7 @@ test_that("simplify_and_colorize works", { result <- simplify_and_colorize(g) expect_true(is_simple(result)) - expect_equal(vcount(result), vcount(g)) + expect_vcount(result, vcount(g)) expect_equal(as_edgelist(result), matrix(c(1:4, 2:5), ncol = 2)) expect_equal(V(result)$color, c(0, 0, 0, 0, 1)) expect_equal(E(result)$color, c(1, 4, 1, 2)) diff --git a/tests/testthat/test-games.R b/tests/testthat/test-games.R index fe602cbdbfe..23acf474bd3 100644 --- a/tests/testthat/test-games.R +++ b/tests/testthat/test-games.R @@ -253,17 +253,17 @@ test_that("sample_pa() works", { g_pa <- sample_pa(100, m = 2) expect_equal(ecount(g_pa), 197) - expect_equal(vcount(g_pa), 100) + expect_vcount(g_pa, 100) expect_true(is_simple(g_pa)) g_pa2 <- sample_pa(100, m = 2, algorithm = "psumtree-multiple") expect_equal(ecount(g_pa2), 198) - expect_equal(vcount(g_pa2), 100) + expect_vcount(g_pa2, 100) expect_false(is_simple(g_pa2)) g_pa3 <- sample_pa(100, m = 2, algorithm = "bag") expect_equal(ecount(g_pa3), 198) - expect_equal(vcount(g_pa3), 100) + expect_vcount(g_pa3, 100) expect_false(is_simple(g_pa3)) g_pa4 <- sample_pa(3, out.seq = 0:2, directed = FALSE) @@ -278,7 +278,7 @@ test_that("sample_pa can start from a graph", { g_pa1 <- sample_pa(10, m = 1, algorithm = "bag", start.graph = make_empty_graph(5)) expect_equal(ecount(g_pa1), 5) - expect_equal(vcount(g_pa1), 10) + expect_vcount(g_pa1, 10) is_degree_zero <- (degree(g_pa1) == 0) expect_true(sum(is_degree_zero) %in% 0:4) @@ -329,7 +329,7 @@ test_that("sample_bipartite works -- undirected gnp", { g_rand_bip <- sample_bipartite(10, 5, type = "gnp", p = .1) expect_equal(g_rand_bip$name, "Bipartite Gnp random graph") - expect_equal(vcount(g_rand_bip), 15) + expect_vcount(g_rand_bip, 15) expect_equal(ecount(g_rand_bip), 7) expect_true(bipartite_mapping(g_rand_bip)$res) expect_false(is_directed(g_rand_bip)) @@ -337,7 +337,7 @@ test_that("sample_bipartite works -- undirected gnp", { test_that("sample_bipartite works -- directed gnp", { g_rand_bip_dir <- sample_bipartite(10, 5, type = "gnp", p = .1, directed = TRUE) - expect_equal(vcount(g_rand_bip_dir), 15) + expect_vcount(g_rand_bip_dir, 15) expect_equal(ecount(g_rand_bip_dir), 6) expect_true(bipartite_mapping(g_rand_bip_dir)$res) expect_true(is_directed(g_rand_bip_dir)) @@ -349,21 +349,21 @@ test_that("sample_bipartite works -- directed gnp", { test_that("sample_bipartite works -- undirected gnm", { g_rand_bip_gnm <- sample_bipartite(10, 5, type = "gnm", m = 8) - expect_equal(vcount(g_rand_bip_gnm), 15) + expect_vcount(g_rand_bip_gnm, 15) expect_equal(ecount(g_rand_bip_gnm), 8) expect_true(bipartite_mapping(g_rand_bip_gnm)$res) expect_false(is_directed(g_rand_bip_gnm)) }) test_that("sample_bipartite works -- directed gnm", { g_rand_bip_gnm_dir <- sample_bipartite(10, 5, type = "gnm", m = 8, directed = TRUE) - expect_equal(vcount(g_rand_bip_gnm_dir), 15) + expect_vcount(g_rand_bip_gnm_dir, 15) expect_equal(ecount(g_rand_bip_gnm_dir), 8) expect_true(bipartite_mapping(g_rand_bip_gnm_dir)$res) expect_true(is_directed(g_rand_bip_gnm_dir)) expect_output(print_all(g_rand_bip_gnm_dir), "5->12") g_rand_bip_gnm_in <- sample_bipartite(10, 5, type = "gnm", m = 8, directed = TRUE, mode = "in") - expect_equal(vcount(g_rand_bip_gnm_in), 15) + expect_vcount(g_rand_bip_gnm_in, 15) expect_equal(ecount(g_rand_bip_gnm_in), 8) expect_true(bipartite_mapping(g_rand_bip_gnm_in)$res) expect_true(is_directed(g_rand_bip_gnm_in)) @@ -438,7 +438,7 @@ test_that("sample_correlated_gnp corner cases work", { cor_gnp_empty <- sample_correlated_gnp(gnp_graph, corr = 0.000001, p = 0.0000001) expect_equal(ecount(cor_gnp_empty), 0) - expect_equal(vcount(cor_gnp_empty), 10) + expect_vcount(cor_gnp_empty, 10) gnp_graph_directed <- sample_gnp(10, .3, directed = TRUE) cor_gnp_directed <- sample_correlated_gnp(gnp_graph_directed, corr = 0.000001, p = .99999999) @@ -446,7 +446,7 @@ test_that("sample_correlated_gnp corner cases work", { cor_gnp_directed_empty <- sample_correlated_gnp(gnp_graph_directed, corr = 0.000001, p = 0.0000001) expect_equal(ecount(cor_gnp_directed_empty), 0) - expect_equal(vcount(cor_gnp_directed_empty), 10) + expect_vcount(cor_gnp_directed_empty, 10) }) test_that("permutation works for sample_correlated_gnp", { @@ -475,28 +475,28 @@ test_that("HSBM works", { g_hsbm1 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 0) expect_equal(ecount(g_hsbm1), 172) - expect_equal(vcount(g_hsbm1), 100) + expect_vcount(g_hsbm1, 100) expect_false(is_directed(g_hsbm1)) withr::local_seed(42) g_hsbm2 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1) expect_equal(ecount(g_hsbm2), ecount(g_hsbm1) + 10 * 9 * (90 + 10) / 2) - expect_equal(vcount(g_hsbm2), 100) + expect_vcount(g_hsbm2, 100) expect_true(is_simple(g_hsbm2)) withr::local_seed(42) g_hsbm3 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1e-15) expect_equal(ecount(g_hsbm3), ecount(g_hsbm1)) - expect_equal(vcount(g_hsbm3), 100) + expect_vcount(g_hsbm3, 100) expect_true(is_simple(g_hsbm3)) withr::local_seed(42) g_hsbm4 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1 - 1e-15) expect_equal(ecount(g_hsbm4), ecount(g_hsbm2)) - expect_equal(vcount(g_hsbm4), 100) + expect_vcount(g_hsbm4, 100) expect_true(is_simple(g_hsbm4)) }) diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index 91669ee58af..43f7eeb5e48 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -49,7 +49,7 @@ test_that("add_vertices works", { nv <- 4 g2 <- add_vertices(g, nv = nv) - expect_equal(vcount(g2), vcount(g) + nv) + expect_vcount(g2, vcount(g) + nv) expect_equal(ecount(g2), ecount(g)) expect_equal(as_edgelist(g2), as_edgelist(g)) }) diff --git a/tests/testthat/test-make.R b/tests/testthat/test-make.R index 34787888db1..d59ff829c25 100644 --- a/tests/testthat/test-make.R +++ b/tests/testthat/test-make.R @@ -12,10 +12,10 @@ test_that("make_ works, order of arguments does not matter", { test_that("make_ works with n parameter", { g0 <- make_undirected_graph(1:10, n = 15) - expect_equal(vcount(g0), 15) + expect_vcount(g0, 15) g1 <- make_directed_graph(1:10, n = 15) - expect_equal(vcount(g1), 15) + expect_vcount(g1, 15) }) test_that("sample_, graph_ also work", { @@ -111,7 +111,7 @@ test_that("graph_from_literal(simplify = FALSE)", { test_that("empty graph works", { empty <- make_empty_graph() - expect_equal(vcount(empty), 0) + expect_vcount(empty, 0) expect_equal(ecount(empty), 0) }) @@ -242,7 +242,7 @@ test_that("compatibility when arguments are not named", { nodes <- 3 graph_unnamed_args <- make_graph(as.vector(t(elist)), nodes, FALSE) - expect_equal(vcount(graph_unnamed_args), 3) + expect_vcount(graph_unnamed_args, 3) expect_equal(ecount(graph_unnamed_args), 1) }) @@ -324,7 +324,7 @@ test_that("make_full_bipartite_graph works", { expect_isomorphic(full_bip_star, make_star(6, "undirected")) full_bip <- make_full_bipartite_graph(5, 5) - expect_equal(vcount(full_bip), 10) + expect_vcount(full_bip, 10) expect_equal(ecount(full_bip), 25) }) diff --git a/tests/testthat/test-operators.R b/tests/testthat/test-operators.R index d4a2301b201..f07e2bebcbb 100644 --- a/tests/testthat/test-operators.R +++ b/tests/testthat/test-operators.R @@ -5,7 +5,7 @@ test_that("union() works", { g2 <- make_star(11, center = 11, mode = "undirected") gu <- union(g1, g2) - expect_equal(vcount(gu), 11) + expect_vcount(gu, 11) expect_equal(ecount(gu), 20) expect_equal( order_by_two_first_columns(rbind(as_edgelist(g1), as_edgelist(g2))), @@ -68,7 +68,7 @@ test_that("compose() works", { gu <- union(g1, g2) gc <- compose(gu, g1) - expect_equal(vcount(gc), 11) + expect_vcount(gc, 11) expect_equal(ecount(gc), 60) expect_equal(diameter(gc), 2) }) @@ -82,7 +82,7 @@ test_that("Union of directed named graphs", { gg <- union.igraph(graphs) - expect_equal(vcount(gg), 5) + expect_vcount(gg, 5) expect_equal(ecount(gg), 10) }) @@ -93,7 +93,7 @@ test_that("edge reversal works", { expect_true(isomorphic(reverse_directed_graph, expected)) reverse_all_directed_graph <- reverse_edges(directed_graph) - expect_equal(vcount(reverse_all_directed_graph), vcount(directed_graph)) + expect_vcount(reverse_all_directed_graph, vcount(directed_graph)) expect_equal( as_edgelist(reverse_all_directed_graph), as_edgelist(directed_graph)[, c(2, 1)] @@ -105,7 +105,7 @@ test_that("edge reversal works", { isolated_vertices_g <- make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 4) reverse_isolated_vertices_g <- reverse_edges(isolated_vertices_g) - expect_equal(vcount(reverse_isolated_vertices_g), vcount(isolated_vertices_g)) + expect_vcount(reverse_isolated_vertices_g, vcount(isolated_vertices_g)) expect_equal( as_edgelist(reverse_isolated_vertices_g), as_edgelist(isolated_vertices_g)[, c(2, 1)] @@ -114,7 +114,7 @@ test_that("edge reversal works", { test_that("t() is aliased to edge reversal for graphs", { g <- make_graph(~ 1 -+ 2, 1 -+ 3, 1 -+ 4, 2 -+ 3, 3 -+ 4) - expect_equal(vcount(t(g)), vcount(g)) + expect_vcount(t(g), vcount(g)) expect_equal(as_edgelist(t(g)), as_edgelist(g)[, c(2, 1)]) }) diff --git a/tests/testthat/test-operators3.R b/tests/testthat/test-operators3.R index 4f29d72bd2c..157d4e2c962 100644 --- a/tests/testthat/test-operators3.R +++ b/tests/testthat/test-operators3.R @@ -4,7 +4,7 @@ test_that("infix operators work", { E(g)$name <- LETTERS[1:10] g <- g - c("a", "b") - expect_equal(vcount(g), 8) + expect_vcount(g, 8) expect_equal(ecount(g), 7) expect_isomorphic(g, make_lattice(8)) diff --git a/tests/testthat/test-trees.R b/tests/testthat/test-trees.R index 0d428c8707e..3c97d3d151e 100644 --- a/tests/testthat/test-trees.R +++ b/tests/testthat/test-trees.R @@ -103,25 +103,25 @@ test_that("sample_tree works", { g <- sample_tree(100) expect_false(is_directed(g)) expect_equal(ecount(g), 99) - expect_equal(vcount(g), 100) + expect_vcount(g, 100) expect_true(is_tree(g)) g <- sample_tree(50, directed = T) expect_true(is_directed(g)) expect_equal(ecount(g), 49) - expect_equal(vcount(g), 50) + expect_vcount(g, 50) expect_true(is_tree(g)) g <- sample_tree(200, method = "prufer") expect_false(is_directed(g)) expect_equal(ecount(g), 199) - expect_equal(vcount(g), 200) + expect_vcount(g, 200) expect_true(is_tree(g)) g <- sample_tree(200, method = "lerw") expect_false(is_directed(g)) expect_equal(ecount(g), 199) - expect_equal(vcount(g), 200) + expect_vcount(g, 200) expect_true(is_tree(g)) }) @@ -129,13 +129,13 @@ test_that("sample_(tree(...)) works", { g <- sample_(tree(200, method = "prufer")) expect_false(is_directed(g)) expect_equal(ecount(g), 199) - expect_equal(vcount(g), 200) + expect_vcount(g, 200) expect_true(is_tree(g)) g2 <- sample_(tree(200, method = "prufer")) expect_false(is_directed(g2)) expect_equal(ecount(g2), 199) - expect_equal(vcount(g2), 200) + expect_vcount(g2, 200) expect_true(is_tree(g2)) expect_false(identical_graphs(g, g2)) }) @@ -144,7 +144,7 @@ test_that("sample_tree yields a singleton graph for n=1", { g <- sample_tree(1) expect_false(is_directed(g)) expect_equal(ecount(g), 0) - expect_equal(vcount(g), 1) + expect_vcount(g, 1) expect_true(is_tree(g)) }) @@ -152,7 +152,7 @@ test_that("sample_tree yields a null graph for n=0", { g <- sample_tree(0) expect_false(is_directed(g)) expect_equal(ecount(g), 0) - expect_equal(vcount(g), 0) + expect_vcount(g, 0) expect_false(is_tree(g)) # edge case, the null graph is not a tree even though it was generated by sample_tree() }) @@ -167,7 +167,7 @@ test_that("sample_spanning_tree works for connected graphs", { expect_equal(length(edges), 7) sg <- subgraph_from_edges(g, edges) - expect_equal(vcount(sg), 8) + expect_vcount(sg, 8) expect_equal(ecount(sg), 7) expect_true(is_tree(sg)) }) @@ -177,19 +177,19 @@ test_that("sample_spanning_tree works for disconnected graphs", { edges <- sample_spanning_tree(g, vid = 8) sg <- subgraph_from_edges(g, edges, delete.vertices = TRUE) - expect_equal(vcount(sg), 8) + expect_vcount(sg, 8) expect_equal(ecount(sg), 7) expect_true(is_tree(sg)) edges <- sample_spanning_tree(g, vid = 9) sg <- subgraph_from_edges(g, edges, delete.vertices = TRUE) - expect_equal(vcount(sg), 5) + expect_vcount(sg, 5) expect_equal(ecount(sg), 4) expect_true(is_tree(sg)) edges <- sample_spanning_tree(g) sg <- subgraph_from_edges(g, edges, delete.vertices = FALSE) - expect_equal(vcount(sg), 13) + expect_vcount(sg, 13) expect_equal(ecount(sg), 11) expect_true(is_tree(induced_subgraph(sg, 1:8))) expect_true(is_tree(induced_subgraph(sg, 9:13))) From be712f4c39f5b5c383f21a4ccb45a20256f023ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Wed, 19 Feb 2025 16:00:11 +0100 Subject: [PATCH 2/5] test: create and use `expect_ecount()` --- tests/testthat/helper.R | 4 +++ tests/testthat/test-adjacency.R | 24 +++++++++--------- tests/testthat/test-dot.product.game.R | 4 +-- tests/testthat/test-games.R | 34 +++++++++++++------------- tests/testthat/test-interface.R | 6 ++--- tests/testthat/test-make.R | 6 ++--- tests/testthat/test-operators.R | 6 ++--- tests/testthat/test-operators3.R | 2 +- tests/testthat/test-operators4.R | 2 +- tests/testthat/test-trees.R | 24 +++++++++--------- 10 files changed, 58 insertions(+), 54 deletions(-) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index da881ef7405..1c81aa125e9 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -27,3 +27,7 @@ expect_isomorphic <- function(g1, g2) { expect_vcount <- function(graph, expected, ...) { expect_equal(object = vcount(graph), expected = expected, ...) } + +expect_ecount <- function(graph, expected, ...) { + expect_equal(object = ecount(graph), expected = expected, ...) +} diff --git a/tests/testthat/test-adjacency.R b/tests/testthat/test-adjacency.R index f072b456f12..79b7261cdf3 100644 --- a/tests/testthat/test-adjacency.R +++ b/tests/testthat/test-adjacency.R @@ -663,12 +663,12 @@ test_that("sparse/dense matrices no loops works",{ A <- diag(1, 5) A[1, 2] <- 1 g <- graph_from_adjacency_matrix(A, diag = FALSE) - expect_equal(ecount(g), 1) + expect_ecount(g, 1) expect_equal(get_edge_ids(g, c(1, 2)), 1) - + A <- as(A, "dgCMatrix") g <- graph_from_adjacency_matrix(A, diag = FALSE) - expect_equal(ecount(g), 1) + expect_ecount(g, 1) expect_equal(get_edge_ids(g,c(1, 2)), 1) }) @@ -678,14 +678,14 @@ test_that("sparse/dense matrices multiple works",{ A <- matrix(0, 5, 5) A[1, 2] <- 3 g <- graph_from_adjacency_matrix(A, diag = FALSE, weighted = FALSE) - expect_equal(ecount(g), 3) + expect_ecount(g, 3) expect_equal(as_edgelist(g), matrix(c(1, 2), 3, 2, byrow = TRUE)) - + A <- as(A,"dgCMatrix") g <- graph_from_adjacency_matrix(A,diag = FALSE) - expect_equal(ecount(g), 3) + expect_ecount(g, 3) expect_equal(as_edgelist(g), matrix(c(1, 2), 3, 2, byrow = TRUE)) - + }) test_that("sparse/dense matrices min/max/plus",{ @@ -695,7 +695,7 @@ test_that("sparse/dense matrices min/max/plus",{ A[2, 1] <- 2 g <- graph_from_adjacency_matrix(A, diag = FALSE, mode = "max", weighted = TRUE) expect_equal(E(g)$weight[1], 3) - + g <- graph_from_adjacency_matrix(A, diag = FALSE, mode = "min", weighted = TRUE) expect_equal(E(g)$weight[1], 2) @@ -705,12 +705,12 @@ test_that("sparse/dense matrices min/max/plus",{ A <- as(A,"dgCMatrix") g <- graph_from_adjacency_matrix(A, diag = FALSE, mode = "max", weighted = TRUE) expect_equal(E(g)$weight[1], 3) - + g <- graph_from_adjacency_matrix(A, diag = FALSE, mode = "min", weighted = TRUE) expect_equal(E(g)$weight[1], 2) g <- graph_from_adjacency_matrix(A, diag = FALSE, mode = "plus", weighted = TRUE) expect_equal(E(g)$weight[1], 5) - - -}) \ No newline at end of file + + +}) diff --git a/tests/testthat/test-dot.product.game.R b/tests/testthat/test-dot.product.game.R index 6ad29cd2354..4cce62192d4 100644 --- a/tests/testthat/test-dot.product.game.R +++ b/tests/testthat/test-dot.product.game.R @@ -22,10 +22,10 @@ test_that("Dot product rng works", { vecs <- replicate(100, rep(sqrt(1 / 8), 4)) g <- sample_dot_product(vecs) - expect_equal(ecount(g), 2454) + expect_ecount(g, 2454) g2 <- sample_dot_product(vecs, directed = TRUE) - expect_equal(ecount(g2), 4938) + expect_ecount(g2, 4938) }) test_that("Dot product rng gives warnings", { diff --git a/tests/testthat/test-games.R b/tests/testthat/test-games.R index 23acf474bd3..e33fbf2aefd 100644 --- a/tests/testthat/test-games.R +++ b/tests/testthat/test-games.R @@ -252,17 +252,17 @@ test_that("sample_pa() works", { withr::local_seed(20240209) g_pa <- sample_pa(100, m = 2) - expect_equal(ecount(g_pa), 197) + expect_ecount(g_pa, 197) expect_vcount(g_pa, 100) expect_true(is_simple(g_pa)) g_pa2 <- sample_pa(100, m = 2, algorithm = "psumtree-multiple") - expect_equal(ecount(g_pa2), 198) + expect_ecount(g_pa2, 198) expect_vcount(g_pa2, 100) expect_false(is_simple(g_pa2)) g_pa3 <- sample_pa(100, m = 2, algorithm = "bag") - expect_equal(ecount(g_pa3), 198) + expect_ecount(g_pa3, 198) expect_vcount(g_pa3, 100) expect_false(is_simple(g_pa3)) @@ -277,7 +277,7 @@ test_that("sample_pa can start from a graph", { withr::local_seed(20231029) g_pa1 <- sample_pa(10, m = 1, algorithm = "bag", start.graph = make_empty_graph(5)) - expect_equal(ecount(g_pa1), 5) + expect_ecount(g_pa1, 5) expect_vcount(g_pa1, 10) is_degree_zero <- (degree(g_pa1) == 0) @@ -330,7 +330,7 @@ test_that("sample_bipartite works -- undirected gnp", { g_rand_bip <- sample_bipartite(10, 5, type = "gnp", p = .1) expect_equal(g_rand_bip$name, "Bipartite Gnp random graph") expect_vcount(g_rand_bip, 15) - expect_equal(ecount(g_rand_bip), 7) + expect_ecount(g_rand_bip, 7) expect_true(bipartite_mapping(g_rand_bip)$res) expect_false(is_directed(g_rand_bip)) }) @@ -338,7 +338,7 @@ test_that("sample_bipartite works -- undirected gnp", { test_that("sample_bipartite works -- directed gnp", { g_rand_bip_dir <- sample_bipartite(10, 5, type = "gnp", p = .1, directed = TRUE) expect_vcount(g_rand_bip_dir, 15) - expect_equal(ecount(g_rand_bip_dir), 6) + expect_ecount(g_rand_bip_dir, 6) expect_true(bipartite_mapping(g_rand_bip_dir)$res) expect_true(is_directed(g_rand_bip_dir)) expect_output(print_all(g_rand_bip_dir), "5->11") @@ -350,21 +350,21 @@ test_that("sample_bipartite works -- directed gnp", { test_that("sample_bipartite works -- undirected gnm", { g_rand_bip_gnm <- sample_bipartite(10, 5, type = "gnm", m = 8) expect_vcount(g_rand_bip_gnm, 15) - expect_equal(ecount(g_rand_bip_gnm), 8) + expect_ecount(g_rand_bip_gnm, 8) expect_true(bipartite_mapping(g_rand_bip_gnm)$res) expect_false(is_directed(g_rand_bip_gnm)) }) test_that("sample_bipartite works -- directed gnm", { g_rand_bip_gnm_dir <- sample_bipartite(10, 5, type = "gnm", m = 8, directed = TRUE) expect_vcount(g_rand_bip_gnm_dir, 15) - expect_equal(ecount(g_rand_bip_gnm_dir), 8) + expect_ecount(g_rand_bip_gnm_dir, 8) expect_true(bipartite_mapping(g_rand_bip_gnm_dir)$res) expect_true(is_directed(g_rand_bip_gnm_dir)) expect_output(print_all(g_rand_bip_gnm_dir), "5->12") g_rand_bip_gnm_in <- sample_bipartite(10, 5, type = "gnm", m = 8, directed = TRUE, mode = "in") expect_vcount(g_rand_bip_gnm_in, 15) - expect_equal(ecount(g_rand_bip_gnm_in), 8) + expect_ecount(g_rand_bip_gnm_in, 8) expect_true(bipartite_mapping(g_rand_bip_gnm_in)$res) expect_true(is_directed(g_rand_bip_gnm_in)) expect_output(print_all(g_rand_bip_gnm_in), "12->10") @@ -373,13 +373,13 @@ test_that("sample_bipartite works -- directed gnm", { type = "gnp", p = 0.9999, directed = TRUE, mode = "all" ) - expect_equal(ecount(g_rand_bip_full), 100) + expect_ecount(g_rand_bip_full, 100) g_rand_bip_edges <- sample_bipartite(10, 5, type = "gnm", m = 99, directed = TRUE, mode = "all" ) - expect_equal(ecount(g_rand_bip_edges), 99) + expect_ecount(g_rand_bip_edges, 99) }) @@ -437,7 +437,7 @@ test_that("sample_correlated_gnp corner cases work", { expect_true(is_full(cor_gnp_full)) cor_gnp_empty <- sample_correlated_gnp(gnp_graph, corr = 0.000001, p = 0.0000001) - expect_equal(ecount(cor_gnp_empty), 0) + expect_ecount(cor_gnp_empty, 0) expect_vcount(cor_gnp_empty, 10) gnp_graph_directed <- sample_gnp(10, .3, directed = TRUE) @@ -445,7 +445,7 @@ test_that("sample_correlated_gnp corner cases work", { expect_true(is_full(cor_gnp_directed)) cor_gnp_directed_empty <- sample_correlated_gnp(gnp_graph_directed, corr = 0.000001, p = 0.0000001) - expect_equal(ecount(cor_gnp_directed_empty), 0) + expect_ecount(cor_gnp_directed_empty, 0) expect_vcount(cor_gnp_directed_empty, 10) }) @@ -474,28 +474,28 @@ test_that("HSBM works", { ), nrow = 3) g_hsbm1 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 0) - expect_equal(ecount(g_hsbm1), 172) + expect_ecount(g_hsbm1, 172) expect_vcount(g_hsbm1, 100) expect_false(is_directed(g_hsbm1)) withr::local_seed(42) g_hsbm2 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1) - expect_equal(ecount(g_hsbm2), ecount(g_hsbm1) + 10 * 9 * (90 + 10) / 2) + expect_ecount(g_hsbm2, ecount(g_hsbm1) + 10 * 9 * (90 + 10) / 2) expect_vcount(g_hsbm2, 100) expect_true(is_simple(g_hsbm2)) withr::local_seed(42) g_hsbm3 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1e-15) - expect_equal(ecount(g_hsbm3), ecount(g_hsbm1)) + expect_ecount(g_hsbm3, ecount(g_hsbm1)) expect_vcount(g_hsbm3, 100) expect_true(is_simple(g_hsbm3)) withr::local_seed(42) g_hsbm4 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1 - 1e-15) - expect_equal(ecount(g_hsbm4), ecount(g_hsbm2)) + expect_ecount(g_hsbm4, ecount(g_hsbm2)) expect_vcount(g_hsbm4, 100) expect_true(is_simple(g_hsbm4)) }) diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index 43f7eeb5e48..d1f5b10ecc1 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -3,7 +3,7 @@ test_that("add_edges keeps edge id order", { edges <- c(1, 2, 2, 3, 3, 4, 1, 6, 1, 7, 9, 10) g2 <- add_edges(g, edges) - expect_equal(ecount(g2), length(edges) / 2) + expect_ecount(g2, length(edges) / 2) expect_equal(get_edge_ids(g2, edges), seq_len(length(edges) / 2)) }) @@ -13,7 +13,7 @@ test_that("add_edges adds attributes", { weights <- c(1, 2, 1, -1) g3 <- add_edges(g, edges, attr = list(weight = weights)) - expect_equal(ecount(g3), (length(edges) / 2)) + expect_ecount(g3, (length(edges) / 2)) expect_equal(get_edge_ids(g3, edges), seq_len(length(edges) / 2)) expect_equal(E(g3)$weight, weights) }) @@ -50,7 +50,7 @@ test_that("add_vertices works", { g2 <- add_vertices(g, nv = nv) expect_vcount(g2, vcount(g) + nv) - expect_equal(ecount(g2), ecount(g)) + expect_ecount(g2, ecount(g)) expect_equal(as_edgelist(g2), as_edgelist(g)) }) diff --git a/tests/testthat/test-make.R b/tests/testthat/test-make.R index d59ff829c25..2ba0bdb1542 100644 --- a/tests/testthat/test-make.R +++ b/tests/testthat/test-make.R @@ -112,7 +112,7 @@ test_that("graph_from_literal(simplify = FALSE)", { test_that("empty graph works", { empty <- make_empty_graph() expect_vcount(empty, 0) - expect_equal(ecount(empty), 0) + expect_ecount(empty, 0) }) test_that("make_star works", { @@ -243,7 +243,7 @@ test_that("compatibility when arguments are not named", { graph_unnamed_args <- make_graph(as.vector(t(elist)), nodes, FALSE) expect_vcount(graph_unnamed_args, 3) - expect_equal(ecount(graph_unnamed_args), 1) + expect_ecount(graph_unnamed_args, 1) }) test_that("make_empty_graph gives an error for invalid arguments", { @@ -325,7 +325,7 @@ test_that("make_full_bipartite_graph works", { full_bip <- make_full_bipartite_graph(5, 5) expect_vcount(full_bip, 10) - expect_equal(ecount(full_bip), 25) + expect_ecount(full_bip, 25) }) test_that("make_kautz_graph works", { diff --git a/tests/testthat/test-operators.R b/tests/testthat/test-operators.R index f07e2bebcbb..e543f56f579 100644 --- a/tests/testthat/test-operators.R +++ b/tests/testthat/test-operators.R @@ -6,7 +6,7 @@ test_that("union() works", { gu <- union(g1, g2) expect_vcount(gu, 11) - expect_equal(ecount(gu), 20) + expect_ecount(gu, 20) expect_equal( order_by_two_first_columns(rbind(as_edgelist(g1), as_edgelist(g2))), order_by_two_first_columns(as_edgelist(gu)) @@ -69,7 +69,7 @@ test_that("compose() works", { gc <- compose(gu, g1) expect_vcount(gc, 11) - expect_equal(ecount(gc), 60) + expect_ecount(gc, 60) expect_equal(diameter(gc), 2) }) @@ -83,7 +83,7 @@ test_that("Union of directed named graphs", { gg <- union.igraph(graphs) expect_vcount(gg, 5) - expect_equal(ecount(gg), 10) + expect_ecount(gg, 10) }) test_that("edge reversal works", { diff --git a/tests/testthat/test-operators3.R b/tests/testthat/test-operators3.R index 157d4e2c962..ab60390542c 100644 --- a/tests/testthat/test-operators3.R +++ b/tests/testthat/test-operators3.R @@ -5,7 +5,7 @@ test_that("infix operators work", { g <- g - c("a", "b") expect_vcount(g, 8) - expect_equal(ecount(g), 7) + expect_ecount(g, 7) expect_isomorphic(g, make_lattice(8)) g <- g - edge("e|f") diff --git a/tests/testthat/test-operators4.R b/tests/testthat/test-operators4.R index 6bb19365d1e..6f24be906ab 100644 --- a/tests/testthat/test-operators4.R +++ b/tests/testthat/test-operators4.R @@ -286,7 +286,7 @@ test_that("difference of named graphs works", { gg <- sg - g - expect_equal(ecount(gg), 0) + expect_ecount(gg, 0) expect_equal(V(gg)$name, letters[c(1:3, 11)]) }) diff --git a/tests/testthat/test-trees.R b/tests/testthat/test-trees.R index 3c97d3d151e..f841890b828 100644 --- a/tests/testthat/test-trees.R +++ b/tests/testthat/test-trees.R @@ -102,25 +102,25 @@ test_that("to_prufer prints an error for non-trees", { test_that("sample_tree works", { g <- sample_tree(100) expect_false(is_directed(g)) - expect_equal(ecount(g), 99) + expect_ecount(g, 99) expect_vcount(g, 100) expect_true(is_tree(g)) g <- sample_tree(50, directed = T) expect_true(is_directed(g)) - expect_equal(ecount(g), 49) + expect_ecount(g, 49) expect_vcount(g, 50) expect_true(is_tree(g)) g <- sample_tree(200, method = "prufer") expect_false(is_directed(g)) - expect_equal(ecount(g), 199) + expect_ecount(g, 199) expect_vcount(g, 200) expect_true(is_tree(g)) g <- sample_tree(200, method = "lerw") expect_false(is_directed(g)) - expect_equal(ecount(g), 199) + expect_ecount(g, 199) expect_vcount(g, 200) expect_true(is_tree(g)) }) @@ -128,13 +128,13 @@ test_that("sample_tree works", { test_that("sample_(tree(...)) works", { g <- sample_(tree(200, method = "prufer")) expect_false(is_directed(g)) - expect_equal(ecount(g), 199) + expect_ecount(g, 199) expect_vcount(g, 200) expect_true(is_tree(g)) g2 <- sample_(tree(200, method = "prufer")) expect_false(is_directed(g2)) - expect_equal(ecount(g2), 199) + expect_ecount(g2, 199) expect_vcount(g2, 200) expect_true(is_tree(g2)) expect_false(identical_graphs(g, g2)) @@ -143,7 +143,7 @@ test_that("sample_(tree(...)) works", { test_that("sample_tree yields a singleton graph for n=1", { g <- sample_tree(1) expect_false(is_directed(g)) - expect_equal(ecount(g), 0) + expect_ecount(g, 0) expect_vcount(g, 1) expect_true(is_tree(g)) }) @@ -151,7 +151,7 @@ test_that("sample_tree yields a singleton graph for n=1", { test_that("sample_tree yields a null graph for n=0", { g <- sample_tree(0) expect_false(is_directed(g)) - expect_equal(ecount(g), 0) + expect_ecount(g, 0) expect_vcount(g, 0) expect_false(is_tree(g)) # edge case, the null graph is not a tree even though it was generated by sample_tree() }) @@ -168,7 +168,7 @@ test_that("sample_spanning_tree works for connected graphs", { sg <- subgraph_from_edges(g, edges) expect_vcount(sg, 8) - expect_equal(ecount(sg), 7) + expect_ecount(sg, 7) expect_true(is_tree(sg)) }) @@ -178,19 +178,19 @@ test_that("sample_spanning_tree works for disconnected graphs", { edges <- sample_spanning_tree(g, vid = 8) sg <- subgraph_from_edges(g, edges, delete.vertices = TRUE) expect_vcount(sg, 8) - expect_equal(ecount(sg), 7) + expect_ecount(sg, 7) expect_true(is_tree(sg)) edges <- sample_spanning_tree(g, vid = 9) sg <- subgraph_from_edges(g, edges, delete.vertices = TRUE) expect_vcount(sg, 5) - expect_equal(ecount(sg), 4) + expect_ecount(sg, 4) expect_true(is_tree(sg)) edges <- sample_spanning_tree(g) sg <- subgraph_from_edges(g, edges, delete.vertices = FALSE) expect_vcount(sg, 13) - expect_equal(ecount(sg), 11) + expect_ecount(sg, 11) expect_true(is_tree(induced_subgraph(sg, 1:8))) expect_true(is_tree(induced_subgraph(sg, 9:13))) }) From 0a0c1f703b58d7fdf6bf0bab9628540b4c5b3401 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Wed, 19 Feb 2025 16:09:07 +0100 Subject: [PATCH 3/5] test: create and use `expect_identical_graphs()` --- tests/testthat/helper.R | 4 ++ tests/testthat/test-constructor-modifiers.R | 16 +++---- tests/testthat/test-degseq.R | 2 +- tests/testthat/test-identical_graphs.R | 6 +-- tests/testthat/test-make.R | 46 ++++++++++----------- tests/testthat/test-operators.R | 4 +- tests/testthat/test-rewire.R | 2 +- tests/testthat/test-vs-es.R | 4 +- 8 files changed, 44 insertions(+), 40 deletions(-) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 1c81aa125e9..fa91a8824c3 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -31,3 +31,7 @@ expect_vcount <- function(graph, expected, ...) { expect_ecount <- function(graph, expected, ...) { expect_equal(object = ecount(graph), expected = expected, ...) } + +expect_identical_graphs <- function(g1, g2, ...) { + expect_true(identical_graphs(g1, g2, ...)) +} diff --git a/tests/testthat/test-constructor-modifiers.R b/tests/testthat/test-constructor-modifiers.R index 148c8d9bccd..5d3fa715e3e 100644 --- a/tests/testthat/test-constructor-modifiers.R +++ b/tests/testthat/test-constructor-modifiers.R @@ -9,7 +9,7 @@ test_that("without_attr", { withr::local_seed(42) g2 <- sample_(gnp(10, 2 / 10), without_attr()) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) expect_equal(graph_attr_names(g2), character()) expect_equal(vertex_attr_names(g2), character()) expect_equal(edge_attr_names(g2), character()) @@ -25,7 +25,7 @@ test_that("without_loops", { without_loops() ) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) expect_true(all(!which_loop(g2))) }) @@ -39,7 +39,7 @@ test_that("without_multiple", { without_multiples() ) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) expect_true(all(!which_multiple(g2))) }) @@ -52,7 +52,7 @@ test_that("simplified", { simplified() ) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) expect_true(all(!which_multiple(g2))) expect_true(all(!which_loop(g2))) }) @@ -71,7 +71,7 @@ test_that("with_vertex_", { ) ) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) expect_equal(V(g2)$color, rep("red", gorder(g2))) expect_equal(V(g2)$foo, paste0("xx", 1:3)) }) @@ -90,7 +90,7 @@ test_that("with_edge_", { ) ) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) expect_equal(E(g)$color, E(g2)$color) expect_equal(E(g)$foo, E(g2)$foo) }) @@ -109,7 +109,7 @@ test_that("with_graph_", { ) ) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) expect_equal(g$color, g2$color) expect_equal(g$foo, g2$foo) }) @@ -126,5 +126,5 @@ test_that("adding and removing attributes", { V(g)$foo <- "bar" g <- delete_vertex_attr(g, "foo") - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) }) diff --git a/tests/testthat/test-degseq.R b/tests/testthat/test-degseq.R index e0d29f502c7..ada62dc796f 100644 --- a/tests/testthat/test-degseq.R +++ b/tests/testthat/test-degseq.R @@ -31,5 +31,5 @@ test_that("realize_degseq supports the make_(...) syntax", { expect_equal(degree(g1), degs) expect_equal(degree(g2), degs) - expect_true(identical_graphs(g1, g2)) + expect_identical_graphs(g1, g2) }) diff --git a/tests/testthat/test-identical_graphs.R b/tests/testthat/test-identical_graphs.R index b6f5bed6484..d13c98be131 100644 --- a/tests/testthat/test-identical_graphs.R +++ b/tests/testthat/test-identical_graphs.R @@ -2,7 +2,7 @@ test_that("identical_graphs works", { g <- make_ring(5) g2 <- make_ring(5) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) g2 <- make_ring(6) @@ -13,10 +13,10 @@ test_that("identical_graphs considers attributes", { g <- sample_pa(10) g2 <- g - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) g2$m <- 2 expect_false(identical_graphs(g, g2)) - expect_true(identical_graphs(g, g2, attrs = FALSE)) + expect_identical_graphs(g, g2, attrs = FALSE) }) diff --git a/tests/testthat/test-make.R b/tests/testthat/test-make.R index 2ba0bdb1542..90403a70fab 100644 --- a/tests/testthat/test-make.R +++ b/tests/testthat/test-make.R @@ -1,13 +1,13 @@ test_that("make_ works, order of arguments does not matter", { g0 <- make_undirected_graph(1:10) g1 <- make_(undirected_graph(1:10)) - expect_true(identical_graphs(g0, g1)) + expect_identical_graphs(g0, g1) g2 <- make_(undirected_graph(), 1:10) - expect_true(identical_graphs(g0, g2)) + expect_identical_graphs(g0, g2) g3 <- make_(1:10, undirected_graph()) - expect_true(identical_graphs(g0, g3)) + expect_identical_graphs(g0, g3) }) test_that("make_ works with n parameter", { @@ -22,22 +22,22 @@ test_that("sample_, graph_ also work", { rlang::local_options(lifecycle_verbosity = "quiet") g0 <- make_undirected_graph(1:10) g1 <- sample_(undirected_graph(1:10)) - expect_true(identical_graphs(g0, g1)) + expect_identical_graphs(g0, g1) g2 <- sample_(undirected_graph(), 1:10) - expect_true(identical_graphs(g0, g2)) + expect_identical_graphs(g0, g2) g3 <- sample_(1:10, undirected_graph()) - expect_true(identical_graphs(g0, g3)) + expect_identical_graphs(g0, g3) g4 <- graph_(undirected_graph(1:10)) - expect_true(identical_graphs(g0, g4)) + expect_identical_graphs(g0, g4) g5 <- graph_(undirected_graph(), 1:10) - expect_true(identical_graphs(g0, g5)) + expect_identical_graphs(g0, g5) g6 <- graph_(1:10, undirected_graph()) - expect_true(identical_graphs(g0, g6)) + expect_identical_graphs(g0, g6) }) test_that("error messages are proper", { @@ -63,7 +63,7 @@ test_that("we pass arguments unevaluated", { rlang::local_options(lifecycle_verbosity = "quiet") g0 <- graph_from_literal(A - +B:C) g1 <- graph_(from_literal(A - +B:C)) - expect_true(identical_graphs(g0, g1)) + expect_identical_graphs(g0, g1) }) test_that("graph_from_literal() and simple undirected graphs", { @@ -192,43 +192,43 @@ test_that("make_lattice prints a warning for fractional length)", { suppressWarnings(lattice_rounded <- make_lattice(dim = 2, length = sqrt(2000))) lattice_integer <- make_lattice(dim = 2, length = 45) - expect_true(identical_graphs(lattice_rounded, lattice_integer)) + expect_identical_graphs(lattice_rounded, lattice_integer) }) test_that("make_graph works", { graph_make <- make_graph(1:10) graph_elist <- make_empty_graph(n = 10) + edges(1:10) - expect_true(identical_graphs(graph_make, graph_elist)) + expect_identical_graphsgraph_make, graph_elist) }) test_that("make_graph accepts an empty vector or NULL", { graph_make <- make_graph(c()) graph_empty <- make_empty_graph(n = 0) - expect_true(identical_graphs(graph_make, graph_empty)) + expect_identical_graphs(graph_make, graph_empty) graph_make_null <- make_graph(NULL, n = 0) - expect_true(identical_graphs(graph_make_null, graph_empty)) + expect_identical_graphs(graph_make_null, graph_empty) graph_make_c <- make_graph(edges = c(), n = 0) - expect_true(identical_graphs(graph_make_c, graph_empty)) + expect_identical_graphs(graph_make_c, graph_empty) }) test_that("make_graph works for numeric edges and isolates", { graph_make <- make_graph(1:10, n = 20) graph_elist <- make_empty_graph(n = 20) + edges(1:10) - expect_true(identical_graphs(graph_make, graph_elist)) + expect_identical_graphs(graph_make, graph_elist) }) test_that("make_graph handles names", { graph_make_names <- make_graph(letters[1:10]) graph_elist_names <- make_empty_graph() + vertices(letters[1:10]) + edges(letters[1:10]) - expect_true(identical_graphs(graph_make_names, graph_elist_names)) + expect_identical_graphs(graph_make_names, graph_elist_names) }) test_that("make_graph handles names and isolates", { graph_make_iso <- make_graph(letters[1:10], isolates = letters[11:20]) graph_elist_iso <- make_empty_graph() + vertices(letters[1:20]) + edges(letters[1:10]) - expect_true(identical_graphs(graph_make_iso, graph_elist_iso)) + expect_identical_graphs(graph_make_iso, graph_elist_iso) }) test_that("make_graph gives warning for ignored arguments", { @@ -355,13 +355,13 @@ test_that("make_kautz_graph works", { test_that("make_graph for notable graphs is case insensitive", { levi <- make_graph("Levi") Levi <- make_graph("levi") - expect_true(identical_graphs(levi, Levi)) + expect_identical_graphs(levi, Levi) }) test_that("spaces are replaced in make_graph for notable graphs", { Kite <- make_graph("Krackhardt_Kite") kite <- make_graph("Krackhardt kite") - expect_true(identical_graphs(Kite, kite)) + expect_identical_graphs(Kite, kite) }) test_that("warnings are given for extra arguments in make_graph for notables", { @@ -369,7 +369,7 @@ test_that("warnings are given for extra arguments in make_graph for notables", { expect_warning(Levi1 <- make_graph("Levi", n = 10)) expect_warning(Levi2 <- make_graph("Levi", isolates = "foo")) expect_warning(Levi3 <- make_graph("Levi", directed = FALSE)) - expect_true(identical_graphs(Levi, Levi1)) - expect_true(identical_graphs(Levi, Levi2)) - expect_true(identical_graphs(Levi, Levi3)) + expect_identical_graphs(Levi, Levi1) + expect_identical_graphs(Levi, Levi2) + expect_identical_graphs(Levi, Levi3) }) diff --git a/tests/testthat/test-operators.R b/tests/testthat/test-operators.R index e543f56f579..6a434c12a9f 100644 --- a/tests/testthat/test-operators.R +++ b/tests/testthat/test-operators.R @@ -57,7 +57,7 @@ test_that("complementer() works", { g2 <- make_star(11, center = 11, mode = "undirected") x <- complementer(complementer(g2)) - expect_true(identical_graphs(x, g2)) + expect_identical_graphs(x, g2) }) @@ -101,7 +101,7 @@ test_that("edge reversal works", { undirected_graph <- make_graph(~ 1 -- 2, 1 -- 3, 1 -- 4, 2 -- 3, 3 -- 4) reverse_undirected_graph <- reverse_edges(undirected_graph, 1:3) - expect_true(identical_graphs(undirected_graph, reverse_undirected_graph)) + expect_identical_graphs(undirected_graph, reverse_undirected_graph) isolated_vertices_g <- make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 4) reverse_isolated_vertices_g <- reverse_edges(isolated_vertices_g) diff --git a/tests/testthat/test-rewire.R b/tests/testthat/test-rewire.R index 0437fb7aeac..bbac34670ff 100644 --- a/tests/testthat/test-rewire.R +++ b/tests/testthat/test-rewire.R @@ -17,5 +17,5 @@ test_that("rewire(each_edge(mode='out')) keeps the out-degree distribution", { test_that("rewire() with zero probability does not do anything", { g <- sample_pa(100) g2 <- g %>% rewire(each_edge(prob = 0)) - expect_true(identical_graphs(g, g2)) + expect_identical_graphs(g, g2) }) diff --git a/tests/testthat/test-vs-es.R b/tests/testthat/test-vs-es.R index 64051ee2ed9..33909e2caae 100644 --- a/tests/testthat/test-vs-es.R +++ b/tests/testthat/test-vs-es.R @@ -211,10 +211,10 @@ test_that("unconnected vs/es can be reused with the same graph", { load(tmp) expect_equal(degree(g, v = vs), rep(2, 10)) - expect_true(identical_graphs( + expect_identical_graphs( delete_edges(g, es), delete_edges(g, 1:5) - )) + ) }) test_that("indexing without arguments", { From 5e4d32cd40c49f49683265c8333c87aef0afcaa2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Wed, 19 Feb 2025 16:10:20 +0100 Subject: [PATCH 4/5] test: create and use `expect_not_identical_graphs()` --- tests/testthat/helper.R | 4 ++++ tests/testthat/test-games.R | 2 +- tests/testthat/test-identical_graphs.R | 4 ++-- tests/testthat/test-trees.R | 2 +- 4 files changed, 8 insertions(+), 4 deletions(-) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index fa91a8824c3..c0d7e6309c1 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -35,3 +35,7 @@ expect_ecount <- function(graph, expected, ...) { expect_identical_graphs <- function(g1, g2, ...) { expect_true(identical_graphs(g1, g2, ...)) } + +expect_not_identical_graphs <- function(g1, g2, ...) { + expect_false(identical_graphs(g1, g2, ...)) +} diff --git a/tests/testthat/test-games.R b/tests/testthat/test-games.R index e33fbf2aefd..0ebd2d92750 100644 --- a/tests/testthat/test-games.R +++ b/tests/testthat/test-games.R @@ -136,7 +136,7 @@ test_that("sample_degseq supports the sample_(...) syntax", { expect_equal(degree(g1), degs) expect_equal(degree(g2), degs) - expect_false(identical_graphs(g1, g2)) + expect_not_identical_graphs(g1, g2) }) test_that("sample_degseq works() -- old method names", { diff --git a/tests/testthat/test-identical_graphs.R b/tests/testthat/test-identical_graphs.R index d13c98be131..654b6506e4b 100644 --- a/tests/testthat/test-identical_graphs.R +++ b/tests/testthat/test-identical_graphs.R @@ -6,7 +6,7 @@ test_that("identical_graphs works", { g2 <- make_ring(6) - expect_false(identical_graphs(g, g2)) + expect_not_identical_graphs(g, g2) }) test_that("identical_graphs considers attributes", { @@ -17,6 +17,6 @@ test_that("identical_graphs considers attributes", { g2$m <- 2 - expect_false(identical_graphs(g, g2)) + expect_not_identical_graphs(g, g2) expect_identical_graphs(g, g2, attrs = FALSE) }) diff --git a/tests/testthat/test-trees.R b/tests/testthat/test-trees.R index f841890b828..1dba898ba5b 100644 --- a/tests/testthat/test-trees.R +++ b/tests/testthat/test-trees.R @@ -137,7 +137,7 @@ test_that("sample_(tree(...)) works", { expect_ecount(g2, 199) expect_vcount(g2, 200) expect_true(is_tree(g2)) - expect_false(identical_graphs(g, g2)) + expect_not_identical_graphs(g, g2) }) test_that("sample_tree yields a singleton graph for n=1", { From 286ddf58a3201ed3240b2a9e0ef4da64c316c047 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Wed, 19 Feb 2025 16:25:18 +0100 Subject: [PATCH 5/5] Update tests/testthat/test-make.R --- tests/testthat/test-make.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-make.R b/tests/testthat/test-make.R index 90403a70fab..ebc298db810 100644 --- a/tests/testthat/test-make.R +++ b/tests/testthat/test-make.R @@ -198,7 +198,7 @@ test_that("make_lattice prints a warning for fractional length)", { test_that("make_graph works", { graph_make <- make_graph(1:10) graph_elist <- make_empty_graph(n = 10) + edges(1:10) - expect_identical_graphsgraph_make, graph_elist) + expect_identical_graphs(graph_make, graph_elist) }) test_that("make_graph accepts an empty vector or NULL", {