From 58accd2323ca62768c9d30fb26ce54f9b6738289 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Tue, 4 Jun 2024 14:56:57 +0200 Subject: [PATCH 1/3] refactor!: change make.R --- R/make.R | 669 ++++++++++++++++++++++++++--- man/graph.Rd | 61 +++ man/graph.atlas.Rd | 18 + man/graph.bipartite.Rd | 30 ++ man/graph.de.bruijn.Rd | 20 + man/graph.empty.Rd | 20 + man/graph.extended.chordal.ring.Rd | 23 + man/graph.famous.Rd | 61 +++ man/graph.formula.Rd | 24 ++ man/graph.full.Rd | 22 + man/graph.full.bipartite.Rd | 28 ++ man/graph.full.citation.Rd | 20 + man/graph.kautz.Rd | 20 + man/graph.lattice.Rd | 43 ++ man/graph.lcf.Rd | 22 + man/graph.ring.Rd | 27 ++ man/graph.star.Rd | 26 ++ man/graph.tree.Rd | 27 ++ man/graph_from_atlas.Rd | 1 - man/graph_from_lcf.Rd | 1 - man/graph_from_literal.Rd | 1 - man/line.graph.Rd | 18 + man/make_bipartite_graph.Rd | 1 - man/make_chordal_ring.Rd | 1 - man/make_de_bruijn_graph.Rd | 1 - man/make_empty_graph.Rd | 1 - man/make_full_bipartite_graph.Rd | 1 - man/make_full_citation_graph.Rd | 1 - man/make_full_graph.Rd | 1 - man/make_graph.Rd | 2 - man/make_kautz_graph.Rd | 1 - man/make_lattice.Rd | 1 - man/make_line_graph.Rd | 1 - man/make_ring.Rd | 1 - man/make_star.Rd | 1 - man/make_tree.Rd | 1 - 36 files changed, 1126 insertions(+), 71 deletions(-) create mode 100644 man/graph.Rd create mode 100644 man/graph.atlas.Rd create mode 100644 man/graph.bipartite.Rd create mode 100644 man/graph.de.bruijn.Rd create mode 100644 man/graph.empty.Rd create mode 100644 man/graph.extended.chordal.ring.Rd create mode 100644 man/graph.famous.Rd create mode 100644 man/graph.formula.Rd create mode 100644 man/graph.full.Rd create mode 100644 man/graph.full.bipartite.Rd create mode 100644 man/graph.full.citation.Rd create mode 100644 man/graph.kautz.Rd create mode 100644 man/graph.lattice.Rd create mode 100644 man/graph.lcf.Rd create mode 100644 man/graph.ring.Rd create mode 100644 man/graph.star.Rd create mode 100644 man/graph.tree.Rd create mode 100644 man/line.graph.Rd diff --git a/R/make.R b/R/make.R index 06e653be9b0..0f75dca76fe 100644 --- a/R/make.R +++ b/R/make.R @@ -1,4 +1,619 @@ +#' Create an igraph graph from a list of edges, or a notable graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph()` was renamed to `make_graph()` to create a more +#' consistent API. +#' @inheritParams make_graph +#' @keywords internal +#' @export +graph <- function(edges , ... , n = max(edges) , isolates = NULL , directed = TRUE , dir = directed , simplify = TRUE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph()", "make_graph()") + if (inherits(edges, "formula")) { + if (!missing(n)) stop("'n' should not be given for graph literals") + if (!missing(isolates)) { + stop("'isolates' should not be given for graph literals") + } + if (!missing(directed)) { + stop("'directed' should not be given for graph literals") + } + + mf <- as.list(match.call())[-1] + mf[[1]] <- mf[[1]][[2]] + graph_from_literal_i(mf) + } else { + if (!missing(simplify)) { + stop("'simplify' should only be used for graph literals") + } + + if (!missing(dir) && !missing(directed)) { + stop("Only give one of 'dir' and 'directed'") + } + + if (!missing(dir) && missing(directed)) directed <- dir + + if (is.character(edges) && length(edges) == 1) { + if (!missing(n)) warning("'n' is ignored for the '", edges, "' graph") + if (!missing(isolates)) { + warning("'isolates' is ignored for the '", edges, "' graph") + } + if (!missing(directed)) { + warning("'directed' is ignored for the '", edges, "' graph") + } + if (!missing(dir)) { + warning("'dir' is ignored for the '", edges, "' graph") + } + if (length(list(...))) stop("Extra arguments in make_graph") + + make_famous_graph(edges) + + ## NULL and empty logical vector is allowed for compatibility + } else if (is.numeric(edges) || is.null(edges) || + (is.logical(edges) && length(edges) == 0)) { + if (is.null(edges) || is.logical(edges)) edges <- as.numeric(edges) + if (!is.null(isolates)) { + warning("'isolates' ignored for numeric edge list") + } + + old_graph <- function(edges, n = max(edges), directed = TRUE) { + on.exit(.Call(R_igraph_finalizer)) + if (missing(n) && (is.null(edges) || length(edges) == 0)) { + n <- 0 + } + .Call( + R_igraph_create, as.numeric(edges) - 1, as.numeric(n), + as.logical(directed) + ) + } + + args <- list(edges, ...) + if (!missing(n)) args <- c(args, list(n = n)) + if (!missing(directed)) args <- c(args, list(directed = directed)) + + do.call(old_graph, args) + } else if (is.character(edges)) { + if (!missing(n)) { + warning("'n' is ignored for edge list with vertex names") + } + if (length(list(...))) stop("Extra arguments in make_graph") + + el <- matrix(edges, ncol = 2, byrow = TRUE) + res <- graph_from_edgelist(el, directed = directed) + if (!is.null(isolates)) { + isolates <- as.character(isolates) + res <- res + vertices(isolates) + } + res + } else { + stop("'edges' must be numeric or character") + } + } +} # nocov end + +#' Create an igraph graph from a list of edges, or a notable graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.famous()` was renamed to `make_graph()` to create a more +#' consistent API. +#' @inheritParams make_graph +#' @keywords internal +#' @export +graph.famous <- function(edges , ... , n = max(edges) , isolates = NULL , directed = TRUE , dir = directed , simplify = TRUE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.famous()", "make_graph()") + if (inherits(edges, "formula")) { + if (!missing(n)) stop("'n' should not be given for graph literals") + if (!missing(isolates)) { + stop("'isolates' should not be given for graph literals") + } + if (!missing(directed)) { + stop("'directed' should not be given for graph literals") + } + + mf <- as.list(match.call())[-1] + mf[[1]] <- mf[[1]][[2]] + graph_from_literal_i(mf) + } else { + if (!missing(simplify)) { + stop("'simplify' should only be used for graph literals") + } + + if (!missing(dir) && !missing(directed)) { + stop("Only give one of 'dir' and 'directed'") + } + + if (!missing(dir) && missing(directed)) directed <- dir + + if (is.character(edges) && length(edges) == 1) { + if (!missing(n)) warning("'n' is ignored for the '", edges, "' graph") + if (!missing(isolates)) { + warning("'isolates' is ignored for the '", edges, "' graph") + } + if (!missing(directed)) { + warning("'directed' is ignored for the '", edges, "' graph") + } + if (!missing(dir)) { + warning("'dir' is ignored for the '", edges, "' graph") + } + if (length(list(...))) stop("Extra arguments in make_graph") + + make_famous_graph(edges) + + ## NULL and empty logical vector is allowed for compatibility + } else if (is.numeric(edges) || is.null(edges) || + (is.logical(edges) && length(edges) == 0)) { + if (is.null(edges) || is.logical(edges)) edges <- as.numeric(edges) + if (!is.null(isolates)) { + warning("'isolates' ignored for numeric edge list") + } + + old_graph <- function(edges, n = max(edges), directed = TRUE) { + on.exit(.Call(R_igraph_finalizer)) + if (missing(n) && (is.null(edges) || length(edges) == 0)) { + n <- 0 + } + .Call( + R_igraph_create, as.numeric(edges) - 1, as.numeric(n), + as.logical(directed) + ) + } + + args <- list(edges, ...) + if (!missing(n)) args <- c(args, list(n = n)) + if (!missing(directed)) args <- c(args, list(directed = directed)) + + do.call(old_graph, args) + } else if (is.character(edges)) { + if (!missing(n)) { + warning("'n' is ignored for edge list with vertex names") + } + if (length(list(...))) stop("Extra arguments in make_graph") + + el <- matrix(edges, ncol = 2, byrow = TRUE) + res <- graph_from_edgelist(el, directed = directed) + if (!is.null(isolates)) { + isolates <- as.character(isolates) + res <- res + vertices(isolates) + } + res + } else { + stop("'edges' must be numeric or character") + } + } +} # nocov end + +#' Line graph of a graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `line.graph()` was renamed to `make_line_graph()` to create a more +#' consistent API. +#' @inheritParams make_line_graph +#' @keywords internal +#' @export +line.graph <- function(graph) { # nocov start + lifecycle::deprecate_soft("2.0.4", "line.graph()", "make_line_graph()") + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + res <- .Call(R_igraph_linegraph, graph) + if (igraph_opt("add.params")) { + res$name <- "Line graph" + } + res +} # nocov end + +#' Create a ring graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.ring()` was renamed to `make_ring()` to create a more +#' consistent API. +#' @inheritParams make_ring +#' @keywords internal +#' @export +graph.ring <- function(n , directed = FALSE , mutual = FALSE , circular = TRUE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.ring()", "make_ring()") + on.exit(.Call(R_igraph_finalizer)) + res <- .Call( + R_igraph_ring, as.numeric(n), as.logical(directed), + as.logical(mutual), as.logical(circular) + ) + if (igraph_opt("add.params")) { + res$name <- "Ring graph" + res$mutual <- mutual + res$circular <- circular + } + res +} # nocov end + +#' Create tree graphs +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.tree()` was renamed to `make_tree()` to create a more +#' consistent API. +#' @inheritParams make_tree +#' @keywords internal +#' @export +graph.tree <- function(n , children = 2 , mode = c("out","in","undirected")) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.tree()", "make_tree()") + mode <- igraph.match.arg(mode) + mode1 <- switch(mode, + "out" = 0, + "in" = 1, + "undirected" = 2 + ) + + on.exit(.Call(R_igraph_finalizer)) + res <- .Call( + R_igraph_kary_tree, as.numeric(n), as.numeric(children), + as.numeric(mode1) + ) + if (igraph_opt("add.params")) { + res$name <- "Tree" + res$children <- children + res$mode <- mode + } + res +} # nocov end + +#' Create a star graph, a tree with n vertices and n - 1 leaves +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.star()` was renamed to `make_star()` to create a more +#' consistent API. +#' @inheritParams make_star +#' @keywords internal +#' @export +graph.star <- function(n , mode = c("in","out","mutual","undirected") , center = 1) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.star()", "make_star()") + mode <- igraph.match.arg(mode) + mode1 <- switch(mode, + "out" = 0, + "in" = 1, + "undirected" = 2, + "mutual" = 3 + ) + + on.exit(.Call(R_igraph_finalizer)) + res <- .Call( + R_igraph_star, as.numeric(n), as.numeric(mode1), + as.numeric(center) - 1 + ) + if (igraph_opt("add.params")) { + res$name <- switch(mode, + "in" = "In-star", + "out" = "Out-star", + "Star" + ) + res$mode <- mode + res$center <- center + } + res +} # nocov end + +#' Creating a graph from LCF notation +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.lcf()` was renamed to `graph_from_lcf()` to create a more +#' consistent API. +#' @inheritParams graph_from_lcf +#' @keywords internal +#' @export +graph.lcf <- function(n , shifts , repeats = 1) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.lcf()", "graph_from_lcf()") + # Argument checks + n <- as.numeric(n) + shifts <- as.numeric(shifts) + repeats <- as.numeric(repeats) + + on.exit( .Call(R_igraph_finalizer) ) + # Function call + res <- .Call(R_igraph_lcf_vector, n, shifts, repeats) + + if (igraph_opt("add.params")) { + res$name <- 'LCF graph' + } + + res +} # nocov end + +#' Create a lattice graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.lattice()` was renamed to `make_lattice()` to create a more +#' consistent API. +#' @inheritParams make_lattice +#' @keywords internal +#' @export +graph.lattice <- function(dimvector = NULL , length = NULL , dim = NULL , nei = 1 , directed = FALSE , mutual = FALSE , circular = FALSE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.lattice()", "make_lattice()") + if (is.numeric(length) && length != floor(length)) { + warning("length was rounded to the nearest integer") + length <- round(length) + } + + if (is.null(dimvector)) { + dimvector <- rep(length, dim) + } + + on.exit(.Call(R_igraph_finalizer)) + res <- .Call( + R_igraph_lattice, as.numeric(dimvector), as.numeric(nei), + as.logical(directed), as.logical(mutual), + as.logical(circular) + ) + if (igraph_opt("add.params")) { + res$name <- "Lattice graph" + res$dimvector <- dimvector + res$nei <- nei + res$mutual <- mutual + res$circular <- circular + } + res +} # nocov end + +#' Kautz graphs +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.kautz()` was renamed to `make_kautz_graph()` to create a more +#' consistent API. +#' @inheritParams make_kautz_graph +#' @keywords internal +#' @export +graph.kautz <- function(m , n) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.kautz()", "make_kautz_graph()") + on.exit(.Call(R_igraph_finalizer)) + res <- .Call(R_igraph_kautz, as.numeric(m), as.numeric(n)) + if (igraph_opt("add.params")) { + res$name <- sprintf("Kautz graph %i-%i", m, n) + res$m <- m + res$n <- n + } + res +} # nocov end + +#' Create a complete (full) citation graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.full.citation()` was renamed to `make_full_citation_graph()` to create a more +#' consistent API. +#' @inheritParams make_full_citation_graph +#' @keywords internal +#' @export +graph.full.citation <- function(n , directed = TRUE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.full.citation()", "make_full_citation_graph()") + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call(R_igraph_full_citation, n, directed) + + res <- set_graph_attr(res, "name", "Full citation graph") + res +} # nocov end + +#' Create a full bipartite graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.full.bipartite()` was renamed to `make_full_bipartite_graph()` to create a more +#' consistent API. +#' @inheritParams make_full_bipartite_graph +#' @keywords internal +#' @export +graph.full.bipartite <- function(n1 , n2 , directed = FALSE , mode = c("all","out","in")) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.full.bipartite()", "make_full_bipartite_graph()") + n1 <- as.numeric(n1) + n2 <- as.numeric(n2) + directed <- as.logical(directed) + mode1 <- switch(igraph.match.arg(mode), + "out" = 1, + "in" = 2, + "all" = 3, + "total" = 3 + ) + + on.exit(.Call(R_igraph_finalizer)) + res <- .Call(R_igraph_full_bipartite, n1, n2, as.logical(directed), mode1) + if (igraph_opt("add.params")) { + res$graph$name <- "Full bipartite graph" + res$n1 <- n1 + res$n2 <- n2 + res$mode <- mode + } + set_vertex_attr(res$graph, "type", value = res$types) +} # nocov end + +#' Create a full graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.full()` was renamed to `make_full_graph()` to create a more +#' consistent API. +#' @inheritParams make_full_graph +#' @keywords internal +#' @export +graph.full <- function(n , directed = FALSE , loops = FALSE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.full()", "make_full_graph()") + on.exit(.Call(R_igraph_finalizer)) + res <- .Call( + R_igraph_full, as.numeric(n), as.logical(directed), + as.logical(loops) + ) + if (igraph_opt("add.params")) { + res$name <- "Full graph" + res$loops <- loops + } + res +} # nocov end + +#' Creating (small) graphs via a simple interface +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.formula()` was renamed to `graph_from_literal()` to create a more +#' consistent API. +#' @inheritParams graph_from_literal +#' @keywords internal +#' @export +graph.formula <- function(... , simplify = TRUE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.formula()", "graph_from_literal()") + mf <- as.list(match.call())[-1] + graph_from_literal_i(mf) +} # nocov end + +#' Create an extended chordal ring graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.extended.chordal.ring()` was renamed to `make_chordal_ring()` to create a more +#' consistent API. +#' @inheritParams make_chordal_ring +#' @keywords internal +#' @export +graph.extended.chordal.ring <- function(n , w , directed = FALSE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.extended.chordal.ring()", "make_chordal_ring()") + on.exit(.Call(R_igraph_finalizer)) + res <- .Call( + R_igraph_extended_chordal_ring, as.numeric(n), + as.matrix(w), as.logical(directed) + ) + if (igraph_opt("add.params")) { + res$name <- "Extended chordal ring" + res$w <- w + } + res +} # nocov end + +#' A graph with no edges +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.empty()` was renamed to `make_empty_graph()` to create a more +#' consistent API. +#' @inheritParams make_empty_graph +#' @keywords internal +#' @export +graph.empty <- function(n = 0 , directed = TRUE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.empty()", "make_empty_graph()") + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit( .Call(R_igraph_finalizer) ) + # Function call + res <- .Call(R_igraph_empty, n, directed) + + res +} # nocov end + +#' De Bruijn graphs +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.de.bruijn()` was renamed to `make_de_bruijn_graph()` to create a more +#' consistent API. +#' @inheritParams make_de_bruijn_graph +#' @keywords internal +#' @export +graph.de.bruijn <- function(m , n) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.de.bruijn()", "make_de_bruijn_graph()") + on.exit(.Call(R_igraph_finalizer)) + res <- .Call(R_igraph_de_bruijn, as.numeric(m), as.numeric(n)) + if (igraph_opt("add.params")) { + res$name <- sprintf("De-Bruijn graph %i-%i", m, n) + res$m <- m + res$n <- n + } + res +} # nocov end + +#' Create a bipartite graph +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.bipartite()` was renamed to `make_bipartite_graph()` to create a more +#' consistent API. +#' @inheritParams make_bipartite_graph +#' @keywords internal +#' @export +graph.bipartite <- function(types , edges , directed = FALSE) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.bipartite()", "make_bipartite_graph()") + vertex.names <- names(types) + + if (is.character(edges)) { + if (is.null(vertex.names)) { + stop("`types` vector must be named when the edge vector contains strings") + } + edges <- match(edges, vertex.names) + if (any(is.na(edges))) { + stop("edge vector contains a vertex name that is not found in `types`") + } + } + + types <- as.logical(types) + edges <- as.numeric(edges) - 1 + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + res <- .Call(R_igraph_create_bipartite, types, edges, directed) + res <- set_vertex_attr(res, "type", value = types) + + if (!is.null(vertex.names)) { + res <- set_vertex_attr(res, "name", value = vertex.names) + } + + res +} # nocov end + +#' Create a graph from the Graph Atlas +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `graph.atlas()` was renamed to `graph_from_atlas()` to create a more +#' consistent API. +#' @inheritParams graph_from_atlas +#' @keywords internal +#' @export +graph.atlas <- function(n) { # nocov start + lifecycle::deprecate_soft("2.0.4", "graph.atlas()", "graph_from_atlas()") + on.exit(.Call(R_igraph_finalizer)) + res <- .Call(R_igraph_atlas, as.numeric(n)) + if (igraph_opt("add.params")) { + res$name <- sprintf("Graph from the Atlas #%i", n) + res$n <- n + } + res +} # nocov end + ## ---------------------------------------------------------------- ## ## IGraph R package @@ -506,7 +1121,6 @@ with_graph_ <- function(...) { #' groups, Journal of Anthropological Research 33, 452-473 (1977). } } #' #' @encoding UTF-8 -#' @aliases graph.famous graph #' @param edges A vector defining the edges, the first edge points #' from the first element to the second, the second edge from the third #' to the fourth, etc. For a numeric vector, these are interpreted @@ -687,7 +1301,6 @@ undirected_graph <- function(...) constructor_spec(make_undirected_graph, ...) #' A graph with no edges #' -#' @aliases graph.empty #' @concept Empty graph. #' @param n Number of vertices. #' @param directed Whether to create a directed graph. @@ -779,7 +1392,6 @@ empty_graph <- function(...) constructor_spec(make_empty_graph, ...) #' #' See more examples below. #' -#' @aliases graph.formula #' @param ... For `graph_from_literal()` the formulae giving the #' structure of the graph, see details below. For `from_literal()` #' all arguments are passed to `graph_from_literal()`. @@ -941,7 +1553,6 @@ from_literal <- function(...) { #' `star()` creates a star graph, in this every single vertex is #' connected to the center vertex and nobody else. #' -#' @aliases graph.star #' @concept Star graph #' @param n Number of vertices. #' @param mode It defines the direction of the @@ -993,7 +1604,6 @@ star <- function(...) constructor_spec(make_star, ...) #' Create a full graph #' -#' @aliases graph.full #' @concept Full graph #' @param n Number of vertices. #' @param directed Whether to create a directed graph. @@ -1033,7 +1643,6 @@ full_graph <- function(...) constructor_spec(make_full_graph, ...) #' `length` and `dim`. In the second form you omit #' `dimvector` and supply `length` and `dim`. #' -#' @aliases graph.lattice #' @concept Lattice #' @param dimvector A vector giving the size of the lattice in each #' dimension. @@ -1094,7 +1703,6 @@ lattice <- function(...) constructor_spec(make_lattice, ...) #' A ring is a one-dimensional lattice and this function is a special case #' of [make_lattice()]. #' -#' @aliases graph.ring #' @param n Number of vertices. #' @param directed Whether the graph is directed. #' @param mutual Whether directed edges are mutual. It is ignored in @@ -1135,7 +1743,6 @@ ring <- function(...) constructor_spec(make_ring, ...) #' Create a k-ary tree graph, where almost all vertices other than the leaves #' have the same number of children. #' -#' @aliases graph.tree #' @concept Trees. #' @param n Number of vertices. #' @param children Integer scalar, the number of children of a vertex @@ -1257,7 +1864,6 @@ from_prufer <- function(...) constructor_spec(make_from_prufer, ...) #' automorphisms. #' } #' -#' @aliases graph.atlas #' @concept Graph Atlas. #' @param n The id of the graph to create. #' @return An igraph graph. @@ -1299,7 +1905,6 @@ atlas <- function(...) constructor_spec(graph_from_atlas, ...) #' of total nodes. See also Kotsis, G: Interconnection Topologies for #' Parallel Processing Systems, PARS Mitteilungen 11, 1-6, 1993. #' -#' @aliases graph.extended.chordal.ring #' @param n The number of vertices. #' @param w A matrix which specifies the extended chordal ring. See #' details below. @@ -1348,7 +1953,6 @@ chordal_ring <- function(...) constructor_spec(make_chordal_ring, ...) #' the first vertex's corresponding edge is the same as the source of the #' second vertex's corresponding edge. #' -#' @aliases line.graph #' @param graph The input graph, it can be directed or undirected. #' @return A new graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com}, the first version of @@ -1399,7 +2003,6 @@ line_graph <- function(...) constructor_spec(make_line_graph, ...) #' De Bruijn graphs have some interesting properties, please see another #' source, e.g. Wikipedia for details. #' -#' @aliases graph.de.bruijn #' @param m Integer scalar, the size of the alphabet. See details below. #' @param n Integer scalar, the length of the labels. See details below. #' @return A graph object. @@ -1445,7 +2048,6 @@ de_bruijn_graph <- function(...) constructor_spec(make_de_bruijn_graph, ...) #' Kautz graphs have some interesting properties, see e.g. Wikipedia for #' details. #' -#' @aliases graph.kautz #' @param m Integer scalar, the size of the alphabet. See details below. #' @param n Integer scalar, the length of the labels. See details below. #' @return A graph object. @@ -1486,7 +2088,6 @@ kautz_graph <- function(...) constructor_spec(make_kautz_graph, ...) #' this is boolean and `FALSE` for the vertices of the first kind and #' `TRUE` for vertices of the second kind. #' -#' @aliases graph.full.bipartite #' @param n1 The number of vertices of the first kind. #' @param n2 The number of vertices of the second kind. #' @param directed Logical scalar, whether the graphs is directed. @@ -1553,7 +2154,6 @@ full_bipartite_graph <- function(...) constructor_spec(make_full_bipartite_graph #' vertex names; in this case, `types` must be a named vector that specifies #' the type for each vertex name that occurs in `edges`. #' -#' @aliases graph.bipartite #' @param types A vector giving the vertex types. It will be coerced into #' boolean. The length of the vector gives the number of vertices in the graph. #' When the vector is a named vector, the names will be attached to the graph @@ -1620,7 +2220,6 @@ bipartite_graph <- function(...) constructor_spec(make_bipartite_graph, ...) #' directed graph, where every `i->j` edge is present if and only if #' \eqn{j Date: Tue, 4 Jun 2024 15:11:26 +0200 Subject: [PATCH 2/3] refactor: remove the deprecated() function --- NAMESPACE | 1 - R/aaa-a-deprecate.R | 29 ----------------------------- 2 files changed, 30 deletions(-) delete mode 100644 R/aaa-a-deprecate.R diff --git a/NAMESPACE b/NAMESPACE index faf16778c99..22f8159eafc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -941,7 +941,6 @@ importFrom(utils,capture.output) importFrom(utils,edit) importFrom(utils,head) importFrom(utils,packageDescription) -importFrom(utils,packageName) importFrom(utils,read.table) importFrom(utils,setTxtProgressBar) importFrom(utils,tail) diff --git a/R/aaa-a-deprecate.R b/R/aaa-a-deprecate.R deleted file mode 100644 index 89a2285bce0..00000000000 --- a/R/aaa-a-deprecate.R +++ /dev/null @@ -1,29 +0,0 @@ - -# IGraph R package -# Copyright (C) 2014 Gabor Csardi -# 334 Harvard street, Cambridge, MA 02139 USA -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 USA -# -################################################################### - -## For the future, right now, we do not warn or even message - -#' @importFrom utils packageName -deprecated <- function(old, new) { # nocov start - assign(old, new, envir = asNamespace(packageName())) -} # nocov end - From d8eb028d648d8c350704a97cb037384749055bab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Tue, 4 Jun 2024 15:11:59 +0200 Subject: [PATCH 3/3] refactor: add script used for refactoring deprecation in make.R --- tools/deprecate-make-template.txt | 14 ++ tools/deprecate-make.R | 280 ++++++++++++++++++++++++++++++ 2 files changed, 294 insertions(+) create mode 100644 tools/deprecate-make-template.txt create mode 100644 tools/deprecate-make.R diff --git a/tools/deprecate-make-template.txt b/tools/deprecate-make-template.txt new file mode 100644 index 00000000000..6ee91a26e94 --- /dev/null +++ b/tools/deprecate-make-template.txt @@ -0,0 +1,14 @@ +#' {{new_title}} +#' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' `{{old}}()` was renamed to `{{new}}()` to create a more +#' consistent API. +{{inheritParamsOrNot}} +#' @keywords internal +#' @export +{{old}} <- function({{{new_usage}}}) { # nocov start + lifecycle::deprecate_soft("2.0.4", "{{old}}()", "{{new}}()") + {{{inline}}} +} # nocov end diff --git a/tools/deprecate-make.R b/tools/deprecate-make.R new file mode 100644 index 00000000000..b55463b22ab --- /dev/null +++ b/tools/deprecate-make.R @@ -0,0 +1,280 @@ +# parse script ---- +zzz_script <- file.path("R", "make.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) + +# utils ---- + +.parse_impl_assignements <- function() { + scripts <- fs::dir_ls(here::here("R")) |> + purrr::keep(~(.x != zzz_script)) |> + purrr::map(parse_script) + + parse_script_function_call <- function(xml) { + kiddos <- xml2::xml_children(xml) + candidates <- kiddos[xml2::xml_name(kiddos) == "expr"] + candidates <- candidates[purrr::map_int(candidates, ~length(xml2::xml_children(.x))) == 3] + + purrr::map_df( + candidates, + ~ tibble::tibble( + left = xml2::xml_children(.x)[[1]] |> xml2::xml_text(), + right = xml2::xml_children(.x)[[3]] |> xml2::xml_text() + ) + ) + } + + purrr::map_df(scripts, parse_script_function_call) +} +parse_impl_assignements <- memoise::memoise(.parse_impl_assignements) + +parse_package_defs <- function() { + scripts <- fs::dir_ls(here::here("R")) |> + purrr::keep(~(.x != zzz_script)) |> + purrr::map(parse_script) + + parse_script_function_call <- function(script, script_name) { + fns <- xml2::xml_find_all(script, ".//FUNCTION[text()='function']") + is_fn_definition <- function(fn) { + siblings <- fn |> xml2::xml_parent() |> xml2::xml_siblings() + (length(siblings) == 2) && (xml2::xml_name(siblings[[2]]) == "LEFT_ASSIGN") + } + fns <- purrr::keep(fns, is_fn_definition) + + parse_function <- function(fn, script_name) { + whole_definition <- fn |> xml2::xml_parent()|> xml2::xml_parent() + line1 <- xml2::xml_attr(whole_definition, "line1") + line2 <- xml2::xml_attr(whole_definition, "line2") + name <- whole_definition |> xml2::xml_child() |> xml2::xml_text() + body <- xml2::xml_children(whole_definition)[[3]] |> + xml2::xml_children() + body <- body[length(body)] + + inline <- brio::read_lines(script_name)[(xml2::xml_attr(body, "line1")):xml2::xml_attr(body, "line2")] + inline <- inline[2:(length(inline)-1)] + inline <- paste(inline, collapse = "\n") + + args <- xml2::xml_find_all(whole_definition, "./*/SYMBOL_FORMALS") |> xml2::xml_text() + args <- xml2::xml_find_all(whole_definition, "./*/SYMBOL_FORMALS") |> xml2::xml_text() + if (length(args) > 0) { + if ("..." %in% args) { + if (length(args) == 1) { + args <- "..." + } else { + args <- toString(c(glue::glue("{args[args!='...']} = {args[args!='...']}"), "...")) + } + } else { + args <- toString(glue::glue("{args} = {args}")) + } + + usage_wrap <- xml2::xml_children(whole_definition)[[3]] |> xml2::xml_children() + # TODO use XPath not numbers? although this should work? + usage <- usage_wrap[3:(length(usage_wrap)-2)] |> xml2::xml_text() |> paste(collapse = " ") + } else { + args <- "" + usage <- "" + } + + + tibble::tibble( + line1 = line1, + line2 = line2, + name = name, + inline = inline, + args = args, + usage = usage + ) + } + script_df <- purrr::map_df(fns, parse_function, script_name = script_name) + script_df$script_name <- script_name + script_df + } + + purrr::map2_df(scripts, names(scripts), parse_script_function_call) +} +# +clean_alias <- function(aliases, x) { + output <- gsub(sprintf(" %s ", x), " ", aliases) + output <- gsub(sprintf(" %s$", x), "", output) + + output[!grepl("@aliases", output)] <- sub( + "#' ", "#' @aliases ", + output[!grepl("@aliases", output)] + ) + + output +} + + +remove_aliases <- function(script, to_be_deprecated) { + lines <- brio::read_lines(script) + + which_aliases <- grepl("@aliases", lines) | + (grepl("@aliases", dplyr::lag(lines, 1)) & + grepl("^#' (?!\\@)", lines, perl = TRUE)) + aliases_present <- (sum(which_aliases) > 0) + + if (aliases_present) { + + aliases <- lines[which_aliases] + aliases <- purrr::reduce( + to_be_deprecated, + \(aliases, x) clean_alias(aliases, x ), + .init = aliases + ) + lines[which_aliases] <- aliases + lines <- purrr::discard( + lines, + \(x) trimws(x) == "#' @aliases" + ) + } + + brio::write_lines(lines, script) +} + +purrr::walk( + list("R/make.R"), + remove_aliases, + to_be_deprecated = deprecated_df$old, + .progress = TRUE +) + +# parse ALL the package scripts ---- + + +# get docs from pkgdown ---- +get_title <- function(fn_name) { + + if (fn_name == "adjacent_triangles") { + fn_name <- "count_triangles" + } + + rd_href <- pkgdown:::get_rd_from_help("igraph", fn_name) + pkgdown:::extract_title(rd_href) +} +topics <- pkgdown::as_pkgdown()[["topics"]] + +# treat calls ---- +treat_call <- function(old, new, topics) { + if (old %in% c("igraph.eigen.default", "igraph.arpack.default")) { + return() + } + + pkg_defs <- parse_package_defs() + template <- paste(readLines(here::here("tools", "deprecate-make-template.txt")), collapse = "\n") + + relevant_row <- pkg_defs[pkg_defs[["name"]] == new,] + + if (nrow(relevant_row) == 0) { + relevant_row <- pkg_defs[pkg_defs[["name"]] == sprintf("%s_impl", new),] + } + + if (nrow(relevant_row) == 0) { + assignments <- parse_impl_assignements() + actual_def <- assignments[["right"]][assignments[["left"]] == new] + relevant_row <- pkg_defs[pkg_defs[["name"]] == actual_def,] + } + + if (nrow(relevant_row) > 1) { + relevant_row <- relevant_row[!grepl("aaa-auto", relevant_row[["script_name"]]),] + } + + if (grepl("_impl$", new)) { + new <- sub("_impl$", "", new) + } + + if (!nzchar(relevant_row[["args"]])) { + inheritParamsOrNot <- "#'" + } else { + inheritParamsOrNot <- sprintf("#' @inheritParams %s", new) + } + + new_text <- whisker::whisker.render( + template, + data = list( + old = old, + new = new, + inline = relevant_row[["inline"]], + inheritParamsOrNot = inheritParamsOrNot, + new_usage = relevant_row[["usage"]], + new_title = stringr::str_squish(get_title(new)) + ) + ) + + script <- system2( + "grep", + c("-r", sprintf("'^%s <- '", new), "R"), + stdout = TRUE + ) + script <- script[!endsWith(script, new)] + script <- sub("\\:.*", "", script) + script_lines <- brio::read_lines(script) + new_lines <- append( + c("", new_text), + values = script_lines + ) + brio::write_lines(new_lines, script) +} +purrr::walk2( + deprecated_df[["old"]], + deprecated_df[["new"]], + treat_call, + topics = topics, + .progress = TRUE +) + +# delete deprecated() calls ---- +remove_deprecated_calls <- function(script) { + lines <- brio::read_lines(script) + deprecated <- which(startsWith(lines, "deprecated(")) + if (length(deprecated) == 0) { + return() + } + + lines <- lines[1:(min(deprecated) - 2)] + brio::write_lines(lines, script) +} +purrr::walk(fs::dir_ls(here::here("R")), remove_deprecated_calls) + +devtools::document() +devtools::check() + + +gert::git_add("R/make.R") +gert::git_add("man*") +gert::git_commit("refactor!: change make.R") + +fs::file_delete("R/aaa-a-deprecate.R") +gert::git_add("R/aaa-a-deprecate.R") +devtools::document() +devtools::check() +gert::git_add("NAMESPACE") +gert::git_commit("refactor: remove the deprecated() function") + +gert::git_add("tools*") +gert::git_commit("refactor: add script used for refactoring deprecation in make.R")