From 22abf24ab8039d00f48fe45bb0c104d10dd11af7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Szabolcs=20Horva=CC=81t?= Date: Sun, 16 Jun 2024 10:27:32 -0400 Subject: [PATCH] feat: `max_degree()` --- NAMESPACE | 1 + R/aaa-auto.R | 15 ++++++++++++++ R/structural.properties.R | 12 +++++++++-- man/degree.Rd | 19 +++++++++++++++--- man/degree.distribution.Rd | 3 +-- src/cpp11.cpp | 2 ++ src/rinterface.c | 35 +++++++++++++++++++++++++++++++++ tests/testthat/test-degree.R | 11 +++++++++++ tools/stimulus/functions-R.yaml | 4 +++- 9 files changed, 94 insertions(+), 8 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 999714d6bc..fd00da449d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -657,6 +657,7 @@ export(max_bipartite_match) export(max_cardinality) export(max_cliques) export(max_cohesion) +export(max_degree) export(max_flow) export(maxcohesion) export(maximal.cliques) diff --git a/R/aaa-auto.R b/R/aaa-auto.R index 5d8f636bf8..e8bd25877e 100644 --- a/R/aaa-auto.R +++ b/R/aaa-auto.R @@ -1268,6 +1268,21 @@ reciprocity_impl <- function(graph, ignore.loops=TRUE, mode=c("default", "ratio" res } +maxdegree_impl <- function(graph, ..., v=V(graph), mode=c("all", "out", "in", "total"), loops=TRUE) { + # Argument checks + check_dots_empty() + ensure_igraph(graph) + v <- as_igraph_vs(graph, v) + mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) + loops <- as.logical(loops) + + on.exit( .Call(R_igraph_finalizer) ) + # Function call + res <- .Call(R_igraph_maxdegree, graph, v-1, mode, loops) + + res +} + mean_degree_impl <- function(graph, loops=TRUE) { # Argument checks ensure_igraph(graph) diff --git a/R/structural.properties.R b/R/structural.properties.R index adf7f86326..5951ee4535 100644 --- a/R/structural.properties.R +++ b/R/structural.properties.R @@ -595,14 +595,17 @@ mean_distance <- average_path_length_dijkstra_impl #' @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. -#' @param \dots Additional arguments to pass to `degree()`, e.g. `mode` -#' is useful but also `v` and `loops` make sense. +#' @inheritParams rlang::args_dots_empty #' @return For `degree()` a numeric vector of the same length as argument #' `v`. #' #' For `degree_distribution()` a numeric vector of the same length as the #' maximum degree plus one. The first element is the relative frequency zero #' degree vertices, the second vertices with degree one, etc. +#' +#' For `max_degree()`, the largest degree in the graph. When no vertices are +#' selected, or when the input is the null graph, zero is returned as this +#' is the smallest possible degree. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} #' @keywords graphs #' @family structural.properties @@ -612,6 +615,7 @@ mean_distance <- average_path_length_dijkstra_impl #' g <- make_ring(10) #' degree(g) #' g2 <- sample_gnp(1000, 10 / 1000) +#' max_degree(g2) #' degree_distribution(g2) #' degree <- function(graph, v = V(graph), @@ -641,6 +645,10 @@ degree <- function(graph, v = V(graph), res } +#' @rdname degree +#' @export +max_degree <- maxdegree_impl + #' @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 e367accd6a..f019f6efbd 100644 --- a/man/degree.Rd +++ b/man/degree.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/structural.properties.R \name{degree} \alias{degree} +\alias{max_degree} \alias{degree_distribution} \title{Degree and degree distribution of the vertices} \usage{ @@ -13,6 +14,14 @@ degree( normalized = FALSE ) +max_degree( + graph, + ..., + v = V(graph), + mode = c("all", "out", "in", "total"), + loops = TRUE +) + degree_distribution(graph, cumulative = FALSE, ...) } \arguments{ @@ -30,11 +39,10 @@ this argument is ignored. \dQuote{all} is a synonym of \dQuote{total}.} \code{TRUE} then the result is divided by \eqn{n-1}, where \eqn{n} is the number of vertices in the graph.} +\item{...}{These dots are for future extensions and must be empty.} + \item{cumulative}{Logical; whether the cumulative degree distribution is to be calculated.} - -\item{\dots}{Additional arguments to pass to \code{degree()}, e.g. \code{mode} -is useful but also \code{v} and \code{loops} make sense.} } \value{ For \code{degree()} a numeric vector of the same length as argument @@ -43,6 +51,10 @@ For \code{degree()} a numeric vector of the same length as argument For \code{degree_distribution()} a numeric vector of the same length as the maximum degree plus one. The first element is the relative frequency zero degree vertices, the second vertices with degree one, etc. + +For \code{max_degree()}, the largest degree in the graph. When no vertices are +selected, or when the input is the null graph, zero is returned as this +is the smallest possible degree. } \description{ The degree of a vertex is its most basic structural property, the number of @@ -53,6 +65,7 @@ its adjacent edges. g <- make_ring(10) degree(g) g2 <- sample_gnp(1000, 10 / 1000) +max_degree(g) degree_distribution(g2) } diff --git a/man/degree.distribution.Rd b/man/degree.distribution.Rd index 945b67d45d..3c1be92a3e 100644 --- a/man/degree.distribution.Rd +++ b/man/degree.distribution.Rd @@ -12,8 +12,7 @@ degree.distribution(graph, cumulative = FALSE, ...) \item{cumulative}{Logical; whether the cumulative degree distribution is to be calculated.} -\item{...}{Additional arguments to pass to \code{degree()}, e.g. \code{mode} -is useful but also \code{v} and \code{loops} make sense.} +\item{...}{These dots are for future extensions and must be empty.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} diff --git a/src/cpp11.cpp b/src/cpp11.cpp index 1a673d8598..ed4f93286e 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -324,6 +324,7 @@ extern SEXP R_igraph_local_scan_k_ecount_them(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_neighborhood_ecount(SEXP, SEXP, SEXP); extern SEXP R_igraph_local_scan_subset_ecount(SEXP, SEXP, SEXP); extern SEXP R_igraph_make_weak_ref(SEXP, SEXP, SEXP); +extern SEXP R_igraph_maxdegree(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_maxflow(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_maximal_cliques(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_maximal_cliques_count(SEXP, SEXP, SEXP, SEXP); @@ -785,6 +786,7 @@ static const R_CallMethodDef CallEntries[] = { {"R_igraph_local_scan_neighborhood_ecount", (DL_FUNC) &R_igraph_local_scan_neighborhood_ecount, 3}, {"R_igraph_local_scan_subset_ecount", (DL_FUNC) &R_igraph_local_scan_subset_ecount, 3}, {"R_igraph_make_weak_ref", (DL_FUNC) &R_igraph_make_weak_ref, 3}, + {"R_igraph_maxdegree", (DL_FUNC) &R_igraph_maxdegree, 4}, {"R_igraph_maxflow", (DL_FUNC) &R_igraph_maxflow, 4}, {"R_igraph_maximal_cliques", (DL_FUNC) &R_igraph_maximal_cliques, 4}, {"R_igraph_maximal_cliques_count", (DL_FUNC) &R_igraph_maximal_cliques_count, 4}, diff --git a/src/rinterface.c b/src/rinterface.c index 73cb904f07..135bb7b327 100644 --- a/src/rinterface.c +++ b/src/rinterface.c @@ -3590,6 +3590,41 @@ SEXP R_igraph_reciprocity(SEXP graph, SEXP ignore_loops, SEXP mode) { return(r_result); } +/*-------------------------------------------/ +/ igraph_maxdegree / +/-------------------------------------------*/ +SEXP R_igraph_maxdegree(SEXP graph, SEXP vids, SEXP mode, SEXP loops) { + /* Declarations */ + igraph_t c_graph; + igraph_integer_t c_res; + igraph_vs_t c_vids; + igraph_neimode_t c_mode; + igraph_bool_t c_loops; + SEXP res; + + SEXP r_result; + /* Convert input */ + R_SEXP_to_igraph(graph, &c_graph); + c_res=0; + 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); + IGRAPH_R_CHECK_BOOL(loops); + c_loops = LOGICAL(loops)[0]; + /* Call igraph */ + IGRAPH_R_CHECK(igraph_maxdegree(&c_graph, &c_res, c_vids, c_mode, c_loops)); + + /* Convert output */ + PROTECT(res=NEW_NUMERIC(1)); + REAL(res)[0]=(double) c_res; + igraph_vector_int_destroy(&c_vids_data); + igraph_vs_destroy(&c_vids); + r_result = res; + + UNPROTECT(1); + return(r_result); +} + /*-------------------------------------------/ / igraph_mean_degree / /-------------------------------------------*/ diff --git a/tests/testthat/test-degree.R b/tests/testthat/test-degree.R index a58c568c09..c6e53a072d 100644 --- a/tests/testthat/test-degree.R +++ b/tests/testthat/test-degree.R @@ -26,3 +26,14 @@ test_that("degree works", { degree(g2, mode = "all", normalized = TRUE) ) }) + +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, 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 6a86213ac6..1ce0b97358 100644 --- a/tools/stimulus/functions-R.yaml +++ b/tools/stimulus/functions-R.yaml @@ -478,7 +478,9 @@ igraph_constraint: IGNORE: RR, RC igraph_maxdegree: - IGNORE: RR, RC, RInit + PARAM_ORDER: graph, *, vids, ... + PARAM_NAMES: + vids: v igraph_density: IGNORE: RR, RC