From b8ab940d6f48a853bdce3acb7f4b0c11a9fcf79e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Fri, 24 Nov 2023 15:57:49 +0100 Subject: [PATCH 1/5] fix test file --- tests/testthat/test-count.multiple.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-count.multiple.R b/tests/testthat/test-count.multiple.R index da25fe5f823..36f4771b2bc 100644 --- a/tests/testthat/test-count.multiple.R +++ b/tests/testthat/test-count.multiple.R @@ -25,10 +25,10 @@ test_that("any_multiple(), count_multiple(), which_multiple() works", { ## Direction of the edge is important - expect_false(any_multiple(graph(c(1, 2, 2, 1)))) - expect_that(which_multiple(graph(c(1, 2, 2, 1))), equals(c(FALSE, FALSE))) + expect_false(any_multiple(make_graph(c(1, 2, 2, 1)))) + expect_that(which_multiple(make_graph(c(1, 2, 2, 1))), equals(c(FALSE, FALSE))) expect_that( - which_multiple(graph(c(1, 2, 2, 1), dir = FALSE)), + which_multiple(make_graph(c(1, 2, 2, 1), dir = FALSE)), equals(c(FALSE, TRUE)) ) From a862ee379f8714228bcc83a96202fca949a3a0b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Mon, 27 Nov 2023 08:21:04 +0100 Subject: [PATCH 2/5] rm deprecated test --- tests/testthat/test-notable.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/tests/testthat/test-notable.R b/tests/testthat/test-notable.R index c1734e4d331..37232e3bf26 100644 --- a/tests/testthat/test-notable.R +++ b/tests/testthat/test-notable.R @@ -1,9 +1,3 @@ -test_that("notable graphs work with make_graph", { - g <- make_graph("Levi") - g2 <- graph.famous("Levi") - expect_true(identical_graphs(g, g2)) -}) - test_that("make_graph for notable graphs is case insensitive", { g <- make_graph("Levi") g2 <- make_graph("levi") From 28e0aac659adbd26a5a295fdb36fe08dce3d045f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Mon, 27 Nov 2023 08:27:34 +0100 Subject: [PATCH 3/5] replace graph.famous --- tests/testthat/test-dimSelect.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-dimSelect.R b/tests/testthat/test-dimSelect.R index afd8087f5eb..288166c3ded 100644 --- a/tests/testthat/test-dimSelect.R +++ b/tests/testthat/test-dimSelect.R @@ -1,7 +1,7 @@ test_that("dimensionality selection works", { set.seed(42) - k <- graph.famous("zachary") + k <- make_graph("zachary") ev <- eigen(get.adjacency(k), only.values = TRUE)$values kdim <- dim_select(ev) expect_that(kdim, equals(4)) From 4b0c4517f8ce4e2e62ba9eb4aed4cf3fead22613 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Mon, 27 Nov 2023 09:43:13 +0100 Subject: [PATCH 4/5] manually remove useless test lines --- tests/testthat/test-get.shortest.paths.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/tests/testthat/test-get.shortest.paths.R b/tests/testthat/test-get.shortest.paths.R index b39686e53b1..b4406bac2d2 100644 --- a/tests/testthat/test-get.shortest.paths.R +++ b/tests/testthat/test-get.shortest.paths.R @@ -21,13 +21,10 @@ test_that("shortest_paths works", { g <- graph_from_data_frame(as.data.frame(edges)) all1 <- all_shortest_paths(g, "s", "t", weights = NA)$vpaths - all2 <- all_shortest_paths(g, "s", "t")$vpaths s1 <- shortest_paths(g, "s", "t", weights = NA) - s2 <- get.shortest.paths(g, "s", "t") expect_true(s1$vpath %in% all1) - expect_true(s2$vpath %in% all2) }) test_that("shortest_paths can handle negative weights", { From 21f04846724950c10594a564cbae33e9a735ac2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Mon, 27 Nov 2023 10:14:12 +0100 Subject: [PATCH 5/5] replace calls to deprecated functions in tests, automatically --- .../test-adjacency.spectral.embedding.R | 2 +- tests/testthat/test-attributes.R | 2 +- tests/testthat/test-betweenness.R | 2 +- tests/testthat/test-bug-154.R | 4 +- tests/testthat/test-coloring.R | 2 +- tests/testthat/test-correlated.R | 8 +- tests/testthat/test-count.multiple.R | 4 +- tests/testthat/test-dimSelect.R | 2 +- tests/testthat/test-dot.product.game.R | 4 +- tests/testthat/test-graph.atlas.R | 4 +- tests/testthat/test-hrg.R | 2 +- tests/testthat/test-hsbm.R | 12 +- tests/testthat/test-identical_graphs.R | 2 +- .../test-laplacian.spectral.embedding.R | 6 +- tests/testthat/test-layout.sugiyama.R | 2 +- tests/testthat/test-operators.R | 8 +- tests/testthat/test-operators4.R | 6 +- tests/testthat/test-rewire.R | 6 +- tests/testthat/test-scan.R | 10 +- tests/testthat/test-transitivity.R | 2 +- tools/deprecate-tests.R | 118 ++++++++++++++++++ 21 files changed, 163 insertions(+), 45 deletions(-) create mode 100644 tools/deprecate-tests.R diff --git a/tests/testthat/test-adjacency.spectral.embedding.R b/tests/testthat/test-adjacency.spectral.embedding.R index 04e7f333116..240f24c1181 100644 --- a/tests/testthat/test-adjacency.spectral.embedding.R +++ b/tests/testthat/test-adjacency.spectral.embedding.R @@ -266,7 +266,7 @@ test_that("Issue #51 is resolved", { pref.matrix <- diag(0.2, 2) + 0.2 block.sizes <- c(800, 800) n <- sum(block.sizes) - g <- sbm.game(n, pref.matrix, block.sizes, directed = TRUE) + g <- sample_sbm(n, pref.matrix, block.sizes, directed = TRUE) for (i in 1:25) { ase <- embed_adjacency_matrix(g, 2) diff --git a/tests/testthat/test-attributes.R b/tests/testthat/test-attributes.R index 925e4c152dd..eab32231e6b 100644 --- a/tests/testthat/test-attributes.R +++ b/tests/testthat/test-attributes.R @@ -194,7 +194,7 @@ test_that("we can set all attributes some vertices/edges", { }) test_that("cannot use vs/es from another graph", { - g <- graph.ring(10) + g <- make_ring(10) g2 <- g + 1 v <- V(g)[1:4] expect_error(g2 - v, "Cannot use a vertex sequence from another graph") diff --git a/tests/testthat/test-betweenness.R b/tests/testthat/test-betweenness.R index 23bb59472bc..9b3fc11e915 100644 --- a/tests/testthat/test-betweenness.R +++ b/tests/testthat/test-betweenness.R @@ -91,7 +91,7 @@ test_that("shortest paths are compared with tolerance when calculating betweenne 5.2605598, 6.6816853, 4.9482123, 1.8989790 ) - g <- graph.data.frame(edges, directed = FALSE) + g <- graph_from_data_frame(edges, directed = FALSE) result <- betweenness(g, weights = edges.dists) expect_that(result[1:5], equals(c("1" = 0, "2" = 44, "3" = 71, "4" = 36.5, "6" = 44))) diff --git a/tests/testthat/test-bug-154.R b/tests/testthat/test-bug-154.R index 873f4befa11..b8deee40325 100644 --- a/tests/testthat/test-bug-154.R +++ b/tests/testthat/test-bug-154.R @@ -1,6 +1,6 @@ test_that("graph.get.subisomorphisms.vf2() works even if the graph has a vertex attribute named x", { - g <- graph.full(4) + g <- make_full_graph(4) V(g)$x <- 1:4 - subs <- graph.get.subisomorphisms.vf2(g, graph.ring(4)) + subs <- graph.get.subisomorphisms.vf2(g, make_ring(4)) expect_equal(length(subs), 24) }) diff --git a/tests/testthat/test-coloring.R b/tests/testthat/test-coloring.R index da942c5920a..62570ac5f9a 100644 --- a/tests/testthat/test-coloring.R +++ b/tests/testthat/test-coloring.R @@ -24,7 +24,7 @@ test_that("simplify_and_colorize works", { expect_true(is_simple(result)) expect_that(vcount(result), equals(vcount(g))) - expect_that(get.edgelist(result), equals(matrix(c(1:4, 2:5), ncol = 2))) + expect_that(as_edgelist(result), equals(matrix(c(1:4, 2:5), ncol = 2))) expect_that(V(result)$color, equals(c(0, 0, 0, 0, 1))) expect_that(E(result)$color, equals(c(1, 4, 1, 2))) }) diff --git a/tests/testthat/test-correlated.R b/tests/testthat/test-correlated.R index 0370e877176..9b9c3670a1e 100644 --- a/tests/testthat/test-correlated.R +++ b/tests/testthat/test-correlated.R @@ -28,7 +28,7 @@ test_that("sample_correlated_gnp works when p is not given", { test_that("sample_correlated_gnp works even for non-ER graphs", { set.seed(42) - g <- grg.game(100, 0.2) + g <- sample_grg(100, 0.2) g2 <- sample_correlated_gnp(g, corr = 1) expect_that(g[], equals(g2[])) @@ -50,7 +50,7 @@ test_that("sample_correlated_gnp corner cases work", { set.seed(42) is.full <- function(g) { - g2 <- graph.full(vcount(g), directed = is.directed(g)) + g2 <- make_full_graph(vcount(g), directed = is_directed(g)) graph.isomorphic(g, g2) } @@ -77,12 +77,12 @@ test_that("permutation works for sample_correlated_gnp", { g <- erdos.renyi.game(10, .3) perm <- sample(vcount(g)) g2 <- sample_correlated_gnp(g, corr = .99999, p = .3, permutation = perm) - g <- permute.vertices(g, perm) + g <- permute(g, perm) expect_that(g[], equals(g2[])) g <- erdos.renyi.game(10, .3) perm <- sample(vcount(g)) g2 <- sample_correlated_gnp(g, corr = 1, p = .3, permutation = perm) - g <- permute.vertices(g, perm) + g <- permute(g, perm) expect_that(g[], equals(g2[])) }) diff --git a/tests/testthat/test-count.multiple.R b/tests/testthat/test-count.multiple.R index 36f4771b2bc..18d030cb70e 100644 --- a/tests/testthat/test-count.multiple.R +++ b/tests/testthat/test-count.multiple.R @@ -1,5 +1,5 @@ test_that("any_multiple(), count_multiple(), which_multiple() works", { - # g <- barabasi.game(10, m = 3, algorithm = "bag") + # g <- sample_pa(10, m = 3, algorithm = "bag") g <- graph_from_edgelist(cbind( c(2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 10, 10, 10), c(1, 1, 1, 1, 1, 1, 1, 2, 3, 4, 3, 4, 3, 1, 1, 1, 3, 1, 2, 4, 1, 1, 2, 4, 1, 4, 1) @@ -33,7 +33,7 @@ test_that("any_multiple(), count_multiple(), which_multiple() works", { ) ## Remove multiple edges but keep multiplicity - # g <- barabasi.game(10, m = 3, algorithm = "bag") + # g <- sample_pa(10, m = 3, algorithm = "bag") g <- graph_from_edgelist(cbind( c(2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 10, 10, 10), c(1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 4, 1, 4, 1, 1, 6, 4, 1, 5, 8) diff --git a/tests/testthat/test-dimSelect.R b/tests/testthat/test-dimSelect.R index 288166c3ded..8121091f46f 100644 --- a/tests/testthat/test-dimSelect.R +++ b/tests/testthat/test-dimSelect.R @@ -2,7 +2,7 @@ test_that("dimensionality selection works", { set.seed(42) k <- make_graph("zachary") - ev <- eigen(get.adjacency(k), only.values = TRUE)$values + ev <- eigen(as_adjacency_matrix(k), only.values = TRUE)$values kdim <- dim_select(ev) expect_that(kdim, equals(4)) diff --git a/tests/testthat/test-dot.product.game.R b/tests/testthat/test-dot.product.game.R index b27886a2c7f..4b8891ed7b9 100644 --- a/tests/testthat/test-dot.product.game.R +++ b/tests/testthat/test-dot.product.game.R @@ -15,10 +15,10 @@ test_that("Dot product rng works", { vecs <- replicate(5, rep(1 / 2, 4)) g <- sample_dot_product(vecs) - expect_that(g[], is_equivalent_to(graph.full(5)[])) + expect_that(g[], is_equivalent_to(make_full_graph(5)[])) g2 <- sample_dot_product(vecs, directed = TRUE) - expect_that(g2[], is_equivalent_to(graph.full(5, directed = TRUE)[])) + expect_that(g2[], is_equivalent_to(make_full_graph(5, directed = TRUE)[])) vecs <- replicate(100, rep(sqrt(1 / 8), 4)) g <- sample_dot_product(vecs) diff --git a/tests/testthat/test-graph.atlas.R b/tests/testthat/test-graph.atlas.R index 08167827cda..b6c418857ce 100644 --- a/tests/testthat/test-graph.atlas.R +++ b/tests/testthat/test-graph.atlas.R @@ -1,9 +1,9 @@ test_that("graph.atlas works", { - g124 <- graph.atlas(124) + g124 <- graph_from_atlas(124) expect_true(graph.isomorphic(g124, make_graph(c(1, 2, 2, 3, 3, 4, 4, 5, 1, 5, 1, 3, 2, 6), directed = FALSE ))) - g234 <- graph.atlas(234) + g234 <- graph_from_atlas(234) expect_true(graph.isomorphic(g234, make_graph(c(1, 6, 2, 6, 3, 6, 4, 6, 5, 6), n = 7, directed = FALSE diff --git a/tests/testthat/test-hrg.R b/tests/testthat/test-hrg.R index 123156636bc..4bb1671c784 100644 --- a/tests/testthat/test-hrg.R +++ b/tests/testthat/test-hrg.R @@ -11,7 +11,7 @@ test_that("as.hclust.igraphHRG() works", { set.seed(42) g <- make_graph("zachary") - hrg <- hrg.fit(g) + hrg <- fit_hrg(g) expect_snapshot({ summary(as.hclust(hrg)) }) diff --git a/tests/testthat/test-hsbm.R b/tests/testthat/test-hsbm.R index 90ffe5deb5d..25ee15d62fd 100644 --- a/tests/testthat/test-hsbm.R +++ b/tests/testthat/test-hsbm.R @@ -10,28 +10,28 @@ test_that("HSBM works", { g <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 0) expect_that(ecount(g), equals(172)) expect_that(vcount(g), equals(100)) - expect_false(is.directed(g)) + expect_false(is_directed(g)) set.seed(42) g2 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1) expect_that(ecount(g2), equals(ecount(g) + 10 * 9 * (90 + 10) / 2)) expect_that(vcount(g2), equals(100)) - expect_true(is.simple(g2)) + expect_true(is_simple(g2)) set.seed(42) g3 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1e-15) expect_that(ecount(g3), equals(ecount(g))) expect_that(vcount(g3), equals(100)) - expect_true(is.simple(g3)) + expect_true(is_simple(g3)) set.seed(42) g4 <- sample_hierarchical_sbm(100, 10, rho = c(3, 3, 4) / 10, C = C, p = 1 - 1e-15) expect_that(ecount(g4), equals(ecount(g2))) expect_that(vcount(g4), equals(100)) - expect_true(is.simple(g4)) + expect_true(is_simple(g4)) }) test_that("HSBM with 1 cluster per block works", { @@ -88,7 +88,7 @@ test_that("HSBM with list arguments works", { m = c(3, 10, 5, 3), rho = list(rho1, rho2, rho3, rho4), C = list(C1, C2, C3, C4), p = 1 ) - expect_true(is.simple(gg1)) + expect_true(is_simple(gg1)) set.seed(42) gg11 <- sample_hierarchical_sbm(21, @@ -109,7 +109,7 @@ test_that("HSBM with list arguments works", { m = c(3, 10, 5, 3), rho = list(rho1, rho2, rho3, rho4), C = list(C1, C2, C3, C4), p = 0 ) - expect_true(is.simple(gg2)) + expect_true(is_simple(gg2)) gg22 <- sample_hierarchical_sbm(21, m = c(3, 10, 5, 3), rho = list(rho1, rho2, rho3, rho4), diff --git a/tests/testthat/test-identical_graphs.R b/tests/testthat/test-identical_graphs.R index 481e59892db..b6f5bed6484 100644 --- a/tests/testthat/test-identical_graphs.R +++ b/tests/testthat/test-identical_graphs.R @@ -10,7 +10,7 @@ test_that("identical_graphs works", { }) test_that("identical_graphs considers attributes", { - g <- barabasi.game(10) + g <- sample_pa(10) g2 <- g expect_true(identical_graphs(g, g2)) diff --git a/tests/testthat/test-laplacian.spectral.embedding.R b/tests/testthat/test-laplacian.spectral.embedding.R index da4cc184b24..2f907298ef4 100644 --- a/tests/testthat/test-laplacian.spectral.embedding.R +++ b/tests/testthat/test-laplacian.spectral.embedding.R @@ -211,7 +211,7 @@ test_that("Undirected, weighted, D-A case works", { E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) no <- 3 - A <- as(Matrix::Matrix(diag(graph.strength(g)), doDiag = FALSE), "generalMatrix") - g[] + A <- as(Matrix::Matrix(diag(strength(g)), doDiag = FALSE), "generalMatrix") - g[] ss <- eigen(A) D <- ss$values @@ -473,8 +473,8 @@ test_that("Directed, weighted case works", { E(g)$weight <- sample(1:5, ecount(g), replace = TRUE) no <- 3 - O12 <- diag(1 / sqrt(graph.strength(g, mode = "out"))) - P12 <- diag(1 / sqrt(graph.strength(g, mode = "in"))) + O12 <- diag(1 / sqrt(strength(g, mode = "out"))) + P12 <- diag(1 / sqrt(strength(g, mode = "in"))) A <- O12 %*% g[] %*% P12 ss <- svd(A) diff --git a/tests/testthat/test-layout.sugiyama.R b/tests/testthat/test-layout.sugiyama.R index 6dc3cfb8611..c5376f16835 100644 --- a/tests/testthat/test-layout.sugiyama.R +++ b/tests/testthat/test-layout.sugiyama.R @@ -1,5 +1,5 @@ test_that("layout_with_sugiyama does not demote matrices to vectors in res$layout.dummy", { ex <- graph_from_literal(A -+ B:C, B -+ C:D) - layex <- layout.sugiyama(ex, layers = NULL) + layex <- layout_with_sugiyama(ex, layers = NULL) expect_that(nrow(layex$layout.dummy), equals(1)) }) diff --git a/tests/testthat/test-operators.R b/tests/testthat/test-operators.R index 0fe34e3727b..55447c41fd8 100644 --- a/tests/testthat/test-operators.R +++ b/tests/testthat/test-operators.R @@ -55,7 +55,7 @@ test_that("Union of directed named graphs", { make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 3, 2 -+ 4, 3 -+ 4, 1 -+ 5, 4 -+ 5) ) - gg <- graph.union(graphs) + gg <- union.igraph(graphs) expect_equal(vcount(gg), 5) expect_equal(ecount(gg), 10) @@ -77,17 +77,17 @@ test_that("edge reversal works", { g <- make_graph(~ 1 -+ 2, 1 -+ 3, 1 -+ 4, 2 -+ 3, 3 -+ 4) g2 <- reverse_edges(g) expect_that(vcount(g2), equals(vcount(g))) - expect_that(get.edgelist(g2), equals(get.edgelist(g)[, c(2, 1)])) + expect_that(as_edgelist(g2), equals(as_edgelist(g)[, c(2, 1)])) # graph with isolated vertices g <- make_graph(~ 1:2:3:4:5, 1 -+ 2, 1 -+ 4) g2 <- reverse_edges(g) expect_that(vcount(g2), equals(vcount(g))) - expect_that(get.edgelist(g2), equals(get.edgelist(g)[, c(2, 1)])) + expect_that(as_edgelist(g2), equals(as_edgelist(g)[, c(2, 1)])) }) test_that("t() is aliased to edge reversal for graphs", { g <- make_graph(~ 1 -+ 2, 1 -+ 3, 1 -+ 4, 2 -+ 3, 3 -+ 4) expect_that(vcount(t(g)), equals(vcount(g))) - expect_that(get.edgelist(t(g)), equals(get.edgelist(g)[, c(2, 1)])) + expect_that(as_edgelist(t(g)), equals(as_edgelist(g)[, c(2, 1)])) }) diff --git a/tests/testthat/test-operators4.R b/tests/testthat/test-operators4.R index 411ffdf1e78..a023a615dd4 100644 --- a/tests/testthat/test-operators4.R +++ b/tests/testthat/test-operators4.R @@ -65,7 +65,7 @@ test_that("union of unnamed graphs works", { E(g1)$b1 <- letters[1:10] E(g2)$b2 <- letters[11:23] - g <- graph.union(g1, g2) + g <- union.igraph(g1, g2) expect_that( sort(graph_attr_names(g)), @@ -109,7 +109,7 @@ test_that("union of named graphs works", { E(g1)$b1 <- letters[1:10] E(g2)$b2 <- letters[11:23] - g <- graph.union(g1, g2) + g <- union.igraph(g1, g2) expect_that( sort(graph_attr_names(g)), @@ -390,7 +390,7 @@ test_that("union of non-named graphs keeps attributes properly", { E(g)$weight <- sample(ecount(g)) E(g2)$weight <- sample(ecount(g2)) - gu <- graph.union(g, g2) + gu <- union.igraph(g, g2) rn <- function(D) { rownames(D) <- paste(D[, 1], D[, 2], sep = "-") diff --git a/tests/testthat/test-rewire.R b/tests/testthat/test-rewire.R index 1913fc4fdfd..d197365e4ca 100644 --- a/tests/testthat/test-rewire.R +++ b/tests/testthat/test-rewire.R @@ -1,5 +1,5 @@ test_that("rewire(each_edge(mode='in')) keeps the in-degree distribution", { - g <- barabasi.game(1000) + g <- sample_pa(1000) g2 <- g %>% rewire(each_edge(mode = "in", multiple = T, prob = 0.2)) expect_that(degree(g, mode = "in"), equals(degree(g2, mode = "in"))) @@ -7,7 +7,7 @@ test_that("rewire(each_edge(mode='in')) keeps the in-degree distribution", { }) test_that("rewire(each_edge(mode='out')) keeps the out-degree distribution", { - g <- barabasi.game(1000) + g <- sample_pa(1000) g2 <- g %>% rewire(each_edge(mode = "out", multiple = T, prob = 0.2)) expect_that(degree(g, mode = "out"), equals(degree(g2, mode = "out"))) @@ -15,7 +15,7 @@ test_that("rewire(each_edge(mode='out')) keeps the out-degree distribution", { }) test_that("rewire() with zero probability does not do anything", { - g <- barabasi.game(100) + g <- sample_pa(100) g2 <- g %>% rewire(each_edge(prob = 0)) expect_true(identical_graphs(g, g2)) }) diff --git a/tests/testthat/test-scan.R b/tests/testthat/test-scan.R index d50db2759b1..5b5e6060d3d 100644 --- a/tests/testthat/test-scan.R +++ b/tests/testthat/test-scan.R @@ -144,12 +144,12 @@ test_that("Issue 18 is really resolved", { g <- make_graph(el) - sc1 <- sapply(graph.neighborhood(g, order = 1, mode = "all"), ecount) + sc1 <- sapply(make_ego_graph(g, order = 1, mode = "all"), ecount) sc2 <- local_scan(graph.us = g, mode = "all", k = 1) expect_that(sc1, equals(sc2)) - g2 <- induced.subgraph(g, 5:8) - sc21 <- sapply(graph.neighborhood(g2, order = 1, mode = "all"), ecount) + g2 <- induced_subgraph(g, 5:8) + sc21 <- sapply(make_ego_graph(g2, order = 1, mode = "all"), ecount) sc22 <- local_scan(graph.us = g2, mode = "all", k = 1) expect_that(sc21, equals(sc22)) }) @@ -164,8 +164,8 @@ test_that("Issue 20 is resolved", { }) test_that("FUN argument works, #32", { - r1 <- local_scan(graph.ring(10), k = 1, FUN = "ecount") - r2 <- local_scan(graph.ring(10), k = 1, FUN = ecount) + r1 <- local_scan(make_ring(10), k = 1, FUN = "ecount") + r2 <- local_scan(make_ring(10), k = 1, FUN = ecount) expect_that(r1, equals(rep(2, 10))) expect_that(r2, equals(rep(2, 10))) }) diff --git a/tests/testthat/test-transitivity.R b/tests/testthat/test-transitivity.R index 7ff9dfe71b4..8334be01639 100644 --- a/tests/testthat/test-transitivity.R +++ b/tests/testthat/test-transitivity.R @@ -23,7 +23,7 @@ test_that("transitivity works", { test_that("no integer overflow", { set.seed(42) - g <- graph.star(80000, mode = "undirected") + edges(sample(2:1000), 100) + g <- make_star(80000, mode = "undirected") + edges(sample(2:1000), 100) mtr <- min(transitivity(g, type = "local"), na.rm = TRUE) expect_true(mtr > 0) }) diff --git a/tools/deprecate-tests.R b/tools/deprecate-tests.R new file mode 100644 index 00000000000..a3efad52aad --- /dev/null +++ b/tools/deprecate-tests.R @@ -0,0 +1,118 @@ +# parse script ---- +zzz_script <- withr::local_tempfile() +curl::curl_download( + url = "https://raw.githubusercontent.com/igraph/rigraph/62c80b042dc30f5f7601f7d337218460d5a9b7d9/R/zzz-deprecate.R", + destfile = zzz_script +) + +parse_script <- function(path) { + path |> + parse(keep.source = TRUE) |> + xmlparsedata::xml_parse_data(pretty = TRUE) |> + xml2::read_xml() +} + +xml <- parse_script(zzz_script) + +# extract all calls to deprecated() +deprecated_calls <- xml2::xml_find_all( + xml, + ".//SYMBOL_FUNCTION_CALL[text()='deprecated']" +) + +tibblify_call <- function(deprecated_call) { + args <- deprecated_call |> + xml2::xml_parent() |> + xml2::xml_siblings() |> + purrr::keep(~xml2::xml_name(.x) == "expr") + old <- xml2::xml_text(args[[1]]) + new <- xml2::xml_text(args[[2]]) + tibble::tibble(old = gsub('"', '', old), new = new) +} + +deprecated_df <- purrr::map_df(deprecated_calls, tibblify_call) + +# parse main scripts ---- + +test_scripts <- fs::dir_ls(here::here("R"), glob = "*.R") + +fix_test_script <- function(test_script, deprecated_df) { + + test_lines <- brio::read_lines(test_script) + + look_for_one <- function(test_lines, old_name, new_name) { + old_name <- sub("\\.", "\\\\.", old_name) + + test_lines <- gsub( + sprintf("^%s\\(", old_name), + sprintf("%s(", new_name), + test_lines, + perl = TRUE + ) + test_lines <- gsub( + sprintf(" %s\\(", old_name), + sprintf(" %s(", new_name), + test_lines, + perl = TRUE + ) + test_lines <- gsub( + sprintf("\\(%s\\(", old_name), + sprintf("(%s(", new_name), + test_lines, + perl = TRUE + ) + } + + test_lines <- purrr::reduce2( + deprecated_df$old, deprecated_df$new, + \(test_lines, old_name, new_name) look_for_one(test_lines, old_name, new_name), + .init = test_lines + ) + + brio::write_lines(test_lines, test_script) +} + +purrr::walk(test_scripts, fix_test_script, deprecated_df = deprecated_df) + + +# parse test scripts ---- + +test_scripts <- fs::dir_ls(here::here("tests", "testthat"), glob = "*.R") + +fix_test_script <- function(test_script, deprecated_df) { + + test_lines <- brio::read_lines(test_script) + + look_for_one <- function(test_lines, old_name, new_name) { + old_name <- sub("\\.", "\\\\.", old_name) + + test_lines <- gsub( + sprintf("^%s\\(", old_name), + sprintf("%s(", new_name), + test_lines, + perl = TRUE + ) + test_lines <- gsub( + sprintf(" %s\\(", old_name), + sprintf(" %s(", new_name), + test_lines, + perl = TRUE + ) + test_lines <- gsub( + sprintf("\\(%s\\(", old_name), + sprintf("(%s(", new_name), + test_lines, + perl = TRUE + ) + } + + test_lines <- purrr::reduce2( + deprecated_df$old, deprecated_df$new, + \(test_lines, old_name, new_name) look_for_one(test_lines, old_name, new_name), + .init = test_lines + ) + + brio::write_lines(test_lines, test_script) +} + +purrr::walk(test_scripts, fix_test_script, deprecated_df = deprecated_df)