From e3000a0f09cc2142a27b31de85bca228809e980e Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 26 Oct 2025 20:44:26 +0000 Subject: [PATCH 1/3] Initial plan From fe831d03f576a6708d6cdaf7db357e5eb51e6adf Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 26 Oct 2025 21:06:22 +0000 Subject: [PATCH 2/3] Fix return.vs.es option handling in multiple functions Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- R/basic.R | 20 ++++++++++++++++---- R/conversion.R | 13 ++++++++++--- R/topology.R | 32 +++++++++++++++++++++++++------- man/as_adj_list.Rd | 7 +++++-- man/head_of.Rd | 4 +++- man/isomorphisms.Rd | 6 ++++-- man/subgraph_isomorphisms.Rd | 6 ++++-- man/tail_of.Rd | 4 +++- 8 files changed, 70 insertions(+), 22 deletions(-) diff --git a/R/basic.R b/R/basic.R index 47b00f7e071..4f6c7e82fe2 100644 --- a/R/basic.R +++ b/R/basic.R @@ -77,13 +77,19 @@ get.edge <- function(graph, id) { #' #' @param graph The input graph. #' @param es The edges to query. -#' @return A vertex sequence with the head(s) of the edge(s). +#' @return A vertex sequence with the head(s) of the edge(s) if +#' the `return.vs.es` igraph option is true (the default), or a numeric +#' vector of vertex IDs otherwise. #' #' @family structural queries #' #' @export head_of <- function(graph, es) { - create_vs(graph, ends(graph, es, names = FALSE)[, 2]) + res <- ends(graph, es, names = FALSE)[, 2] + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res } #' Tails of the edge(s) in a graph @@ -94,11 +100,17 @@ head_of <- function(graph, es) { #' #' @param graph The input graph. #' @param es The edges to query. -#' @return A vertex sequence with the tail(s) of the edge(s). +#' @return A vertex sequence with the tail(s) of the edge(s) if +#' the `return.vs.es` igraph option is true (the default), or a numeric +#' vector of vertex IDs otherwise. #' #' @family structural queries #' #' @export tail_of <- function(graph, es) { - create_vs(graph, ends(graph, es, names = FALSE)[, 1]) + res <- ends(graph, es, names = FALSE)[, 1] + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res } diff --git a/R/conversion.R b/R/conversion.R index 4de5467dd4c..3237fe4902f 100644 --- a/R/conversion.R +++ b/R/conversion.R @@ -651,7 +651,9 @@ as_undirected <- function( #' #' `as_adj_edge_list()` returns a list of numeric vectors, which include the #' ids of adjacent edges (according to the `mode` argument) of all -#' vertices. +#' vertices. The return type depends on the `return.vs.es` option: if true +#' (default), a list of `igraph.es` is returned; if false, a list of numeric +#' vectors is returned. #' #' @param graph The input graph. #' @param mode Character scalar, it gives what kind of adjacent edges/vertices @@ -663,7 +665,8 @@ as_undirected <- function( #' is not allowed for directed graphs and will be replaced with `"once"`. #' @param multiple Logical scalar, set to `FALSE` to use only one representative #' of each set of parallel edges. -#' @return A list of `igraph.vs` or a list of numeric vectors depending on +#' @return A list of `igraph.vs` (for `as_adj_list()`) or `igraph.es` +#' (for `as_adj_edge_list()`), or a list of numeric vectors depending on #' the value of `igraph_opt("return.vs.es")`, see details for performance #' characteristics. #' @details If `igraph_opt("return.vs.es")` is true (default), the numeric @@ -730,7 +733,11 @@ as_adj_edge_list <- function( on.exit(.Call(R_igraph_finalizer)) res <- .Call(R_igraph_get_adjedgelist, graph, mode, loops) - res <- lapply(res, function(.x) E(graph)[.x + 1]) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, function(.x) E(graph)[.x + 1]) + } else { + res <- lapply(res, `+`, 1) + } if (is_named(graph)) { names(res) <- V(graph)$name } diff --git a/R/topology.R b/R/topology.R index 14bc4bd81f3..59b1f5b6f5b 100644 --- a/R/topology.R +++ b/R/topology.R @@ -192,7 +192,12 @@ graph.get.isomorphisms.vf2 <- function( edge.color2 ) - lapply(res, function(.x) V(graph2)[.x + 1]) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, function(.x) V(graph2)[.x + 1]) + } else { + res <- lapply(res, `+`, 1) + } + res } #' @export @@ -260,7 +265,12 @@ graph.get.subisomorphisms.vf2 <- function( edge.color2 ) - lapply(res, function(.x) V(graph1)[.x + 1]) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, function(.x) V(graph1)[.x + 1]) + } else { + res <- lapply(res, `+`, 1) + } + res } #' @export @@ -330,7 +340,11 @@ graph.subisomorphic.lad <- function( } } if (all.maps) { - res$maps <- lapply(res$maps, function(.x) V(target)[.x + 1]) + if (igraph_opt("return.vs.es")) { + res$maps <- lapply(res$maps, function(.x) V(target)[.x + 1]) + } else { + res$maps <- lapply(res$maps, `+`, 1) + } } res @@ -854,8 +868,10 @@ graph.count.subisomorphisms.vf2 <- function( #' @param method Currently only \sQuote{vf2} is supported, see #' [isomorphic()] for details about it and extra arguments. #' @param ... Extra arguments, passed to the various methods. -#' @return A list of vertex sequences, corresponding to all -#' mappings from the first graph to the second. +#' @return A list of vertex sequences (if the `return.vs.es` igraph option is +#' true, the default), or a list of numeric vectors of vertex IDs (if +#' `return.vs.es` is false), corresponding to all mappings from the first +#' graph to the second. #' #' @aliases graph.get.isomorphisms.vf2 #' @@ -920,8 +936,10 @@ isomorphisms <- function(graph1, graph2, method = "vf2", ...) { #' @param method The method to use. Possible values: \sQuote{auto}, #' \sQuote{lad}, \sQuote{vf2}. See their details below. #' @param ... Additional arguments, passed to the various methods. -#' @return A list of vertex sequences, corresponding to all -#' mappings from the first graph to the second. +#' @return A list of vertex sequences (if the `return.vs.es` igraph option is +#' true, the default), or a list of numeric vectors of vertex IDs (if +#' `return.vs.es` is false), corresponding to all mappings from the first +#' graph to the second. #' #' @aliases graph.get.subisomorphisms.vf2 #' diff --git a/man/as_adj_list.Rd b/man/as_adj_list.Rd index 24d17623734..d6531214421 100644 --- a/man/as_adj_list.Rd +++ b/man/as_adj_list.Rd @@ -34,7 +34,8 @@ is not allowed for directed graphs and will be replaced with \code{"once"}.} of each set of parallel edges.} } \value{ -A list of \code{igraph.vs} or a list of numeric vectors depending on +A list of \code{igraph.vs} (for \code{as_adj_list()}) or \code{igraph.es} +(for \code{as_adj_edge_list()}), or a list of numeric vectors depending on the value of \code{igraph_opt("return.vs.es")}, see details for performance characteristics. } @@ -49,7 +50,9 @@ vertices. \code{as_adj_edge_list()} returns a list of numeric vectors, which include the ids of adjacent edges (according to the \code{mode} argument) of all -vertices. +vertices. The return type depends on the \code{return.vs.es} option: if true +(default), a list of \code{igraph.es} is returned; if false, a list of numeric +vectors is returned. If \code{igraph_opt("return.vs.es")} is true (default), the numeric vectors of the adjacency lists are coerced to \code{igraph.vs}, this can be diff --git a/man/head_of.Rd b/man/head_of.Rd index adeda86f7f1..37475098a06 100644 --- a/man/head_of.Rd +++ b/man/head_of.Rd @@ -12,7 +12,9 @@ head_of(graph, es) \item{es}{The edges to query.} } \value{ -A vertex sequence with the head(s) of the edge(s). +A vertex sequence with the head(s) of the edge(s) if +the \code{return.vs.es} igraph option is true (the default), or a numeric +vector of vertex IDs otherwise. } \description{ For undirected graphs, head and tail is not defined. In this case diff --git a/man/isomorphisms.Rd b/man/isomorphisms.Rd index 95ffdf50edb..283e5486f83 100644 --- a/man/isomorphisms.Rd +++ b/man/isomorphisms.Rd @@ -18,8 +18,10 @@ isomorphisms(graph1, graph2, method = "vf2", ...) \item{...}{Extra arguments, passed to the various methods.} } \value{ -A list of vertex sequences, corresponding to all -mappings from the first graph to the second. +A list of vertex sequences (if the \code{return.vs.es} igraph option is +true, the default), or a list of numeric vectors of vertex IDs (if +\code{return.vs.es} is false), corresponding to all mappings from the first +graph to the second. } \description{ Calculate all isomorphic mappings between the vertices of two graphs diff --git a/man/subgraph_isomorphisms.Rd b/man/subgraph_isomorphisms.Rd index 67f38b14d21..71d801de66b 100644 --- a/man/subgraph_isomorphisms.Rd +++ b/man/subgraph_isomorphisms.Rd @@ -22,8 +22,10 @@ mutual edges.} \item{...}{Additional arguments, passed to the various methods.} } \value{ -A list of vertex sequences, corresponding to all -mappings from the first graph to the second. +A list of vertex sequences (if the \code{return.vs.es} igraph option is +true, the default), or a list of numeric vectors of vertex IDs (if +\code{return.vs.es} is false), corresponding to all mappings from the first +graph to the second. } \description{ All isomorphic mappings between a graph and subgraphs of another graph diff --git a/man/tail_of.Rd b/man/tail_of.Rd index b2f2df6d993..4a937eb90de 100644 --- a/man/tail_of.Rd +++ b/man/tail_of.Rd @@ -12,7 +12,9 @@ tail_of(graph, es) \item{es}{The edges to query.} } \value{ -A vertex sequence with the tail(s) of the edge(s). +A vertex sequence with the tail(s) of the edge(s) if +the \code{return.vs.es} igraph option is true (the default), or a numeric +vector of vertex IDs otherwise. } \description{ For undirected graphs, head and tail is not defined. In this case From ea6674871d793f409d1731f975b83dc85ae1d879 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 26 Oct 2025 21:13:18 +0000 Subject: [PATCH 3/3] Changes before error encountered Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- tests/testthat/test-conversion.R | 18 ++++++++++++ tests/testthat/test-interface.R | 36 +++++++++++++++++++++++ tests/testthat/test-topology.R | 49 ++++++++++++++++++++++++++++++++ 3 files changed, 103 insertions(+) diff --git a/tests/testthat/test-conversion.R b/tests/testthat/test-conversion.R index 5fddb5f12fb..2b47fdf06fc 100644 --- a/tests/testthat/test-conversion.R +++ b/tests/testthat/test-conversion.R @@ -444,6 +444,24 @@ test_that("as_adj_list works when return.vs.es is FALSE", { } }) +test_that("as_adj_edge_list respects return.vs.es option", { + g <- make_tree(6, children = 2) + V(g)$name <- paste0("V", 1:6) + + # Test with return.vs.es = TRUE (default) + local_igraph_options(return.vs.es = TRUE) + adj_el_list <- as_adj_edge_list(g) + expect_s3_class(adj_el_list[[1]], "igraph.es") + expect_length(adj_el_list[[1]], 2) + + # Test with return.vs.es = FALSE + local_igraph_options(return.vs.es = FALSE) + adj_el_list <- as_adj_edge_list(g) + expect_type(adj_el_list[[1]], "integer") + expect_length(adj_el_list[[1]], 2) + expect_equal(as.numeric(adj_el_list[[1]]), c(1, 2)) +}) + test_that("as_edgelist works", { g <- sample_gnp(100, 3 / 100) el <- as_edgelist(g) diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index d1f5b10ecc1..b184ca1d2dc 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -222,3 +222,39 @@ test_that("get_edge_id() errors correctly for wrong matrices", { mat <- matrix(c(1, 2, 1, 3, 1, 4), nrow = 2, ncol = 3) lifecycle::expect_deprecated(get_edge_ids(g, mat)) }) + +test_that("head_of respects return.vs.es option", { + g <- make_tree(6, children = 2) + V(g)$name <- paste0("V", 1:6) + + # Test with return.vs.es = TRUE (default) + local_igraph_options(return.vs.es = TRUE) + result <- head_of(g, E(g)[c(1, 4)]) + expect_s3_class(result, "igraph.vs") + expect_length(result, 2) + + # Test with return.vs.es = FALSE + local_igraph_options(return.vs.es = FALSE) + result <- head_of(g, E(g)[c(1, 4)]) + expect_type(result, "integer") + expect_length(result, 2) + expect_equal(as.numeric(result), c(2, 5)) +}) + +test_that("tail_of respects return.vs.es option", { + g <- make_tree(6, children = 2) + V(g)$name <- paste0("V", 1:6) + + # Test with return.vs.es = TRUE (default) + local_igraph_options(return.vs.es = TRUE) + result <- tail_of(g, E(g)[c(1, 4)]) + expect_s3_class(result, "igraph.vs") + expect_length(result, 2) + + # Test with return.vs.es = FALSE + local_igraph_options(return.vs.es = FALSE) + result <- tail_of(g, E(g)[c(1, 4)]) + expect_type(result, "integer") + expect_length(result, 2) + expect_equal(as.numeric(result), c(1, 2)) +}) diff --git a/tests/testthat/test-topology.R b/tests/testthat/test-topology.R index 12dec658e91..dbead6834f3 100644 --- a/tests/testthat/test-topology.R +++ b/tests/testthat/test-topology.R @@ -361,3 +361,52 @@ test_that("subgraph_isomorphisms, vf2", { g3 <- graph_from_literal(X - Y - Z - X) expect_equal(subgraph_isomorphisms(g3, g1, method = "vf2"), list()) }) + +test_that("graph.get.isomorphisms.vf2 respects return.vs.es option", { + g <- make_tree(6, children = 2) + V(g)$name <- paste0("V", 1:6) + + # Test with return.vs.es = TRUE (default) + local_igraph_options(return.vs.es = TRUE) + result <- graph.get.isomorphisms.vf2(g, g) + expect_s3_class(result[[1]], "igraph.vs") + expect_length(result[[1]], 6) + + # Test with return.vs.es = FALSE + local_igraph_options(return.vs.es = FALSE) + result <- graph.get.isomorphisms.vf2(g, g) + expect_type(result[[1]], "integer") + expect_length(result[[1]], 6) +}) + +test_that("graph.get.subisomorphisms.vf2 respects return.vs.es option", { + g <- make_tree(6, children = 2) + + # Test with return.vs.es = TRUE (default) + local_igraph_options(return.vs.es = TRUE) + result <- graph.get.subisomorphisms.vf2(g, g) + expect_s3_class(result[[1]], "igraph.vs") + expect_length(result[[1]], 6) + + # Test with return.vs.es = FALSE + local_igraph_options(return.vs.es = FALSE) + result <- graph.get.subisomorphisms.vf2(g, g) + expect_type(result[[1]], "integer") + expect_length(result[[1]], 6) +}) + +test_that("graph.subisomorphic.lad respects return.vs.es option", { + g <- make_tree(6, children = 2) + + # Test with return.vs.es = TRUE (default) + local_igraph_options(return.vs.es = TRUE) + result <- graph.subisomorphic.lad(g, g, all.maps = TRUE) + expect_s3_class(result$maps[[1]], "igraph.vs") + expect_length(result$maps[[1]], 6) + + # Test with return.vs.es = FALSE + local_igraph_options(return.vs.es = FALSE) + result <- graph.subisomorphic.lad(g, g, all.maps = TRUE) + expect_type(result$maps[[1]], "integer") + expect_length(result$maps[[1]], 6) +})