From ae22e400bbafc9893fe06bb66daac95b3c9ea954 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Fri, 3 Oct 2025 15:06:28 +0200 Subject: [PATCH 1/2] chore: handle new values of `loops` argument of `degree()` and `max_degree()` --- R/aaa-auto.R | 14 +++++ R/structural-properties.R | 65 +++++++++++++++++---- man/degree.Rd | 8 ++- src/rinterface.c | 36 ++++++++++++ src/rinterface_extra.c | 24 -------- tests/testthat/test-structural-properties.R | 6 +- tools/stimulus/functions-R.yaml | 3 - 7 files changed, 113 insertions(+), 43 deletions(-) diff --git a/R/aaa-auto.R b/R/aaa-auto.R index ae20fdb02e..3773e67904 100644 --- a/R/aaa-auto.R +++ b/R/aaa-auto.R @@ -59,6 +59,20 @@ vcount_impl <- function(graph) { res } +degree_impl <- function(graph, vids=V(graph), mode=c("all", "out", "in", "total"), loops=c("twice", "none", "once")) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) + loops <- switch(igraph.match.arg(loops), "none"=0L, "twice"=1L, "once"=2L) + + on.exit( .Call(R_igraph_finalizer) ) + # Function call + res <- .Call(R_igraph_degree, graph, vids-1, mode, loops) + + res +} + get_all_eids_between_impl <- function(graph, from, to, directed=TRUE) { # Argument checks ensure_igraph(graph) diff --git a/R/structural-properties.R b/R/structural-properties.R index ee9e528174..e44559c058 100644 --- a/R/structural-properties.R +++ b/R/structural-properties.R @@ -865,7 +865,11 @@ mean_distance <- average_path_length_impl #' @param mode Character string, \dQuote{out} for out-degree, \dQuote{in} for #' in-degree or \dQuote{total} for the sum of the two. For undirected graphs #' this argument is ignored. \dQuote{all} is a synonym of \dQuote{total}. -#' @param loops Logical; whether the loop edges are also counted. +#' @param loops Character string, +#' `"none"` ignores loop edges; +#' `"once"` counts each loop edge only once; +#' `"twice"` (the default) counts each loop edge twice in undirected graphs +#' and once in directed graphs. #' @param normalized Logical scalar, whether to normalize the degree. If #' `TRUE` then the result is divided by \eqn{n-1}, where \eqn{n} is the #' number of vertices in the graph. @@ -896,22 +900,33 @@ degree <- function( graph, v = V(graph), mode = c("all", "out", "in", "total"), - loops = TRUE, + loops = c("twice", "none", "once"), normalized = FALSE ) { ensure_igraph(graph) - v <- as_igraph_vs(graph, v) mode <- igraph.match.arg(mode) - mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3) - on.exit(.Call(R_igraph_finalizer)) - res <- .Call( - R_igraph_degree, + if (is.logical(loops)) { + lifecycle::deprecate_soft( + "2.1.5", + "degree(loops = 'must be a character string')" + ) + if (loops) { + loops <- "twice" + } else { + loops <- "none" + } + } + + loops <- igraph.match.arg(loops) + + res <- degree_impl( graph, - v - 1, - as.numeric(mode), - as.logical(loops) + vids = v, + mode = mode, + loops = loops ) + if (normalized) { res <- res / (vcount(graph) - 1) } @@ -924,8 +939,36 @@ degree <- function( #' @rdname degree #' @export #' @cdocs igraph_maxdegree -max_degree <- maxdegree_impl +max_degree <- function( + graph, + ..., + v = V(graph), + mode = c("all", "out", "in", "total"), + loops = c("twice", "none", "once") +) { + ensure_igraph(graph) + mode <- igraph.match.arg(mode) + + if (is.logical(loops)) { + lifecycle::deprecate_soft( + "2.1.5", + "max_degree(loops = 'must be a character string')" + ) + if (loops) { + loops <- "twice" + } else { + loops <- "none" + } + } + loops <- igraph.match.arg(loops) + maxdegree_impl( + graph, + v = v, + mode = mode, + loops = loops + ) +} #' @rdname degree #' @param cumulative Logical; whether the cumulative degree distribution is to #' be calculated. diff --git a/man/degree.Rd b/man/degree.Rd index e548afcbb3..29eede56c1 100644 --- a/man/degree.Rd +++ b/man/degree.Rd @@ -10,7 +10,7 @@ degree( graph, v = V(graph), mode = c("all", "out", "in", "total"), - loops = TRUE, + loops = c("twice", "none", "once"), normalized = FALSE ) @@ -33,7 +33,11 @@ degree_distribution(graph, cumulative = FALSE, ...) in-degree or \dQuote{total} for the sum of the two. For undirected graphs this argument is ignored. \dQuote{all} is a synonym of \dQuote{total}.} -\item{loops}{Logical; whether the loop edges are also counted.} +\item{loops}{Character string, +\code{"none"} ignores loop edges; +\code{"once"} counts each loop edge only once; +\code{"twice"} (the default) counts each loop edge twice in undirected graphs +and once in directed graphs.} \item{normalized}{Logical scalar, whether to normalize the degree. If \code{TRUE} then the result is divided by \eqn{n-1}, where \eqn{n} is the diff --git a/src/rinterface.c b/src/rinterface.c index 7ff8f56eb8..72e2bf616b 100644 --- a/src/rinterface.c +++ b/src/rinterface.c @@ -188,6 +188,42 @@ SEXP R_igraph_vcount(SEXP graph) { return(r_result); } +/*-------------------------------------------/ +/ igraph_degree / +/-------------------------------------------*/ +SEXP R_igraph_degree(SEXP graph, SEXP vids, SEXP mode, SEXP loops) { + /* Declarations */ + igraph_t c_graph; + igraph_vector_int_t c_res; + igraph_vs_t c_vids; + igraph_neimode_t c_mode; + igraph_loops_t c_loops; + SEXP res; + + SEXP r_result; + /* Convert input */ + R_SEXP_to_igraph(graph, &c_graph); + IGRAPH_R_CHECK(igraph_vector_int_init(&c_res, 0)); + IGRAPH_FINALLY(igraph_vector_int_destroy, &c_res); + igraph_vector_int_t c_vids_data; + R_SEXP_to_igraph_vs(vids, &c_graph, &c_vids, &c_vids_data); + c_mode = (igraph_neimode_t) Rf_asInteger(mode); + c_loops = (igraph_loops_t) Rf_asInteger(loops); + /* Call igraph */ + IGRAPH_R_CHECK(igraph_degree(&c_graph, &c_res, c_vids, c_mode, c_loops)); + + /* Convert output */ + PROTECT(res=R_igraph_vector_int_to_SEXP(&c_res)); + igraph_vector_int_destroy(&c_res); + IGRAPH_FINALLY_CLEAN(1); + igraph_vector_int_destroy(&c_vids_data); + igraph_vs_destroy(&c_vids); + r_result = res; + + UNPROTECT(1); + return(r_result); +} + /*-------------------------------------------/ / igraph_get_all_eids_between / /-------------------------------------------*/ diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index 257ffccf4c..51dde1d98b 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -3983,30 +3983,6 @@ SEXP R_igraph_create(SEXP edges, SEXP pn, SEXP pdirected) { return result; } -SEXP R_igraph_degree(SEXP graph, SEXP vids, SEXP pmode, SEXP ploops) { - - igraph_t g; - igraph_vs_t vs; - igraph_vector_int_t vs_data; - igraph_vector_int_t res; - igraph_neimode_t mode = (igraph_neimode_t) Rf_asInteger(pmode); - igraph_bool_t loops=LOGICAL(ploops)[0]; - SEXP result; - - R_SEXP_to_igraph(graph, &g); - R_SEXP_to_igraph_vs(vids, &g, &vs, &vs_data); - igraph_vector_int_init(&res, 0); - IGRAPH_R_CHECK(igraph_degree(&g, &res, vs, mode, loops)); - - PROTECT(result=R_igraph_vector_int_to_SEXP(&res)); - igraph_vector_int_destroy(&res); - igraph_vector_int_destroy(&vs_data); - igraph_vs_destroy(&vs); - - UNPROTECT(1); - return result; -} - SEXP R_igraph_get_diameter(SEXP graph, SEXP pdirected, SEXP punconnected, SEXP pweights) { diff --git a/tests/testthat/test-structural-properties.R b/tests/testthat/test-structural-properties.R index f938d495dd..7f8a1fcd30 100644 --- a/tests/testthat/test-structural-properties.R +++ b/tests/testthat/test-structural-properties.R @@ -65,9 +65,9 @@ test_that("max_degree() works", { g <- make_graph(c(1, 2, 2, 2, 2, 3), directed = TRUE) expect_equal(max_degree(g), 4) expect_equal(max_degree(g, mode = "out"), 2) - expect_equal(max_degree(g, loops = FALSE), 2) - expect_equal(max_degree(g, mode = "out", loops = FALSE), 1) - expect_equal(max_degree(g, mode = "in", loops = FALSE), 1) + expect_equal(max_degree(g, loops = "none"), 2) + expect_equal(max_degree(g, mode = "out", loops = "none"), 1) + expect_equal(max_degree(g, mode = "in", loops = "none"), 1) expect_equal(max_degree(g, v = c()), 0) expect_equal(max_degree(make_empty_graph()), 0) }) diff --git a/tools/stimulus/functions-R.yaml b/tools/stimulus/functions-R.yaml index 47b140f3b8..4db2ae8fb6 100644 --- a/tools/stimulus/functions-R.yaml +++ b/tools/stimulus/functions-R.yaml @@ -34,9 +34,6 @@ igraph_neighbors: igraph_is_directed: IGNORE: RR, RC -igraph_degree: - IGNORE: RR, RC - igraph_edge: IGNORE: RR, RC, RInit From aafa5db91bce6c701966d8a2159929dba48f944f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Thu, 9 Oct 2025 09:58:54 +0200 Subject: [PATCH 2/2] change version --- R/structural-properties.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/structural-properties.R b/R/structural-properties.R index e44559c058..74af2e03e3 100644 --- a/R/structural-properties.R +++ b/R/structural-properties.R @@ -908,7 +908,7 @@ degree <- function( if (is.logical(loops)) { lifecycle::deprecate_soft( - "2.1.5", + "2.2.0", "degree(loops = 'must be a character string')" ) if (loops) { @@ -951,7 +951,7 @@ max_degree <- function( if (is.logical(loops)) { lifecycle::deprecate_soft( - "2.1.5", + "2.2.0", "max_degree(loops = 'must be a character string')" ) if (loops) {