From 3087e6d1f763ead585e8deea45bd1c494db9472a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Tue, 10 Jun 2025 15:23:35 +0200 Subject: [PATCH 1/3] feat!: change arguments default and order for `graph_from_lcf()` --- R/make.R | 149 ++++++++++++---- man/graph.lcf.Rd | 3 +- man/graph_from_lcf.Rd | 9 +- tests/testthat/test-make.R | 356 ++++++++++++++++++++++++++++--------- 4 files changed, 398 insertions(+), 119 deletions(-) diff --git a/R/make.R b/R/make.R index 90bac175b13..a75061baffc 100644 --- a/R/make.R +++ b/R/make.R @@ -20,8 +20,9 @@ graph <- function( # nocov start lifecycle::deprecate_soft("2.1.0", "graph()", "make_graph()") if (inherits(edges, "formula")) { - if (!missing(n)) + if (!missing(n)) { cli::cli_abort("{.arg n} should not be given for graph literals") + } if (!missing(isolates)) { cli::cli_abort("{.arg isolates} should not be given for graph literals") } @@ -41,11 +42,14 @@ graph <- function( cli::cli_abort("Only give one of {.arg dir} and {.arg directed}") } - if (!missing(dir) && missing(directed)) directed <- dir + if (!missing(dir) && missing(directed)) { + directed <- dir + } if (is.character(edges) && length(edges) == 1) { - if (!missing(n)) + if (!missing(n)) { cli::cli_warn("{.arg n} is ignored for the {.str {edges}} graph.") + } if (!missing(isolates)) { cli::cli_warn( "{.arg isolates} is ignored for the {.str {edges}} graph." @@ -59,7 +63,9 @@ graph <- function( if (!missing(dir)) { cli::cli_warn("{.arg dir} is ignored for the {.str {edges}} graph") } - if (length(list(...))) cli::cli_abort("Extra arguments in make_graph") + if (length(list(...))) { + cli::cli_abort("Extra arguments in make_graph") + } make_famous_graph(edges) @@ -69,7 +75,9 @@ graph <- function( is.null(edges) || (is.logical(edges) && length(edges) == 0) ) { - if (is.null(edges) || is.logical(edges)) edges <- as.numeric(edges) + if (is.null(edges) || is.logical(edges)) { + edges <- as.numeric(edges) + } if (!is.null(isolates)) { cli::cli_warn("{.arg isolates} ignored for numeric edge list.") } @@ -88,15 +96,21 @@ graph <- function( } args <- list(edges, ...) - if (!missing(n)) args <- c(args, list(n = n)) - if (!missing(directed)) args <- c(args, list(directed = directed)) + 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)) { cli::cli_warn("{.arg n} is ignored for edge list with vertex names.") } - if (length(list(...))) cli::cli_abort("Extra arguments in make_graph") + if (length(list(...))) { + cli::cli_abort("Extra arguments in make_graph") + } el <- matrix(edges, ncol = 2, byrow = TRUE) res <- graph_from_edgelist(el, directed = directed) @@ -133,8 +147,9 @@ graph.famous <- function( # nocov start lifecycle::deprecate_soft("2.1.0", "graph.famous()", "make_graph()") if (inherits(edges, "formula")) { - if (!missing(n)) + if (!missing(n)) { cli::cli_abort("{.arg n} should not be given for graph literals") + } if (!missing(isolates)) { cli::cli_abort("{.arg isolates} should not be given for graph literals") } @@ -154,11 +169,14 @@ graph.famous <- function( cli::cli_abort("Only give one of {.arg dir} and {.arg directed}") } - if (!missing(dir) && missing(directed)) directed <- dir + if (!missing(dir) && missing(directed)) { + directed <- dir + } if (is.character(edges) && length(edges) == 1) { - if (!missing(n)) + if (!missing(n)) { cli::cli_warn("{.arg n} is ignored for the {.str {edges}} graph.") + } if (!missing(isolates)) { cli::cli_warn( "{.arg isolates} is ignored for the {.str {edges}} graph." @@ -172,7 +190,9 @@ graph.famous <- function( if (!missing(dir)) { cli::cli_warn("{.arg dir} is ignored for the {.str {edges}} graph.") } - if (length(list(...))) cli::cli_abort("Extra arguments in make_graph") + if (length(list(...))) { + cli::cli_abort("Extra arguments in make_graph") + } make_famous_graph(edges) @@ -182,7 +202,9 @@ graph.famous <- function( is.null(edges) || (is.logical(edges) && length(edges) == 0) ) { - if (is.null(edges) || is.logical(edges)) edges <- as.numeric(edges) + if (is.null(edges) || is.logical(edges)) { + edges <- as.numeric(edges) + } if (!is.null(isolates)) { cli::cli_warn("{.arg isolates} ignored for numeric edge list.") } @@ -201,15 +223,21 @@ graph.famous <- function( } args <- list(edges, ...) - if (!missing(n)) args <- c(args, list(n = n)) - if (!missing(directed)) args <- c(args, list(directed = directed)) + 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)) { cli::cli_warn("{.arg n} is ignored for edge list with vertex names.") } - if (length(list(...))) cli::cli_abort("Extra arguments in make_graph") + if (length(list(...))) { + cli::cli_abort("Extra arguments in make_graph") + } el <- matrix(edges, ncol = 2, byrow = TRUE) res <- graph_from_edgelist(el, directed = directed) @@ -830,9 +858,15 @@ graph.atlas <- function(n) { ga <- graph_attr_names(graph) va <- vertex_attr_names(graph) ea <- edge_attr_names(graph) - for (g in ga) graph <- delete_graph_attr(graph, g) - for (v in va) graph <- delete_vertex_attr(graph, v) - for (e in ea) graph <- delete_edge_attr(graph, e) + for (g in ga) { + graph <- delete_graph_attr(graph, g) + } + for (v in va) { + graph <- delete_vertex_attr(graph, v) + } + for (e in ea) { + graph <- delete_edge_attr(graph, e) + } } else if (m$id == "without_loops") { graph <- simplify(graph, remove.loops = TRUE, remove.multiple = FALSE) } else if (m$id == "without_multiples") { @@ -1404,8 +1438,9 @@ make_graph <- function( simplify = TRUE ) { if (inherits(edges, "formula")) { - if (!missing(n)) + if (!missing(n)) { cli::cli_abort("{.arg n} should not be given for graph literals") + } if (!missing(isolates)) { cli::cli_abort("{.arg isolates} should not be given for graph literals") } @@ -1425,11 +1460,14 @@ make_graph <- function( cli::cli_abort("Only give one of {.arg dir} and {.arg directed}") } - if (!missing(dir) && missing(directed)) directed <- dir + if (!missing(dir) && missing(directed)) { + directed <- dir + } if (is.character(edges) && length(edges) == 1) { - if (!missing(n)) + if (!missing(n)) { cli::cli_warn("{.arg n} is ignored for the {.str {edges}} graph.") + } if (!missing(isolates)) { cli::cli_warn( "{.arg isolates} is ignored for the {.str {edges}} graph." @@ -1443,7 +1481,9 @@ make_graph <- function( if (!missing(dir)) { cli::cli_warn("{.arg dir} is ignored for the {.str {edges}} graph.") } - if (length(list(...))) cli::cli_abort("Extra arguments in make_graph") + if (length(list(...))) { + cli::cli_abort("Extra arguments in make_graph") + } make_famous_graph(edges) @@ -1453,7 +1493,9 @@ make_graph <- function( is.null(edges) || (is.logical(edges) && length(edges) == 0) ) { - if (is.null(edges) || is.logical(edges)) edges <- as.numeric(edges) + if (is.null(edges) || is.logical(edges)) { + edges <- as.numeric(edges) + } if (!is.null(isolates)) { cli::cli_warn("{.arg isolates} ignored for numeric edge list.") } @@ -1472,15 +1514,21 @@ make_graph <- function( } args <- list(edges, ...) - if (!missing(n)) args <- c(args, list(n = n)) - if (!missing(directed)) args <- c(args, list(directed = directed)) + 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)) { cli::cli_warn("{.arg n} is ignored for edge list with vertex names.") } - if (length(list(...))) cli::cli_abort("Extra arguments in make_graph") + if (length(list(...))) { + cli::cli_abort("Extra arguments in make_graph") + } el <- matrix(edges, ncol = 2, byrow = TRUE) res <- graph_from_edgelist(el, directed = directed) @@ -1783,7 +1831,9 @@ graph_from_literal_i <- function(mf) { ids <- seq(along.with = v) names(ids) <- v res <- make_graph(unname(ids[edges]), n = length(v), directed = directed) - if (simplify) res <- simplify(res) + if (simplify) { + res <- simplify(res) + } res <- set_vertex_attr(res, "name", value = v) res } @@ -2078,8 +2128,9 @@ sample_tree <- tree_game_impl #' @rdname make_tree #' @param ... Passed to `make_tree()` or `sample_tree()`. #' @export -tree <- function(...) +tree <- function(...) { constructor_spec(list(make = make_tree, sample = sample_tree), ...) +} ## ----------------------------------------------------------------- @@ -2410,8 +2461,9 @@ make_full_bipartite_graph <- function( #' @rdname make_full_bipartite_graph #' @param ... Passed to `make_full_bipartite_graph()`. #' @export -full_bipartite_graph <- function(...) +full_bipartite_graph <- function(...) { constructor_spec(make_full_bipartite_graph, ...) +} ## ----------------------------------------------------------------- @@ -2525,8 +2577,9 @@ make_full_citation_graph <- function(n, directed = TRUE) { #' @rdname make_full_citation_graph #' @param ... Passed to `make_full_citation_graph()`. #' @export -full_citation_graph <- function(...) +full_citation_graph <- function(...) { constructor_spec(make_full_citation_graph, ...) +} ## ----------------------------------------------------------------- @@ -2541,7 +2594,8 @@ full_citation_graph <- function(...) #' #' #' @aliases graph_from_lcf -#' @param n Integer, the number of vertices in the graph. +#' @param n Integer, the number of vertices in the graph. If `NULL` (default), +#' it is set to `len(shifts) * repeats`. #' @param shifts Integer vector, the shifts. #' @param repeats Integer constant, how many times to repeat the shifts. #' @return A graph object. @@ -2552,13 +2606,40 @@ full_citation_graph <- function(...) #' @examples #' #' # This is the Franklin graph: -#' g1 <- graph_from_lcf(12, c(5, -5), 6) +#' g1 <- graph_from_lcf(shifts = c(5L, -5L), n = 12L, repeats = 6L) #' g2 <- make_graph("Franklin") #' isomorphic(g1, g2) #' @export #' @cdocs igraph_lcf_vector -graph_from_lcf <- lcf_vector_impl +graph_from_lcf <- function( + shifts, + ..., + n = NULL, + repeats = 1L +) { + if (!rlang::is_integer(shifts)) { + cli::cli_abort( + "{.arg shift} must be an integer vector, not {.obj_type_friendly {shifts}}." + ) + } + + check_dots_empty() + + n <- n %||% (len(shifts) * repeats) + if (!rlang::is_integer(n, n = 1)) { + cli::cli_abort( + "{.arg n} must be an integer of length 1, not {.obj_type_friendly {n}}." + ) + } + if (!rlang::is_integer(repeats, n = 1)) { + cli::cli_abort( + "{.arg repeats} must be an integer of length 1, not {.obj_type_friendly {repeats}}." + ) + } + + lcf_vector_impl(n = n, shifts = shifts, repeats = repeats) +} ## ----------------------------------------------------------------- #' Creating a graph from a given degree sequence, deterministically diff --git a/man/graph.lcf.Rd b/man/graph.lcf.Rd index 2ba86e80bc3..fab95a327f9 100644 --- a/man/graph.lcf.Rd +++ b/man/graph.lcf.Rd @@ -7,7 +7,8 @@ graph.lcf(n, shifts, repeats = 1) } \arguments{ -\item{n}{Integer, the number of vertices in the graph.} +\item{n}{Integer, the number of vertices in the graph. If \code{NULL} (default), +it is set to \code{len(shifts) * repeats}.} \item{shifts}{Integer vector, the shifts.} diff --git a/man/graph_from_lcf.Rd b/man/graph_from_lcf.Rd index 2ae9978e599..d0230b68bf4 100644 --- a/man/graph_from_lcf.Rd +++ b/man/graph_from_lcf.Rd @@ -4,13 +4,14 @@ \alias{graph_from_lcf} \title{Creating a graph from LCF notation} \usage{ -graph_from_lcf(n, shifts, repeats = 1) +graph_from_lcf(shifts, ..., n = NULL, repeats = 1L) } \arguments{ -\item{n}{Integer, the number of vertices in the graph.} - \item{shifts}{Integer vector, the shifts.} +\item{n}{Integer, the number of vertices in the graph. If \code{NULL} (default), +it is set to \code{len(shifts) * repeats}.} + \item{repeats}{Integer constant, how many times to repeat the shifts.} } \value{ @@ -27,7 +28,7 @@ details. \examples{ # This is the Franklin graph: -g1 <- graph_from_lcf(12, c(5, -5), 6) +g1 <- graph_from_lcf(shifts = c(5L, -5L), n = 12L, repeats = 6L) g2 <- make_graph("Franklin") isomorphic(g1, g2) } diff --git a/tests/testthat/test-make.R b/tests/testthat/test-make.R index 40ab46057ab..dc57733cf13 100644 --- a/tests/testthat/test-make.R +++ b/tests/testthat/test-make.R @@ -61,8 +61,8 @@ test_that("error messages are proper", { 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)) + g0 <- graph_from_literal(A - +B:C) + g1 <- graph_(from_literal(A - +B:C)) expect_identical_graphs(g0, g1) }) @@ -86,18 +86,18 @@ test_that("graph_from_literal() and undirected explosion", { test_that("graph_from_literal() and simple directed graphs", { local_igraph_options(print.id = FALSE) expect_snapshot({ - graph_from_literal(A -+ B) - graph_from_literal(A -+ B -+ C) - graph_from_literal(A -+ B -+ C -+ A) - graph_from_literal(A -+ B +- C -+ A) + graph_from_literal(A - +B) + graph_from_literal(A - +B - +C) + graph_from_literal(A - +B - +C - +A) + graph_from_literal(A - +B + -C - +A) }) }) test_that("graph_from_literal() and directed explosion", { local_igraph_options(print.id = FALSE) expect_snapshot({ - graph_from_literal(A:B:C -+ D:E, B:D +- C:E) - graph_from_literal(A:B:C -+ D:E +- F:G:H -+ I +- J:K:L:M) + graph_from_literal(A:B:C - +D:E, B:D + -C:E) + graph_from_literal(A:B:C - +D:E + -F:G:H - +I + -J:K:L:M) }) }) @@ -147,50 +147,90 @@ test_that("make_full_graph works", { test_that("make_lattice works", { lattice_make <- make_lattice(dim = 2, length = 3, periodic = FALSE) - lattice_elist <- make_empty_graph(n = 9) + edges(c( - 1, 2, - 1, 4, - 2, 3, - 2, 5, - 3, 6, - 4, 5, - 4, 7, - 5, 6, - 5, 8, - 6, 9, - 7, 8, - 8, 9 - )) + lattice_elist <- make_empty_graph(n = 9) + + edges(c( + 1, + 2, + 1, + 4, + 2, + 3, + 2, + 5, + 3, + 6, + 4, + 5, + 4, + 7, + 5, + 6, + 5, + 8, + 6, + 9, + 7, + 8, + 8, + 9 + )) expect_equal(as_edgelist(lattice_make), as_edgelist(lattice_elist)) lattice_make_periodic <- make_lattice(dim = 2, length = 3, periodic = TRUE) - lattice_elist_periodic <- make_empty_graph(n = 9) + edges(c( - 1, 2, - 1, 4, - 2, 3, - 2, 5, - 1, 3, - 3, 6, - 4, 5, - 4, 7, - 5, 6, - 5, 8, - 4, 6, - 6, 9, - 7, 8, - 1, 7, - 8, 9, - 2, 8, - 7, 9, - 3, 9 - )) - expect_equal(as_edgelist(lattice_make_periodic), as_edgelist(lattice_elist_periodic)) + lattice_elist_periodic <- make_empty_graph(n = 9) + + edges(c( + 1, + 2, + 1, + 4, + 2, + 3, + 2, + 5, + 1, + 3, + 3, + 6, + 4, + 5, + 4, + 7, + 5, + 6, + 5, + 8, + 4, + 6, + 6, + 9, + 7, + 8, + 1, + 7, + 8, + 9, + 2, + 8, + 7, + 9, + 3, + 9 + )) + expect_equal( + as_edgelist(lattice_make_periodic), + as_edgelist(lattice_elist_periodic) + ) }) test_that("make_lattice prints a warning for fractional length)", { - expect_warning(make_lattice(dim = 2, length = sqrt(2000)), "`length` was rounded") + expect_warning( + make_lattice(dim = 2, length = sqrt(2000)), + "`length` was rounded" + ) - suppressWarnings(lattice_rounded <- make_lattice(dim = 2, length = sqrt(2000))) + suppressWarnings( + lattice_rounded <- make_lattice(dim = 2, length = sqrt(2000)) + ) lattice_integer <- make_lattice(dim = 2, length = 45) expect_identical_graphs(lattice_rounded, lattice_integer) }) @@ -221,19 +261,29 @@ test_that("make_graph works for numeric edges and isolates", { 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]) + graph_elist_names <- make_empty_graph() + + vertices(letters[1:10]) + + edges(letters[1:10]) 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]) + graph_elist_iso <- make_empty_graph() + + vertices(letters[1:20]) + + edges(letters[1:10]) expect_identical_graphs(graph_make_iso, graph_elist_iso) }) test_that("make_graph gives warning for ignored arguments", { - expect_warning(make_graph(letters[1:10], n = 10), "ignored for edge list with vertex names") - expect_warning(make_graph(1:10, isolates = 11:12), "ignored for numeric edge list") + expect_warning( + make_graph(letters[1:10], n = 10), + "ignored for edge list with vertex names" + ) + expect_warning( + make_graph(1:10, isolates = 11:12), + "ignored for numeric edge list" + ) }) test_that("compatibility when arguments are not named", { @@ -254,14 +304,15 @@ test_that("make_empty_graph gives an error for invalid arguments", { test_that("make_graph_atlas works", { atlas_124 <- graph_from_atlas(124) - expect_isomorphic(atlas_124, make_graph(c(1, 2, 2, 3, 3, 4, 4, 5, 1, 5, 1, 3, 2, 6), - directed = FALSE - )) + expect_isomorphic( + atlas_124, + make_graph(c(1, 2, 2, 3, 3, 4, 4, 5, 1, 5, 1, 3, 2, 6), directed = FALSE) + ) atlas_234 <- graph_from_atlas(234) - expect_isomorphic(atlas_234, make_graph(c(1, 6, 2, 6, 3, 6, 4, 6, 5, 6), - n = 7, - directed = FALSE - )) + expect_isomorphic( + atlas_234, + make_graph(c(1, 6, 2, 6, 3, 6, 4, 6, 5, 6), n = 7, directed = FALSE) + ) }) test_that("make_chordal_ring works", { @@ -283,15 +334,35 @@ test_that("make_de_bruijn_graph works", { de_bruijn22 <- make_de_bruijn_graph(2, 2) de_bruijn21_line <- make_line_graph(de_bruijn21) - expect_isomorphic(de_bruijn21_line, make_graph(c( - 1, 1, 3, 1, 1, 2, 3, 2, 2, 3, - 4, 3, 2, 4, 4, 4 - ))) + expect_isomorphic( + de_bruijn21_line, + make_graph(c( + 1, + 1, + 3, + 1, + 1, + 2, + 3, + 2, + 2, + 3, + 4, + 3, + 2, + 4, + 4, + 4 + )) + ) expect_isomorphic(de_bruijn22, de_bruijn21_line) }) test_that("make_bipartite_graph works", { - inc_mat_rand <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) + inc_mat_rand <- matrix( + sample(0:1, 35, replace = TRUE, prob = c(3, 1)), + ncol = 5 + ) bip_from_inc <- graph_from_biadjacency_matrix(inc_mat_rand) edges <- unlist(sapply(seq_len(nrow(inc_mat_rand)), function(x) { @@ -302,7 +373,10 @@ test_that("make_bipartite_graph works", { numeric() } })) - bip_from_make <- make_bipartite_graph(seq_len(nrow(inc_mat_rand) + ncol(inc_mat_rand)) > nrow(inc_mat_rand), edges) + bip_from_make <- make_bipartite_graph( + seq_len(nrow(inc_mat_rand) + ncol(inc_mat_rand)) > nrow(inc_mat_rand), + edges + ) inc_mat_bip <- as_biadjacency_matrix(bip_from_make) expect_equal(inc_mat_bip, inc_mat_rand, ignore_attr = TRUE) @@ -311,13 +385,39 @@ test_that("make_bipartite_graph works", { test_that("make_bipartite_graph works with vertex names", { types <- c(0, 1, 0, 1, 0, 1) names(types) <- LETTERS[1:length(types)] - edges <- c("A", "B", "C", "D", "E", "F", "A", "D", "D", "E", "B", "C", "C", "F") + edges <- c( + "A", + "B", + "C", + "D", + "E", + "F", + "A", + "D", + "D", + "E", + "B", + "C", + "C", + "F" + ) bip_grap <- make_bipartite_graph(types, edges) - expect_equal(V(bip_grap)$name, c("A", "B", "C", "D", "E", "F"), ignore_attr = TRUE) - expect_equal(V(bip_grap)$type, c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE), ignore_attr = TRUE) + expect_equal( + V(bip_grap)$name, + c("A", "B", "C", "D", "E", "F"), + ignore_attr = TRUE + ) + expect_equal( + V(bip_grap)$type, + c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE), + ignore_attr = TRUE + ) - expect_error(make_bipartite_graph(types, c(edges, "Q")), "edge vector contains a vertex name that is not found") + expect_error( + make_bipartite_graph(types, c(edges, "Q")), + "edge vector contains a vertex name that is not found" + ) }) test_that("make_full_bipartite_graph works", { @@ -337,20 +437,110 @@ test_that("make_kautz_graph works", { el <- as_edgelist(kautz) el <- el[order(el[, 1], el[, 2]), ] - expect_equal(el, structure( - c( - 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, - 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, - 12, 13, 13, 14, 14, 15, 15, 16, 16, 17, - 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, - 22, 23, 23, 24, 24, 9, 10, 11, 12, 13, - 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, - 24, 1, 2, 3, 4, 5, 6, 7, 8, 17, 18, 19, - 20, 21, 22, 23, 24, 1, 2, 3, 4, 5, 6, 7, - 8, 9, 10, 11, 12, 13, 14, 15, 16 - ), - .Dim = c(48L, 2L) - )) + expect_equal( + el, + structure( + c( + 1, + 1, + 2, + 2, + 3, + 3, + 4, + 4, + 5, + 5, + 6, + 6, + 7, + 7, + 8, + 8, + 9, + 9, + 10, + 10, + 11, + 11, + 12, + 12, + 13, + 13, + 14, + 14, + 15, + 15, + 16, + 16, + 17, + 17, + 18, + 18, + 19, + 19, + 20, + 20, + 21, + 21, + 22, + 22, + 23, + 23, + 24, + 24, + 9, + 10, + 11, + 12, + 13, + 14, + 15, + 16, + 17, + 18, + 19, + 20, + 21, + 22, + 23, + 24, + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 17, + 18, + 19, + 20, + 21, + 22, + 23, + 24, + 1, + 2, + 3, + 4, + 5, + 6, + 7, + 8, + 9, + 10, + 11, + 12, + 13, + 14, + 15, + 16 + ), + .Dim = c(48L, 2L) + ) + ) }) test_that("make_graph for notable graphs is case insensitive", { @@ -404,3 +594,9 @@ test_that("graph is updated if in LHS", { E(g)[1:5]$weight <- 0 expect_equal(E(g)$weight, c(rep(0, 5), 6:10)) }) + +test_that("graph_from_lcf() works", { + g1 <- graph_from_lcf(shifts = c(5L, -5L), n = 12L, repeats = 6L) + g2 <- make_graph("Franklin") + expect_isomorphic(g1, g2) +}) From 3526333130f0a44bdb0d948947cd5388e55128fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Thu, 12 Jun 2025 14:01:58 +0200 Subject: [PATCH 2/3] fixes --- R/make.R | 3 ++- man/graph_from_lcf.Rd | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/make.R b/R/make.R index a75061baffc..d25460c751c 100644 --- a/R/make.R +++ b/R/make.R @@ -2598,6 +2598,7 @@ full_citation_graph <- function(...) { #' it is set to `len(shifts) * repeats`. #' @param shifts Integer vector, the shifts. #' @param repeats Integer constant, how many times to repeat the shifts. +#' @inheritParams rlang::args_dots_empty #' @return A graph object. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @seealso [make_graph()] can create arbitrary graphs, see also the other @@ -2625,7 +2626,7 @@ graph_from_lcf <- function( check_dots_empty() - n <- n %||% (len(shifts) * repeats) + n <- n %||% (length(shifts) * repeats) if (!rlang::is_integer(n, n = 1)) { cli::cli_abort( "{.arg n} must be an integer of length 1, not {.obj_type_friendly {n}}." diff --git a/man/graph_from_lcf.Rd b/man/graph_from_lcf.Rd index d0230b68bf4..99e11272b24 100644 --- a/man/graph_from_lcf.Rd +++ b/man/graph_from_lcf.Rd @@ -9,6 +9,8 @@ graph_from_lcf(shifts, ..., n = NULL, repeats = 1L) \arguments{ \item{shifts}{Integer vector, the shifts.} +\item{...}{These dots are for future extensions and must be empty.} + \item{n}{Integer, the number of vertices in the graph. If \code{NULL} (default), it is set to \code{len(shifts) * repeats}.} From e06b5bd7dcf2fc7bf895f50df462a4455653c046 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Tue, 24 Jun 2025 10:17:55 +0200 Subject: [PATCH 3/3] fix --- tests/testthat/test-make.R | 34 ++++++++-------------------------- 1 file changed, 8 insertions(+), 26 deletions(-) diff --git a/tests/testthat/test-make.R b/tests/testthat/test-make.R index 1d2e9aea17e..396bf65dc43 100644 --- a/tests/testthat/test-make.R +++ b/tests/testthat/test-make.R @@ -86,18 +86,18 @@ test_that("graph_from_literal() and undirected explosion", { test_that("graph_from_literal() and simple directed graphs", { local_igraph_options(print.id = FALSE) expect_snapshot({ - graph_from_literal(A - +B) - graph_from_literal(A - +B - +C) - graph_from_literal(A - +B - +C - +A) - graph_from_literal(A - +B + -C - +A) + graph_from_literal(A -+ B) + graph_from_literal(A -+ B -+ C) + graph_from_literal(A -+ B -+ C -+ A) + graph_from_literal(A -+ B +- C -+ A) }) }) test_that("graph_from_literal() and directed explosion", { local_igraph_options(print.id = FALSE) expect_snapshot({ - graph_from_literal(A:B:C - +D:E, B:D + -C:E) - graph_from_literal(A:B:C - +D:E + -F:G:H - +I + -J:K:L:M) + graph_from_literal(A:B:C -+ D:E, B:D +- C:E) + graph_from_literal(A:B:C -+ D:E +- F:G:H -+ I +- J:K:L:M) }) }) @@ -320,10 +320,7 @@ test_that("make_de_bruijn_graph works", { }) test_that("make_bipartite_graph works", { - inc_mat_rand <- matrix( - sample(0:1, 35, replace = TRUE, prob = c(3, 1)), - ncol = 5 - ) + inc_mat_rand <- matrix(sample(0:1, 35, replace = TRUE, prob = c(3, 1)), ncol = 5) bip_from_inc <- graph_from_biadjacency_matrix(inc_mat_rand) edges <- unlist(sapply(seq_len(nrow(inc_mat_rand)), function(x) { @@ -346,22 +343,7 @@ test_that("make_bipartite_graph works", { test_that("make_bipartite_graph works with vertex names", { types <- c(0, 1, 0, 1, 0, 1) names(types) <- LETTERS[1:length(types)] - edges <- c( - "A", - "B", - "C", - "D", - "E", - "F", - "A", - "D", - "D", - "E", - "B", - "C", - "C", - "F" - ) + edges <- c("A", "B", "C", "D", "E", "F", "A", "D", "D", "E", "B", "C", "C", "F") bip_grap <- make_bipartite_graph(types, edges) expect_equal(