diff --git a/R/community.R b/R/community.R index 43b1519775..4627d8cd84 100644 --- a/R/community.R +++ b/R/community.R @@ -1236,7 +1236,7 @@ cluster_leiden <- function(graph, objective_function = c("CPM", "modularity"), #' @export #' @keywords graphs #' @examples -#' g <- graph.famous("Zachary") +#' g <- make_graph("Zachary") #' comms <- cluster_fluid_communities(g, 2) cluster_fluid_communities <- function(graph, no.of.communities) { # Argument checks diff --git a/R/fit.R b/R/fit.R index 3fd8589a5c..4a9db033b7 100644 --- a/R/fit.R +++ b/R/fit.R @@ -113,7 +113,7 @@ #' @examples #' #' # This should approximately yield the correct exponent 3 -#' g <- barabasi.game(1000) # increase this number to have a better estimate +#' g <- sample_pa(1000) # increase this number to have a better estimate #' d <- degree(g, mode = "in") #' fit1 <- fit_power_law(d + 1, 10) #' fit2 <- fit_power_law(d + 1, 10, implementation = "R.mle") diff --git a/R/flow.R b/R/flow.R index a6b7ffe7a2..992b15a544 100644 --- a/R/flow.R +++ b/R/flow.R @@ -207,9 +207,9 @@ min_cut <- function(graph, source = NULL, target = NULL, capacity = NULL, value. #' @keywords graphs #' @examples #' -#' g <- barabasi.game(100, m = 1) +#' g <- sample_pa(100, m = 1) #' g <- delete_edges(g, E(g)[100 %--% 1]) -#' g2 <- barabasi.game(100, m = 5) +#' g2 <- sample_pa(100, m = 5) #' g2 <- delete_edges(g2, E(g2)[100 %--% 1]) #' vertex_connectivity(g, 100, 1) #' vertex_connectivity(g2, 100, 1) @@ -299,8 +299,8 @@ vertex_connectivity <- function(graph, source = NULL, target = NULL, checks = TR #' @keywords graphs #' @examples #' -#' g <- barabasi.game(100, m = 1) -#' g2 <- barabasi.game(100, m = 5) +#' g <- sample_pa(100, m = 1) +#' g2 <- sample_pa(100, m = 5) #' edge_connectivity(g, 100, 1) #' edge_connectivity(g2, 100, 1) #' edge_disjoint_paths(g2, 100, 1) @@ -785,11 +785,11 @@ is_min_separator <- is_minimal_separator_impl #' ) #' #' # Cohesive subgraphs -#' mw1 <- induced.subgraph(mw, as.character(c(1:7, 17:23))) -#' mw2 <- induced.subgraph(mw, as.character(7:16)) -#' mw3 <- induced.subgraph(mw, as.character(17:23)) -#' mw4 <- induced.subgraph(mw, as.character(c(7, 8, 11, 14))) -#' mw5 <- induced.subgraph(mw, as.character(1:7)) +#' mw1 <- induced_subgraph(mw, as.character(c(1:7, 17:23))) +#' mw2 <- induced_subgraph(mw, as.character(7:16)) +#' mw3 <- induced_subgraph(mw, as.character(17:23)) +#' mw4 <- induced_subgraph(mw, as.character(c(7, 8, 11, 14))) +#' mw5 <- induced_subgraph(mw, as.character(1:7)) #' #' min_separators(mw) #' min_separators(mw1) diff --git a/R/motifs.R b/R/motifs.R index bcb550d1e4..f688e47192 100644 --- a/R/motifs.R +++ b/R/motifs.R @@ -47,7 +47,7 @@ #' @family graph motifs #' #' @examples -#' g <- barabasi.game(100) +#' g <- sample_pa(100) #' motifs(g, 3) #' count_motifs(g, 3) #' sample_motifs(g, 3) @@ -91,7 +91,7 @@ motifs <- function(graph, size = 3, cut.prob = rep(0, size)) { #' @family graph motifs #' #' @examples -#' g <- barabasi.game(100) +#' g <- sample_pa(100) #' motifs(g, 3) #' count_motifs(g, 3) #' sample_motifs(g, 3) @@ -139,7 +139,7 @@ count_motifs <- function(graph, size = 3, cut.prob = rep(0, size)) { #' @family graph motifs #' #' @examples -#' g <- barabasi.game(100) +#' g <- sample_pa(100) #' motifs(g, 3) #' count_motifs(g, 3) #' sample_motifs(g, 3) diff --git a/R/rewire.R b/R/rewire.R index cbb465af24..64d7ad9205 100644 --- a/R/rewire.R +++ b/R/rewire.R @@ -123,7 +123,7 @@ rewire_keeping_degseq <- function(graph, loops, niter) { #' #' # Rewiring the start of each directed edge preserves the in-degree distribution #' # but not the out-degree distribution -#' g <- barabasi.game(1000) +#' g <- sample_pa(1000) #' g2 <- g %>% rewire(each_edge(mode = "in", multiple = TRUE, prob = 0.2)) #' degree(g, mode = "in") == degree(g2, mode = "in") each_edge <- function(prob, loops = FALSE, multiple = FALSE, mode = c("all", "out", "in", "total")) { diff --git a/R/sgm.R b/R/sgm.R index e09f6e94f9..7fa2c85b12 100644 --- a/R/sgm.R +++ b/R/sgm.R @@ -66,8 +66,8 @@ solve_LSAP <- function(x, maximum = FALSE) { #' g1 <- sample_gnp(10, 0.1) #' randperm <- c(1:3, 3 + sample(7)) #' g2 <- sample_correlated_gnp(g1, corr = 1, p = g1$p, permutation = randperm) -#' A <- as.matrix(get.adjacency(g1)) -#' B <- as.matrix(get.adjacency(g2)) +#' A <- as_adjacency_matrix(g1) +#' B <- as_adjacency_matrix(g2) #' P <- match_vertices(A, B, m = 3, start = diag(rep(1, nrow(A) - 3)), 20) #' P #' @family sgm diff --git a/R/structural.properties.R b/R/structural.properties.R index bf6b9ab328..2598fa20c9 100644 --- a/R/structural.properties.R +++ b/R/structural.properties.R @@ -1327,7 +1327,7 @@ coreness <- function(graph, mode = c("all", "out", "in")) { #' @export #' @examples #' -#' g <- barabasi.game(100) +#' g <- sample_pa(100) #' topo_sort(g) #' topo_sort <- function(graph, mode = c("out", "all", "in")) { @@ -1486,7 +1486,7 @@ girth <- function(graph, circle = TRUE) { #' which_loop(g) #' #' # Multiple edges -#' g <- barabasi.game(10, m = 3, algorithm = "bag") +#' g <- sample_pa(10, m = 3, algorithm = "bag") #' any_multiple(g) #' which_multiple(g) #' count_multiple(g) @@ -1494,11 +1494,11 @@ girth <- function(graph, circle = TRUE) { #' all(count_multiple(simplify(g)) == 1) #' #' # Direction of the edge is important -#' which_multiple(graph(c(1, 2, 2, 1))) -#' which_multiple(graph(c(1, 2, 2, 1), dir = FALSE)) +#' which_multiple(make_graph(c(1, 2, 2, 1))) +#' which_multiple(make_graph(c(1, 2, 2, 1), dir = FALSE)) #' #' # Remove multiple edges but keep multiplicity -#' g <- barabasi.game(10, m = 3, algorithm = "bag") +#' g <- sample_pa(10, m = 3, algorithm = "bag") #' E(g)$weight <- count_multiple(g) #' g <- simplify(g, edge.attr.comb = list(weight = "min")) #' any(which_multiple(g)) diff --git a/R/topology.R b/R/topology.R index 3110182dd2..421a3d5291 100644 --- a/R/topology.R +++ b/R/topology.R @@ -276,7 +276,7 @@ graph.subisomorphic.lad <- function(pattern, target, domains = NULL, #' isomorphic(g1, g2) #' #' # create two isomorphic graphs, by permuting the vertices of the first -#' g1 <- barabasi.game(30, m = 2, directed = FALSE) +#' g1 <- sample_pa(30, m = 2, directed = FALSE) #' g2 <- permute(g1, sample(vcount(g1))) #' # should be TRUE #' isomorphic(g1, g2) diff --git a/man/cluster_fluid_communities.Rd b/man/cluster_fluid_communities.Rd index 84369a92ae..cfefcfd373 100644 --- a/man/cluster_fluid_communities.Rd +++ b/man/cluster_fluid_communities.Rd @@ -25,7 +25,7 @@ several fluids interacting in a non-homogeneous environment interaction and density. } \examples{ -g <- graph.famous("Zachary") +g <- make_graph("Zachary") comms <- cluster_fluid_communities(g, 2) } \references{ diff --git a/man/count_motifs.Rd b/man/count_motifs.Rd index 6d715eec10..8a14b774ad 100644 --- a/man/count_motifs.Rd +++ b/man/count_motifs.Rd @@ -28,7 +28,7 @@ structure. These functions search a graph for various motifs. size in graph. } \examples{ -g <- barabasi.game(100) +g <- sample_pa(100) motifs(g, 3) count_motifs(g, 3) sample_motifs(g, 3) diff --git a/man/each_edge.Rd b/man/each_edge.Rd index d7bc14d020..e8be36cca6 100644 --- a/man/each_edge.Rd +++ b/man/each_edge.Rd @@ -43,7 +43,7 @@ mean_distance(g) # Rewiring the start of each directed edge preserves the in-degree distribution # but not the out-degree distribution -g <- barabasi.game(1000) +g <- sample_pa(1000) g2 <- g \%>\% rewire(each_edge(mode = "in", multiple = TRUE, prob = 0.2)) degree(g, mode = "in") == degree(g2, mode = "in") } diff --git a/man/edge_connectivity.Rd b/man/edge_connectivity.Rd index 9d695e2321..a6305d1da8 100644 --- a/man/edge_connectivity.Rd +++ b/man/edge_connectivity.Rd @@ -61,8 +61,8 @@ included only for having more descriptive function names. } \examples{ -g <- barabasi.game(100, m = 1) -g2 <- barabasi.game(100, m = 5) +g <- sample_pa(100, m = 1) +g2 <- sample_pa(100, m = 5) edge_connectivity(g, 100, 1) edge_connectivity(g2, 100, 1) edge_disjoint_paths(g2, 100, 1) diff --git a/man/fit_power_law.Rd b/man/fit_power_law.Rd index cc6527578d..f58242b10a 100644 --- a/man/fit_power_law.Rd +++ b/man/fit_power_law.Rd @@ -98,7 +98,7 @@ parameters of the fitted distribution. See references below for the details. \examples{ # This should approximately yield the correct exponent 3 -g <- barabasi.game(1000) # increase this number to have a better estimate +g <- sample_pa(1000) # increase this number to have a better estimate d <- degree(g, mode = "in") fit1 <- fit_power_law(d + 1, 10) fit2 <- fit_power_law(d + 1, 10, implementation = "R.mle") diff --git a/man/isomorphic.Rd b/man/isomorphic.Rd index 745a45c710..7db4b283cd 100644 --- a/man/isomorphic.Rd +++ b/man/isomorphic.Rd @@ -100,7 +100,7 @@ g2 <- graph_from_isomorphism_class(3, 11) isomorphic(g1, g2) # create two isomorphic graphs, by permuting the vertices of the first -g1 <- barabasi.game(30, m = 2, directed = FALSE) +g1 <- sample_pa(30, m = 2, directed = FALSE) g2 <- permute(g1, sample(vcount(g1))) # should be TRUE isomorphic(g1, g2) diff --git a/man/match_vertices.Rd b/man/match_vertices.Rd index 2113f39287..f65f79ae54 100644 --- a/man/match_vertices.Rd +++ b/man/match_vertices.Rd @@ -56,8 +56,8 @@ See references for further details. g1 <- sample_gnp(10, 0.1) randperm <- c(1:3, 3 + sample(7)) g2 <- sample_correlated_gnp(g1, corr = 1, p = g1$p, permutation = randperm) -A <- as.matrix(get.adjacency(g1)) -B <- as.matrix(get.adjacency(g2)) +A <- as_adjacency_matrix(g1) +B <- as_adjacency_matrix(g2) P <- match_vertices(A, B, m = 3, start = diag(rep(1, nrow(A) - 3)), 20) P } diff --git a/man/min_separators.Rd b/man/min_separators.Rd index e5ba8fd1cc..d7e344fe01 100644 --- a/man/min_separators.Rd +++ b/man/min_separators.Rd @@ -38,11 +38,11 @@ mw <- graph_from_literal( ) # Cohesive subgraphs -mw1 <- induced.subgraph(mw, as.character(c(1:7, 17:23))) -mw2 <- induced.subgraph(mw, as.character(7:16)) -mw3 <- induced.subgraph(mw, as.character(17:23)) -mw4 <- induced.subgraph(mw, as.character(c(7, 8, 11, 14))) -mw5 <- induced.subgraph(mw, as.character(1:7)) +mw1 <- induced_subgraph(mw, as.character(c(1:7, 17:23))) +mw2 <- induced_subgraph(mw, as.character(7:16)) +mw3 <- induced_subgraph(mw, as.character(17:23)) +mw4 <- induced_subgraph(mw, as.character(c(7, 8, 11, 14))) +mw5 <- induced_subgraph(mw, as.character(1:7)) min_separators(mw) min_separators(mw1) diff --git a/man/motifs.Rd b/man/motifs.Rd index 758cf8213a..7366d2ae96 100644 --- a/man/motifs.Rd +++ b/man/motifs.Rd @@ -34,7 +34,7 @@ the motifs is defined by their isomorphism class, see \code{\link[=isomorphism_class]{isomorphism_class()}}. } \examples{ -g <- barabasi.game(100) +g <- sample_pa(100) motifs(g, 3) count_motifs(g, 3) sample_motifs(g, 3) diff --git a/man/sample_motifs.Rd b/man/sample_motifs.Rd index a553bc0488..3b1916d9e2 100644 --- a/man/sample_motifs.Rd +++ b/man/sample_motifs.Rd @@ -42,7 +42,7 @@ structure. These functions search a graph for various motifs. size in a graph based on a sample. } \examples{ -g <- barabasi.game(100) +g <- sample_pa(100) motifs(g, 3) count_motifs(g, 3) sample_motifs(g, 3) diff --git a/man/topo_sort.Rd b/man/topo_sort.Rd index 84a34bc411..1fb21d6a6d 100644 --- a/man/topo_sort.Rd +++ b/man/topo_sort.Rd @@ -33,7 +33,7 @@ and a warning is issued. } \examples{ -g <- barabasi.game(100) +g <- sample_pa(100) topo_sort(g) } diff --git a/man/vertex_connectivity.Rd b/man/vertex_connectivity.Rd index 2f98c5e893..d9b1ccea4e 100644 --- a/man/vertex_connectivity.Rd +++ b/man/vertex_connectivity.Rd @@ -73,9 +73,9 @@ included only for the ease of using more descriptive function names. } \examples{ -g <- barabasi.game(100, m = 1) +g <- sample_pa(100, m = 1) g <- delete_edges(g, E(g)[100 \%--\% 1]) -g2 <- barabasi.game(100, m = 5) +g2 <- sample_pa(100, m = 5) g2 <- delete_edges(g2, E(g2)[100 \%--\% 1]) vertex_connectivity(g, 100, 1) vertex_connectivity(g2, 100, 1) diff --git a/man/which_multiple.Rd b/man/which_multiple.Rd index cfc7d62fdf..1282a3a5ce 100644 --- a/man/which_multiple.Rd +++ b/man/which_multiple.Rd @@ -59,7 +59,7 @@ any_loop(g) which_loop(g) # Multiple edges -g <- barabasi.game(10, m = 3, algorithm = "bag") +g <- sample_pa(10, m = 3, algorithm = "bag") any_multiple(g) which_multiple(g) count_multiple(g) @@ -67,11 +67,11 @@ which_multiple(simplify(g)) all(count_multiple(simplify(g)) == 1) # Direction of the edge is important -which_multiple(graph(c(1, 2, 2, 1))) -which_multiple(graph(c(1, 2, 2, 1), dir = FALSE)) +which_multiple(make_graph(c(1, 2, 2, 1))) +which_multiple(make_graph(c(1, 2, 2, 1), dir = FALSE)) # Remove multiple edges but keep multiplicity -g <- barabasi.game(10, m = 3, algorithm = "bag") +g <- sample_pa(10, m = 3, algorithm = "bag") E(g)$weight <- count_multiple(g) g <- simplify(g, edge.attr.comb = list(weight = "min")) any(which_multiple(g)) diff --git a/tests/testthat/_snaps/plot/basic-graph-r-4-2.svg b/tests/testthat/_snaps/plot/basic-graph-r-4-2.svg deleted file mode 100644 index fddeb30284..0000000000 --- a/tests/testthat/_snaps/plot/basic-graph-r-4-2.svg +++ /dev/null @@ -1,40 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -2 -3 - - diff --git a/tools/update-examples.R b/tools/update-examples.R new file mode 100644 index 0000000000..28783e737d --- /dev/null +++ b/tools/update-examples.R @@ -0,0 +1,74 @@ +zzz_script <- here::here("R", "zzz-deprecate.R") + +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) + +detect_fun <- function(fun_name, lines) { + file <- withr::local_tempfile() + brio::write_lines(lines, file) + xml <- parse_script(file) + called_funs <- xml2::xml_find_all(xml, ".//SYMBOL_FUNCTION_CALL") |> xml2::xml_text() + + any(called_funs == fun_name) + +} + +topics <- pkgdown::as_pkgdown()[["topics"]] + +treat_topic <- function(topic, deprecated_df) { + message(topic) + lines <- example(topic, character.only = TRUE, package = "igraph", give.lines = TRUE) + + no_example <- is.null(lines) + if (no_example) { + return(invisible()) + } + + deprecated_in_there <- deprecated_df[ + purrr::map_lgl( + split(deprecated_df, seq(nrow(deprecated_df))), + ~ detect_fun(.x[["old"]], lines) + ), + ] + if (nrow(deprecated_in_there > 0)) { + return(tibble::tibble( + topic = topic, + deprecated = toString(deprecated_in_there[["old"]]) + )) + } + + NULL + +} + +df <- purrr::map_df(topics[["name"]], treat_topic, deprecated_df = deprecated_df) +# Update by hand, document(), R CMD build, re-run script to be sure +if (nrow(df) > 0) { + View(df) +} else { + message("All fixed! :-)") +}