From 7ad11a8218e554423d0d6561d3ec24d673b023c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 20 Jan 2025 10:21:34 +0100 Subject: [PATCH 1/7] feat: `get_edge_ids()` accepts data frames and matrices --- R/interface.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/interface.R b/R/interface.R index fdae8dcf454..54b08b5b2f7 100644 --- a/R/interface.R +++ b/R/interface.R @@ -482,8 +482,9 @@ get.edges <- function(graph, es) { #' vertices. #' #' @param graph The input graph. -#' @param vp The incident vertices, given as vertex ids or symbolic vertex -#' names. They are interpreted pairwise, i.e. the first and second are used for +#' @param vp The incident vertices, given as a two-column data frame, two-column matrix, +#' or vector of vertex ids or symbolic vertex names. +#' For a vector, the values are interpreted pairwise, i.e. the first and second are used for #' the first edge, the third and fourth for the second, etc. #' @param directed Logical scalar, whether to consider edge directions in #' directed graphs. This argument is ignored for undirected graphs. From 11e324030993c9177040b69e8ea1a8809b3ac9a4 Mon Sep 17 00:00:00 2001 From: schochastics Date: Mon, 20 Jan 2025 15:30:04 +0100 Subject: [PATCH 2/7] added converter from df/mat to vector --- R/interface.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/R/interface.R b/R/interface.R index 54b08b5b2f7..00aeaaf284e 100644 --- a/R/interface.R +++ b/R/interface.R @@ -467,6 +467,19 @@ get.edges <- function(graph, es) { ends(graph, es, names = FALSE) } +el_to_vec <- function(x) { + if (is.data.frame(x)) { + c(rbind(x[[1]], x[[2]])) + } else if (inherits(x, "matrix")) { + # c(t(x[,1:2])) TODO: decide on deprecation note + x + } else if (is.vector(x)) { + x + } else { + cli::cli_abort("only two-column data.frames and matrices, and vectors are allowed for vp") + } +} + #' Find the edge ids based on the incident vertices of the edges #' @@ -520,6 +533,8 @@ get_edge_ids <- function(graph, error = FALSE) { ensure_igraph(graph) + vp <- el_to_vec(vp) + on.exit(.Call(R_igraph_finalizer)) .Call( R_igraph_get_eids, graph, as_igraph_vs(graph, vp) - 1, From 3acdae69c95976de8d56c95b7c0e93114bfe317f Mon Sep 17 00:00:00 2001 From: David Schoch Date: Mon, 20 Jan 2025 15:47:16 +0100 Subject: [PATCH 3/7] added call argument for proper error display MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Kirill Müller --- R/interface.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/interface.R b/R/interface.R index 00aeaaf284e..812a18494d3 100644 --- a/R/interface.R +++ b/R/interface.R @@ -467,7 +467,7 @@ get.edges <- function(graph, es) { ends(graph, es, names = FALSE) } -el_to_vec <- function(x) { +el_to_vec <- function(x, call = caller_env()) { if (is.data.frame(x)) { c(rbind(x[[1]], x[[2]])) } else if (inherits(x, "matrix")) { From 1bb6b793180b121143624823ab7b09f31398af46 Mon Sep 17 00:00:00 2001 From: schochastics Date: Mon, 20 Jan 2025 19:15:37 +0100 Subject: [PATCH 4/7] added tests and call to cli::abort --- R/interface.R | 6 ++--- tests/testthat/test-interface.R | 39 ++++++++++++++++++++++----------- 2 files changed, 28 insertions(+), 17 deletions(-) diff --git a/R/interface.R b/R/interface.R index 812a18494d3..75ecebb254b 100644 --- a/R/interface.R +++ b/R/interface.R @@ -1,4 +1,3 @@ - #' Check whether a graph is directed #' #' @description @@ -467,7 +466,7 @@ get.edges <- function(graph, es) { ends(graph, es, names = FALSE) } -el_to_vec <- function(x, call = caller_env()) { +el_to_vec <- function(x, call = rlang::caller_env()) { if (is.data.frame(x)) { c(rbind(x[[1]], x[[2]])) } else if (inherits(x, "matrix")) { @@ -476,7 +475,7 @@ el_to_vec <- function(x, call = caller_env()) { } else if (is.vector(x)) { x } else { - cli::cli_abort("only two-column data.frames and matrices, and vectors are allowed for vp") + cli::cli_abort("only two-column data.frames and matrices, and vectors are allowed for vp", call = call) } } @@ -559,7 +558,6 @@ get.edge.ids <- function(graph, directed = TRUE, error = FALSE, multi = deprecated()) { - if (lifecycle::is_present(multi)) { if (isTRUE(multi)) { lifecycle::deprecate_stop("2.0.0", "get.edge.ids(multi = )") diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index 6b0463a1c51..d13aeb3cd85 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -124,7 +124,6 @@ test_that("adjacent_vertices works", { for (i in seq_along(test_vertices)) { expect_setequal(adj_vertices[[i]], al[[test_vertices[i]]]) } - }) @@ -156,18 +155,18 @@ test_that("delete_edges works", { g2 <- delete_edges(g, E(g, P = c("D", "E"))) expected_matrix <- matrix( - c( - 0, 0, 0, 1, 1, 1, - 0, 0, 0, 1, 1, 1, - 0, 0, 0, 1, 1, 1, - 1, 1, 1, 0, 0, 0, - 1, 1, 1, 0, 0, 1, - 1, 1, 1, 0, 1, 0 - ), - nrow = 6L, - ncol = 6L, - dimnames = list(c("A", "B", "C", "D", "E", "F"), c("A", "B", "C", "D", "E", "F")) - ) + c( + 0, 0, 0, 1, 1, 1, + 0, 0, 0, 1, 1, 1, + 0, 0, 0, 1, 1, 1, + 1, 1, 1, 0, 0, 0, + 1, 1, 1, 0, 0, 1, + 1, 1, 1, 0, 1, 0 + ), + nrow = 6L, + ncol = 6L, + dimnames = list(c("A", "B", "C", "D", "E", "F"), c("A", "B", "C", "D", "E", "F")) + ) expect_equal(as.matrix(g2[]), expected_matrix) }) @@ -184,3 +183,17 @@ test_that("get.edge.ids() deprecation", { expect_snapshot(get.edge.ids(g, 1:2)) expect_snapshot(get.edge.ids(g, 1:2, multi = TRUE), error = TRUE) }) + +test_that("get_edge_id() works with data frame", { + g <- make_full_graph(3, directed = FALSE) + el_df <- data.frame(from = c(1, 1), to = c(2, 3)) + expect_equal(get_edge_ids(g, el_df), c(1, 2)) +}) + +test_that("get_edge_id() errors correctly", { + g <- make_full_graph(3, directed = FALSE) + el_g <- make_empty_graph() + expect_error(get_edge_ids(g, el_g)) + expect_error(get_edge_ids(g, NULL)) + expect_error(get_edge_ids(g, NA)) +}) From 034a2bec915b980a6a411037887c0be483023e42 Mon Sep 17 00:00:00 2001 From: David Schoch Date: Thu, 23 Jan 2025 19:47:18 +0100 Subject: [PATCH 5/7] Updated error message MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Kirill Müller --- R/interface.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/interface.R b/R/interface.R index 75ecebb254b..75686d80a54 100644 --- a/R/interface.R +++ b/R/interface.R @@ -475,7 +475,7 @@ el_to_vec <- function(x, call = rlang::caller_env()) { } else if (is.vector(x)) { x } else { - cli::cli_abort("only two-column data.frames and matrices, and vectors are allowed for vp", call = call) + cli::cli_abort("Only two-column data.frames and matrices, and vectors are allowed for {.args vp}", call = call) } } From 547fca1b608b4d838783f2969c5c421a083af917 Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 23 Jan 2025 20:50:52 +0100 Subject: [PATCH 6/7] refactor el-to-vec and added tests --- R/interface.R | 27 +++++++++++++++++++++++---- tests/testthat/_snaps/interface.md | 16 ++++++++++++++++ tests/testthat/test-interface.R | 29 +++++++++++++++++++++++++++-- 3 files changed, 66 insertions(+), 6 deletions(-) diff --git a/R/interface.R b/R/interface.R index 75686d80a54..90e607b1f04 100644 --- a/R/interface.R +++ b/R/interface.R @@ -468,10 +468,29 @@ get.edges <- function(graph, es) { el_to_vec <- function(x, call = rlang::caller_env()) { if (is.data.frame(x)) { - c(rbind(x[[1]], x[[2]])) + if (typeof(x[[1]]) == typeof(x[[2]])) { + c(rbind(x[[1]], x[[2]])) + } else { + cli::cli_abort("The columns of the data.frame are of different type ({typeof(x[[1]])} and {typeof(x[[2]])}) ") + } } else if (inherits(x, "matrix")) { - # c(t(x[,1:2])) TODO: decide on deprecation note - x + dimx <- dim(x) + if (identical(dimx, c(2L, 2L))) { + lifecycle::deprecate_stop( + "2.1.5", + "get_edge_ids(vp = 'is not allowed to be a 2 times 2 matrix')" + ) + } else if (dimx[1] == 2L) { + lifecycle::deprecate_warn( + "2.1.5", + "get_edge_ids(vp = 'supplied as a matrix should be a n times 2 matrix, not 2 times n')" + ) + c(x) + } else if (dimx[2] == 2L) { + c(t(x)) + } else { + cli::cli_abort("{.args vp} was supplied as a {dimx[1]} times {dimx[2]} matrix. Only n times 2 matrices are allowed") + } } else if (is.vector(x)) { x } else { @@ -532,7 +551,7 @@ get_edge_ids <- function(graph, error = FALSE) { ensure_igraph(graph) - vp <- el_to_vec(vp) + vp <- el_to_vec(vp, call = rlang::caller_env()) on.exit(.Call(R_igraph_finalizer)) .Call( diff --git a/tests/testthat/_snaps/interface.md b/tests/testthat/_snaps/interface.md index f7a83c55648..d394032f7a6 100644 --- a/tests/testthat/_snaps/interface.md +++ b/tests/testthat/_snaps/interface.md @@ -17,3 +17,19 @@ Error: ! The `multi` argument of `get.edge.ids()` was deprecated in igraph 2.0.0 and is now defunct. +# get_edge_id() errors correctly for wrong vp + + Code + get_edge_ids(g, el_g) + Condition + Error: + ! Only two-column data.frames and matrices, and vectors are allowed for vp + +--- + + Code + get_edge_ids(g, df) + Condition + Error in `el_to_vec()`: + ! The columns of the data.frame are of different type (character and double) + diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index d13aeb3cd85..7ab14c8ea95 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -190,10 +190,35 @@ test_that("get_edge_id() works with data frame", { expect_equal(get_edge_ids(g, el_df), c(1, 2)) }) -test_that("get_edge_id() errors correctly", { +test_that("get_edge_id() works with matrices", { + g <- make_full_graph(10) + mat <- matrix(c(1, 2, 1, 3, 1, 4), 3, 2, byrow = TRUE) + expect_equal(get_edge_ids(g, mat), c(1, 2, 3)) + + mat <- matrix(c(1, 2), 1, 2) + expect_equal(get_edge_ids(g, mat), 1) +}) + +test_that("get_edge_id() errors correctly for wrong vp", { g <- make_full_graph(3, directed = FALSE) el_g <- make_empty_graph() - expect_error(get_edge_ids(g, el_g)) + expect_snapshot(error = TRUE, { + get_edge_ids(g, el_g) + }) expect_error(get_edge_ids(g, NULL)) expect_error(get_edge_ids(g, NA)) + + V(g)$name <- letters[1:3] + df <- data.frame(from = c("a", "b"), to = c(1, 2)) + expect_snapshot(error = TRUE, { + get_edge_ids(g, df) + }) +}) + +test_that("get_edge_id() errors correctly for wrong matrices", { + g <- make_full_graph(10) + mat <- matrix(c(1, 2, 3, 4), 2, 2) + lifecycle::expect_defunct(get_edge_ids(g, mat)) + mat <- matrix(c(1, 2, 1, 3, 1, 4), 2, 3) + lifecycle::expect_deprecated(get_edge_ids(g, mat)) }) From 8e69f380b934896a022c7059ffef62bfafc9abb3 Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 30 Jan 2025 20:42:05 +0100 Subject: [PATCH 7/7] fixed review remarks --- R/interface.R | 11 +++++++---- tests/testthat/test-interface.R | 4 ++-- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/R/interface.R b/R/interface.R index 90e607b1f04..687f45a9fac 100644 --- a/R/interface.R +++ b/R/interface.R @@ -475,18 +475,21 @@ el_to_vec <- function(x, call = rlang::caller_env()) { } } else if (inherits(x, "matrix")) { dimx <- dim(x) - if (identical(dimx, c(2L, 2L))) { + nrow <- dimx[[1]] + ncol <- dimx[[2]] + if (nrow == 2 && ncol == 2) { lifecycle::deprecate_stop( "2.1.5", "get_edge_ids(vp = 'is not allowed to be a 2 times 2 matrix')" ) - } else if (dimx[1] == 2L) { + } else if (nrow == 2) { lifecycle::deprecate_warn( "2.1.5", - "get_edge_ids(vp = 'supplied as a matrix should be a n times 2 matrix, not 2 times n')" + "get_edge_ids(vp = 'supplied as a matrix should be a n times 2 matrix, not 2 times n')", + details = "either transpose the matrix with t() or convert it to a data.frame with two columns." ) c(x) - } else if (dimx[2] == 2L) { + } else if (ncol == 2) { c(t(x)) } else { cli::cli_abort("{.args vp} was supplied as a {dimx[1]} times {dimx[2]} matrix. Only n times 2 matrices are allowed") diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index 7ab14c8ea95..91669ee58af 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -217,8 +217,8 @@ test_that("get_edge_id() errors correctly for wrong vp", { test_that("get_edge_id() errors correctly for wrong matrices", { g <- make_full_graph(10) - mat <- matrix(c(1, 2, 3, 4), 2, 2) + mat <- matrix(c(1, 2, 3, 4), nrow = 2, ncol = 2) lifecycle::expect_defunct(get_edge_ids(g, mat)) - mat <- matrix(c(1, 2, 1, 3, 1, 4), 2, 3) + mat <- matrix(c(1, 2, 1, 3, 1, 4), nrow = 2, ncol = 3) lifecycle::expect_deprecated(get_edge_ids(g, mat)) })