From cf68108f9970d7c634208933ad6ee16446f09829 Mon Sep 17 00:00:00 2001 From: David Schoch Date: Thu, 23 Apr 2026 14:34:53 +0200 Subject: [PATCH 1/2] Split generated R/aaa-auto.R into per-category R/aaa-.R files Stimulus generates one monolithic R/aaa-auto.R (~14.8k lines) covering every C igraph wrapper. This commit introduces a categorization layer that splits the generated output into 26 per-category files matching how the functions are grouped in the igraph reference manual, with subcategory banner comments inside each file. - tools/aaa-categories.yaml: authoritative category -> subcategory -> fn mapping, reconciled against every R_igraph_* symbol .Call()'d from the generated wrappers (491 entries; 8 closure wrappers mapped back to their underlying C functions via the src/rcallback.c whitelist) - tools/rebuild-cats.R: idempotent reconciliation tool; fails loudly if new functions appear in the generated wrappers without a categorization - tools/split-aaa-auto.R: post-processes stimulus output into R/aaa-.R - Makefile-cigraph: stimulus now writes to .build/aaa-auto.R (ignored), the split script produces the in-repo R/ files. Phony target r_wrappers covers the full pipeline --- .Rbuildignore | 1 + .gitignore | 1 + Makefile-cigraph | 23 +- R/aaa-auto.R | 14814 ------------------------------------ R/aaa-basicigraph.R | 534 ++ R/aaa-bipartite.R | 286 + R/aaa-cliques.R | 536 ++ R/aaa-coloring.R | 115 + R/aaa-community.R | 731 ++ R/aaa-cycles.R | 389 + R/aaa-embedding.R | 104 + R/aaa-error.R | 20 + R/aaa-flows.R | 714 ++ R/aaa-foreign.R | 436 ++ R/aaa-games.R | 1145 +++ R/aaa-generators.R | 881 +++ R/aaa-graphlets.R | 106 + R/aaa-hrg.R | 245 + R/aaa-isomorphism.R | 957 +++ R/aaa-layout.R | 1000 +++ R/aaa-motifs.R | 221 + R/aaa-nongraph.R | 258 + R/aaa-operators.R | 529 ++ R/aaa-processes.R | 199 + R/aaa-progress.R | 22 + R/aaa-separators.R | 92 + R/aaa-spatial.R | 20 + R/aaa-status.R | 20 + R/aaa-structural.R | 5237 +++++++++++++ R/aaa-visitors.R | 316 + tools/aaa-categories.yaml | 669 ++ tools/rebuild-cats.R | 379 + tools/split-aaa-auto.R | 277 + 33 files changed, 16457 insertions(+), 14820 deletions(-) delete mode 100644 R/aaa-auto.R create mode 100644 R/aaa-basicigraph.R create mode 100644 R/aaa-bipartite.R create mode 100644 R/aaa-cliques.R create mode 100644 R/aaa-coloring.R create mode 100644 R/aaa-community.R create mode 100644 R/aaa-cycles.R create mode 100644 R/aaa-embedding.R create mode 100644 R/aaa-error.R create mode 100644 R/aaa-flows.R create mode 100644 R/aaa-foreign.R create mode 100644 R/aaa-games.R create mode 100644 R/aaa-generators.R create mode 100644 R/aaa-graphlets.R create mode 100644 R/aaa-hrg.R create mode 100644 R/aaa-isomorphism.R create mode 100644 R/aaa-layout.R create mode 100644 R/aaa-motifs.R create mode 100644 R/aaa-nongraph.R create mode 100644 R/aaa-operators.R create mode 100644 R/aaa-processes.R create mode 100644 R/aaa-progress.R create mode 100644 R/aaa-separators.R create mode 100644 R/aaa-spatial.R create mode 100644 R/aaa-status.R create mode 100644 R/aaa-structural.R create mode 100644 R/aaa-visitors.R create mode 100644 tools/aaa-categories.yaml create mode 100644 tools/rebuild-cats.R create mode 100644 tools/split-aaa-auto.R diff --git a/.Rbuildignore b/.Rbuildignore index f6cd805ee96..8ee77119738 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -71,3 +71,4 @@ ^BRANCHES\.md$ ^scripts$ ^\.claude$ +^\.build$ diff --git a/.gitignore b/.gitignore index 8a954dc9012..f7b58cc7573 100644 --- a/.gitignore +++ b/.gitignore @@ -29,3 +29,4 @@ cran /Rplots.pdf /_codeql_detected_source_root /tests/testthat/_problems/ +/.build/ diff --git a/Makefile-cigraph b/Makefile-cigraph index 43b12068723..86181f192ee 100644 --- a/Makefile-cigraph +++ b/Makefile-cigraph @@ -100,7 +100,7 @@ $(RAY2): src/vendor/%: vendor/% # R files that are generated/copied -RGEN = R/aaa-auto.R src/rinterface.c \ +RGEN = .build/r-wrappers.stamp src/rinterface.c \ configure src/config.h.in # Files generated by stimulus @@ -121,21 +121,32 @@ src/rinterface.c: \ -t tools/stimulus/types-RC.yaml \ -l RC -R/aaa-auto.R: \ +# Stimulus generates a single R/aaa-auto.R blob, which tools/split-aaa-auto.R +# then splits into per-category R/aaa-.R files driven by +# tools/aaa-categories.yaml. The monolithic blob is written to .build/ so it +# never lands in R/ itself. +.build/r-wrappers.stamp: \ venv \ $(vendored_srcdir)/interfaces/functions.yaml \ $(vendored_srcdir)/interfaces/types.yaml \ tools/stimulus/aaa-auto.R.in \ tools/stimulus/functions-R.yaml \ - tools/stimulus/types-RR.yaml + tools/stimulus/types-RR.yaml \ + tools/aaa-categories.yaml \ + tools/split-aaa-auto.R + mkdir -p .build $(STIMULUS) \ -f $(vendored_srcdir)/interfaces/functions.yaml \ -f tools/stimulus/functions-R.yaml \ -i tools/stimulus/aaa-auto.R.in \ - -o R/aaa-auto.R \ + -o .build/aaa-auto.R \ -t $(vendored_srcdir)/interfaces/types.yaml \ -t tools/stimulus/types-RR.yaml \ -l RR + Rscript tools/split-aaa-auto.R .build/aaa-auto.R + touch $@ + +r_wrappers: .build/r-wrappers.stamp # This is the list of all object files in the R package, # we write it to a file to be able to depend on it. @@ -157,9 +168,9 @@ pre_build: venv patches $(RSRC) \ $(PARSER2) clean: - rm -rf src/core src/vendor src/include src/config.h.in src/rinterface.c R/aaa-auto.R + rm -rf src/core src/vendor src/include src/config.h.in src/rinterface.c R/aaa-*.R .build git -C $(top_srcdir) reset --hard -.PHONY: all igraph force clean check check-cran check-rhub check-links install test src/sources.mk +.PHONY: all igraph force clean check check-cran check-rhub check-links install test r_wrappers src/sources.mk .NOTPARALLEL: diff --git a/R/aaa-auto.R b/R/aaa-auto.R deleted file mode 100644 index dc98fa76511..00000000000 --- a/R/aaa-auto.R +++ /dev/null @@ -1,14814 +0,0 @@ -# Generated by make -f Makefile-cigraph, do not edit by hand -# styler: off - -empty_impl <- function( - n = 0, - directed = TRUE -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_empty, - n, - directed - ) - - res -} - -add_edges_impl <- function( - graph, - edges -) { - # Argument checks - ensure_igraph(graph) - edges <- as_igraph_vs(graph, edges) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_add_edges, - graph, - edges - 1 - ) - - res -} - -empty_attrs_impl <- function( - n, - directed -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_empty_attrs, - n, - directed - ) - - res -} - -add_vertices_impl <- function( - graph, - nv -) { - # Argument checks - ensure_igraph(graph) - nv <- as.numeric(nv) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_add_vertices, - graph, - nv - ) - - res -} - -copy_impl <- function( - from -) { - # Argument checks - ensure_igraph(from) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_copy, - from - ) - - res -} - -delete_edges_impl <- function( - graph, - edges -) { - # Argument checks - ensure_igraph(graph) - edges <- as_igraph_es(graph, edges) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_delete_edges, - graph, - edges - 1 - ) - - res -} - -delete_vertices_impl <- function( - graph, - vertices -) { - # Argument checks - ensure_igraph(graph) - vertices <- as_igraph_vs(graph, vertices) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_delete_vertices, - graph, - vertices - 1 - ) - - res -} - -delete_vertices_idx_impl <- function( - graph, - vertices -) { - # Argument checks - ensure_igraph(graph) - vertices <- as_igraph_vs(graph, vertices) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_delete_vertices_idx, - graph, - vertices - 1 - ) - - res -} - -vcount_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_vcount, - graph - ) - - res -} - -ecount_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_ecount, - graph - ) - - res -} - -neighbors_impl <- function( - graph, - vid, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - vid <- as_igraph_vs(graph, vid) - if (length(vid) != 1) { - cli::cli_abort( - "{.arg vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_neighbors, - graph, - vid - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -is_directed_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_directed, - graph - ) - - res -} - -degree_impl <- function( - graph, - vids = V(graph), - mode = c("all", "out", "in", "total"), - loops = TRUE -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_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_degree, - graph, - vids - 1, - mode, - loops - ) - - res -} - -edge_impl <- function( - graph, - eid -) { - # Argument checks - ensure_igraph(graph) - eid <- as.numeric(eid) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_edge, - graph, - eid - ) - - res -} - -edges_impl <- function( - graph, - eids -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_edges, - graph, - eids - 1 - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -get_eid_impl <- function( - graph, - from, - to, - directed = TRUE, - error = TRUE -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (length(to) != 1) { - cli::cli_abort( - "{.arg to} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - directed <- as.logical(directed) - error <- as.logical(error) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_eid, - graph, - from - 1, - to - 1, - directed, - error - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -get_eids_impl <- function( - graph, - pairs, - directed = TRUE, - error = TRUE -) { - # Argument checks - ensure_igraph(graph) - pairs <- as_igraph_vs(graph, pairs) - directed <- as.logical(directed) - error <- as.logical(error) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_eids, - graph, - pairs - 1, - directed, - error - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -get_all_eids_between_impl <- function( - graph, - from, - to, - directed = TRUE -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (length(to) != 1) { - cli::cli_abort( - "{.arg to} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_all_eids_between, - graph, - from - 1, - to - 1, - directed - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -incident_impl <- function( - graph, - vid, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - vid <- as_igraph_vs(graph, vid) - if (length(vid) != 1) { - cli::cli_abort( - "{.arg vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_incident, - graph, - vid - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -is_same_graph_impl <- function( - graph1, - graph2 -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_same_graph, - graph1, - graph2 - ) - - res -} - -create_impl <- function( - edges, - n = 0, - directed = TRUE -) { - # Argument checks - edges <- as.numeric(edges) - n <- as.numeric(n) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_create, - edges, - n, - directed - ) - - res -} - -adjacency_impl <- function( - adjmatrix, - mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), - loops = c("once", "none", "twice") -) { - # Argument checks - adjmatrix[] <- as.numeric(adjmatrix) - mode <- switch_igraph_arg( - mode, - "directed" = 0L, - "undirected" = 1L, - "upper" = 2L, - "lower" = 3L, - "min" = 4L, - "plus" = 5L, - "max" = 6L - ) - loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_adjacency, - adjmatrix, - mode, - loops - ) - - res -} - -sparse_adjacency_impl <- function( - adjmatrix, - mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), - loops = c("once", "none", "twice") -) { - # Argument checks - requireNamespace("Matrix", quietly = TRUE) - adjmatrix <- as(as(as(adjmatrix, "dMatrix"), "generalMatrix"), "CsparseMatrix") - mode <- switch_igraph_arg( - mode, - "directed" = 0L, - "undirected" = 1L, - "upper" = 2L, - "lower" = 3L, - "min" = 4L, - "plus" = 5L, - "max" = 6L - ) - loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_sparse_adjacency, - adjmatrix, - mode, - loops - ) - - res -} - -sparse_weighted_adjacency_impl <- function( - adjmatrix, - mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), - loops = c("once", "none", "twice") -) { - # Argument checks - requireNamespace("Matrix", quietly = TRUE) - adjmatrix <- as(as(as(adjmatrix, "dMatrix"), "generalMatrix"), "CsparseMatrix") - mode <- switch_igraph_arg( - mode, - "directed" = 0L, - "undirected" = 1L, - "upper" = 2L, - "lower" = 3L, - "min" = 4L, - "plus" = 5L, - "max" = 6L - ) - loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_sparse_weighted_adjacency, - adjmatrix, - mode, - loops - ) - - res -} - -weighted_adjacency_impl <- function( - adjmatrix, - mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), - loops = c("once", "none", "twice") -) { - # Argument checks - adjmatrix[] <- as.numeric(adjmatrix) - mode <- switch_igraph_arg( - mode, - "directed" = 0L, - "undirected" = 1L, - "upper" = 2L, - "lower" = 3L, - "min" = 4L, - "plus" = 5L, - "max" = 6L - ) - loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_weighted_adjacency, - adjmatrix, - mode, - loops - ) - - res -} - -star_impl <- function( - n, - mode = c("out", "in", "undirected", "mutual"), - center = 0 -) { - # Argument checks - n <- as.numeric(n) - mode <- switch_igraph_arg( - mode, - "out" = 0L, - "in" = 1L, - "undirected" = 2L, - "mutual" = 3L - ) - center <- as.numeric(center) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_star, - n, - mode, - center - ) - - res -} - -wheel_impl <- function( - n, - mode = c("out", "in", "undirected", "mutual"), - center = 0 -) { - # Argument checks - n <- as.numeric(n) - mode <- switch_igraph_arg( - mode, - "out" = 0L, - "in" = 1L, - "undirected" = 2L, - "mutual" = 3L - ) - center <- as.numeric(center) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_wheel, - n, - mode, - center - ) - - res -} - -hypercube_impl <- function( - n, - directed = FALSE -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hypercube, - n, - directed - ) - - res -} - -square_lattice_impl <- function( - dimvector, - nei = 1, - directed = FALSE, - mutual = FALSE, - periodic = NULL -) { - # Argument checks - dimvector <- as.numeric(dimvector) - nei <- as.numeric(nei) - directed <- as.logical(directed) - mutual <- as.logical(mutual) - if (!is.null(periodic)) { - periodic <- as.logical(periodic) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_square_lattice, - dimvector, - nei, - directed, - mutual, - periodic - ) - - res -} - -triangular_lattice_impl <- function( - dimvector, - directed = FALSE, - mutual = FALSE -) { - # Argument checks - dimvector <- as.numeric(dimvector) - directed <- as.logical(directed) - mutual <- as.logical(mutual) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_triangular_lattice, - dimvector, - directed, - mutual - ) - - res -} - -ring_impl <- function( - n, - directed = FALSE, - mutual = FALSE, - circular = TRUE -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - mutual <- as.logical(mutual) - circular <- as.logical(circular) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_ring, - n, - directed, - mutual, - circular - ) - - res -} - -path_graph_impl <- function( - n, - directed = FALSE, - mutual = FALSE -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - mutual <- as.logical(mutual) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_path_graph, - n, - directed, - mutual - ) - - res -} - -cycle_graph_impl <- function( - n, - directed = FALSE, - mutual = FALSE -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - mutual <- as.logical(mutual) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_cycle_graph, - n, - directed, - mutual - ) - - res -} - -kary_tree_impl <- function( - n, - children = 2, - type = c("out", "in", "undirected") -) { - # Argument checks - n <- as.numeric(n) - children <- as.numeric(children) - type <- switch_igraph_arg(type, "out" = 0L, "in" = 1L, "undirected" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_kary_tree, - n, - children, - type - ) - - res -} - -symmetric_tree_impl <- function( - branches, - type = c("out", "in", "undirected") -) { - # Argument checks - branches <- as.numeric(branches) - type <- switch_igraph_arg(type, "out" = 0L, "in" = 1L, "undirected" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_symmetric_tree, - branches, - type - ) - - res -} - -regular_tree_impl <- function( - h, - k = 3, - type = c("undirected", "out", "in") -) { - # Argument checks - h <- as.numeric(h) - k <- as.numeric(k) - type <- switch_igraph_arg(type, "out" = 0L, "in" = 1L, "undirected" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_regular_tree, - h, - k, - type - ) - - res -} - -full_impl <- function( - n, - directed = FALSE, - loops = FALSE -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_full, - n, - directed, - loops - ) - - res -} - -full_citation_impl <- function( - n, - directed = TRUE -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_full_citation, - n, - directed - ) - - res -} - -atlas_impl <- function( - number = 0 -) { - # Argument checks - number <- as.numeric(number) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_atlas, - number - ) - - res -} - -extended_chordal_ring_impl <- function( - nodes, - W, - directed = FALSE -) { - # Argument checks - nodes <- as.numeric(nodes) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_extended_chordal_ring, - nodes, - W, - directed - ) - - res -} - -connect_neighborhood_impl <- function( - graph, - order = 2, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - order <- as.numeric(order) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_connect_neighborhood, - graph, - order, - mode - ) - - res -} - -graph_power_impl <- function( - graph, - order, - directed = FALSE -) { - # Argument checks - ensure_igraph(graph) - order <- as.numeric(order) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_graph_power, - graph, - order, - directed - ) - - res -} - -linegraph_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_linegraph, - graph - ) - - res -} - -de_bruijn_impl <- function( - m, - n -) { - # Argument checks - m <- as.numeric(m) - n <- as.numeric(n) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_de_bruijn, - m, - n - ) - - res -} - -kautz_impl <- function( - m, - n -) { - # Argument checks - m <- as.numeric(m) - n <- as.numeric(n) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_kautz, - m, - n - ) - - res -} - -famous_impl <- function( - name -) { - # Argument checks - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_famous, - name - ) - - res -} - -lcf_vector_impl <- function( - n, - shifts, - repeats = 1 -) { - # Argument checks - n <- as.numeric(n) - shifts <- as.numeric(shifts) - repeats <- as.numeric(repeats) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_lcf_vector, - n, - shifts, - repeats - ) - - if (igraph_opt("add.params")) { - res$name <- 'LCF graph' - } - - res -} - -mycielski_graph_impl <- function( - k -) { - # Argument checks - k <- as.numeric(k) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_mycielski_graph, - k - ) - - res -} - -adjlist_impl <- function( - adjlist, - mode = c("out", "in", "all", "total"), - duplicate = TRUE -) { - # Argument checks - adjlist <- lapply(adjlist, function(x) as.numeric(x) - 1) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - duplicate <- as.logical(duplicate) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_adjlist, - adjlist, - mode, - duplicate - ) - - res -} - -full_bipartite_impl <- function( - n1, - n2, - directed = FALSE, - mode = c("all", "out", "in", "total") -) { - # Argument checks - n1 <- as.numeric(n1) - n2 <- as.numeric(n2) - directed <- as.logical(directed) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_full_bipartite, - n1, - n2, - directed, - mode - ) - if (igraph_opt("add.vertex.names") && is_named(res$graph)) { - names(res$types) <- vertex_attr(res$graph, "name") - } - res -} - -full_multipartite_impl <- function( - n, - directed = FALSE, - mode = c("all", "out", "in", "total") -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_full_multipartite, - n, - directed, - mode - ) - - if (igraph_opt("add.params")) { - res$name <- 'Full multipartite graph' - res$n <- n - res$mode <- mode - } - - res -} - -realize_degree_sequence_impl <- function( - out_deg, - in_deg = NULL, - allowed_edge_types = c("simple", "loops", "multi", "all"), - method = c("smallest", "largest", "index") -) { - # Argument checks - out_deg <- as.numeric(out_deg) - if (!is.null(in_deg)) { - in_deg <- as.numeric(in_deg) - } - allowed_edge_types <- switch_igraph_arg( - allowed_edge_types, - "simple" = 0L, - "loop" = 1L, - "loops" = 1L, - "multi" = 6L, - "multiple" = 6L, - "all" = 7L - ) - method <- switch_igraph_arg(method, "smallest" = 0L, "largest" = 1L, "index" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_realize_degree_sequence, - out_deg, - in_deg, - allowed_edge_types, - method - ) - - if (igraph_opt("add.params")) { - res$name <- 'Graph from degree sequence' - res$out_deg <- out_deg - res$in_deg <- in_deg - res$allowed_edge_types <- allowed_edge_types - res$method <- method - } - - res -} - -realize_bipartite_degree_sequence_impl <- function( - degrees1, - degrees2, - allowed_edge_types = c("simple", "loops", "multi", "all"), - method = c("smallest", "largest", "index") -) { - # Argument checks - degrees1 <- as.numeric(degrees1) - degrees2 <- as.numeric(degrees2) - allowed_edge_types <- switch_igraph_arg( - allowed_edge_types, - "simple" = 0L, - "loop" = 1L, - "loops" = 1L, - "multi" = 6L, - "multiple" = 6L, - "all" = 7L - ) - method <- switch_igraph_arg(method, "smallest" = 0L, "largest" = 1L, "index" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_realize_bipartite_degree_sequence, - degrees1, - degrees2, - allowed_edge_types, - method - ) - - if (igraph_opt("add.params")) { - res$name <- 'Bipartite graph from degree sequence' - res$degrees1 <- degrees1 - res$degrees2 <- degrees2 - res$allowed_edge_types <- allowed_edge_types - res$method <- method - } - - res -} - -circulant_impl <- function( - n, - shifts, - directed = FALSE -) { - # Argument checks - n <- as.numeric(n) - shifts <- as.numeric(shifts) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_circulant, - n, - shifts, - directed - ) - - if (igraph_opt("add.params")) { - res$name <- 'Circulant graph' - res$shifts <- shifts - } - - res -} - -generalized_petersen_impl <- function( - n, - k -) { - # Argument checks - n <- as.numeric(n) - k <- as.numeric(k) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_generalized_petersen, - n, - k - ) - - res -} - -turan_impl <- function( - n, - r -) { - # Argument checks - n <- as.numeric(n) - r <- as.numeric(r) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_turan, - n, - r - ) - - if (igraph_opt("add.params")) { - res$name <- 'Turan graph' - res$n <- n - res$r <- r - } - - res -} - -weighted_sparsemat_impl <- function( - A, - directed, - attr, - loops = FALSE -) { - # Argument checks - requireNamespace("Matrix", quietly = TRUE) - A <- as(as(as(A, "dMatrix"), "generalMatrix"), "CsparseMatrix") - directed <- as.logical(directed) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_weighted_sparsemat, - A, - directed, - attr, - loops - ) - - res -} - -barabasi_game_impl <- function( - n, - power = 1.0, - m = 1, - outseq = NULL, - outpref = FALSE, - A = 1.0, - directed = TRUE, - algo = c("bag", "psumtree", "psumtree_multiple"), - start_from = NULL -) { - # Argument checks - n <- as.numeric(n) - power <- as.numeric(power) - m <- as.numeric(m) - if (!is.null(outseq)) { - outseq <- as.numeric(outseq) - } - outpref <- as.logical(outpref) - A <- as.numeric(A) - directed <- as.logical(directed) - algo <- switch_igraph_arg(algo, "bag" = 0L, "psumtree" = 1L, "psumtree_multiple" = 2L) - if (!is.null(start_from)) { - ensure_igraph(start_from) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_barabasi_game, - n, - power, - m, - outseq, - outpref, - A, - directed, - algo, - start_from - ) - - res -} - -erdos_renyi_game_gnp_impl <- function( - n, - p, - directed = FALSE, - loops = FALSE -) { - # Argument checks - n <- as.numeric(n) - p <- as.numeric(p) - directed <- as.logical(directed) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_erdos_renyi_game_gnp, - n, - p, - directed, - loops - ) - - res -} - -erdos_renyi_game_gnm_impl <- function( - n, - m, - directed = FALSE, - loops = FALSE -) { - # Argument checks - n <- as.numeric(n) - m <- as.numeric(m) - directed <- as.logical(directed) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_erdos_renyi_game_gnm, - n, - m, - directed, - loops - ) - - res -} - -degree_sequence_game_impl <- function( - out_deg, - in_deg = NULL, - method = c("configuration", "fast_heur_simple", "configuration_simple", "edge_switching_simple", "vl") -) { - # Argument checks - out_deg <- as.numeric(out_deg) - if (!is.null(in_deg)) { - in_deg <- as.numeric(in_deg) - } - method <- switch_igraph_arg( - method, - "configuration" = 0L, - "vl" = 1L, - "fast_heur_simple" = 2L, - "configuration_simple" = 3L, - "edge_switching_simple" = 4L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_degree_sequence_game, - out_deg, - in_deg, - method - ) - - res -} - -growing_random_game_impl <- function( - n, - m = 1, - ..., - directed = TRUE, - citation = FALSE -) { - # Argument checks - check_dots_empty() - n <- as.numeric(n) - m <- as.numeric(m) - directed <- as.logical(directed) - citation <- as.logical(citation) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_growing_random_game, - n, - m, - directed, - citation - ) - - if (igraph_opt("add.params")) { - res$name <- 'Growing random graph' - res$m <- m - res$citation <- citation - } - - res -} - -barabasi_aging_game_impl <- function( - nodes, - m = 1, - outseq = NULL, - outpref = FALSE, - pa_exp = 1.0, - aging_exp = 0.0, - aging_bin = 1, - zero_deg_appeal = 1.0, - zero_age_appeal = 0.0, - deg_coef = 1.0, - age_coef = 1.0, - directed = TRUE -) { - # Argument checks - nodes <- as.numeric(nodes) - m <- as.numeric(m) - if (!is.null(outseq)) { - outseq <- as.numeric(outseq) - } - outpref <- as.logical(outpref) - pa_exp <- as.numeric(pa_exp) - aging_exp <- as.numeric(aging_exp) - aging_bin <- as.numeric(aging_bin) - zero_deg_appeal <- as.numeric(zero_deg_appeal) - zero_age_appeal <- as.numeric(zero_age_appeal) - deg_coef <- as.numeric(deg_coef) - age_coef <- as.numeric(age_coef) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_barabasi_aging_game, - nodes, - m, - outseq, - outpref, - pa_exp, - aging_exp, - aging_bin, - zero_deg_appeal, - zero_age_appeal, - deg_coef, - age_coef, - directed - ) - - res -} - -recent_degree_game_impl <- function( - n, - power = 1.0, - window = 1, - m = 1, - outseq = NULL, - outpref = FALSE, - zero_appeal = 1.0, - directed = TRUE -) { - # Argument checks - n <- as.numeric(n) - power <- as.numeric(power) - window <- as.numeric(window) - m <- as.numeric(m) - if (!is.null(outseq)) { - outseq <- as.numeric(outseq) - } - outpref <- as.logical(outpref) - zero_appeal <- as.numeric(zero_appeal) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_recent_degree_game, - n, - power, - window, - m, - outseq, - outpref, - zero_appeal, - directed - ) - - res -} - -recent_degree_aging_game_impl <- function( - nodes, - m = 1, - outseq = NULL, - outpref = FALSE, - pa_exp = 1.0, - aging_exp = 0.0, - aging_bin = 1, - window = 1, - zero_appeal = 1.0, - directed = TRUE -) { - # Argument checks - nodes <- as.numeric(nodes) - m <- as.numeric(m) - if (!is.null(outseq)) { - outseq <- as.numeric(outseq) - } - outpref <- as.logical(outpref) - pa_exp <- as.numeric(pa_exp) - aging_exp <- as.numeric(aging_exp) - aging_bin <- as.numeric(aging_bin) - window <- as.numeric(window) - zero_appeal <- as.numeric(zero_appeal) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_recent_degree_aging_game, - nodes, - m, - outseq, - outpref, - pa_exp, - aging_exp, - aging_bin, - window, - zero_appeal, - directed - ) - - res -} - -callaway_traits_game_impl <- function( - nodes, - types, - edges_per_step = 1, - type_dist, - pref_matrix, - directed = FALSE -) { - # Argument checks - nodes <- as.numeric(nodes) - types <- as.numeric(types) - edges_per_step <- as.numeric(edges_per_step) - type_dist <- as.numeric(type_dist) - pref_matrix[] <- as.numeric(pref_matrix) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_callaway_traits_game, - nodes, - types, - edges_per_step, - type_dist, - pref_matrix, - directed - ) - - res -} - -establishment_game_impl <- function( - nodes, - types, - k = 1, - type_dist, - pref_matrix, - directed = TRUE -) { - # Argument checks - nodes <- as.numeric(nodes) - types <- as.numeric(types) - k <- as.numeric(k) - type_dist <- as.numeric(type_dist) - pref_matrix[] <- as.numeric(pref_matrix) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_establishment_game, - nodes, - types, - k, - type_dist, - pref_matrix, - directed - ) - - res -} - -grg_game_impl <- function( - nodes, - radius, - torus = FALSE -) { - # Argument checks - nodes <- as.numeric(nodes) - radius <- as.numeric(radius) - torus <- as.logical(torus) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_grg_game, - nodes, - radius, - torus - ) - - res -} - -preference_game_impl <- function( - nodes, - types, - type_dist, - fixed_sizes = FALSE, - pref_matrix, - directed = FALSE, - loops = FALSE -) { - # Argument checks - nodes <- as.numeric(nodes) - types <- as.numeric(types) - type_dist <- as.numeric(type_dist) - fixed_sizes <- as.logical(fixed_sizes) - pref_matrix[] <- as.numeric(pref_matrix) - directed <- as.logical(directed) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_preference_game, - nodes, - types, - type_dist, - fixed_sizes, - pref_matrix, - directed, - loops - ) - - res -} - -asymmetric_preference_game_impl <- function( - nodes, - out_types, - in_types, - type_dist_matrix, - pref_matrix, - loops = FALSE -) { - # Argument checks - nodes <- as.numeric(nodes) - out_types <- as.numeric(out_types) - in_types <- as.numeric(in_types) - type_dist_matrix[] <- as.numeric(type_dist_matrix) - pref_matrix[] <- as.numeric(pref_matrix) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_asymmetric_preference_game, - nodes, - out_types, - in_types, - type_dist_matrix, - pref_matrix, - loops - ) - - res -} - -rewire_edges_impl <- function( - graph, - prob, - loops = FALSE, - multiple = FALSE -) { - # Argument checks - ensure_igraph(graph) - prob <- as.numeric(prob) - loops <- as.logical(loops) - multiple <- as.logical(multiple) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_rewire_edges, - graph, - prob, - loops, - multiple - ) - - res -} - -rewire_directed_edges_impl <- function( - graph, - prob, - loops = FALSE, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - prob <- as.numeric(prob) - loops <- as.logical(loops) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_rewire_directed_edges, - graph, - prob, - loops, - mode - ) - - res -} - -watts_strogatz_game_impl <- function( - dim, - size, - nei, - p, - loops = FALSE, - multiple = FALSE -) { - # Argument checks - dim <- as.numeric(dim) - size <- as.numeric(size) - nei <- as.numeric(nei) - p <- as.numeric(p) - loops <- as.logical(loops) - multiple <- as.logical(multiple) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_watts_strogatz_game, - dim, - size, - nei, - p, - loops, - multiple - ) - - res -} - -lastcit_game_impl <- function( - nodes, - edges_per_node = 1, - agebins = 1, - preference, - directed = TRUE -) { - # Argument checks - nodes <- as.numeric(nodes) - edges_per_node <- as.numeric(edges_per_node) - agebins <- as.numeric(agebins) - preference <- as.numeric(preference) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_lastcit_game, - nodes, - edges_per_node, - agebins, - preference, - directed - ) - - res -} - -cited_type_game_impl <- function( - nodes, - types, - pref, - edges_per_step = 1, - directed = TRUE -) { - # Argument checks - nodes <- as.numeric(nodes) - types <- as.numeric(types) - 1 - pref <- as.numeric(pref) - edges_per_step <- as.numeric(edges_per_step) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_cited_type_game, - nodes, - types, - pref, - edges_per_step, - directed - ) - - res -} - -citing_cited_type_game_impl <- function( - nodes, - types, - pref, - edges_per_step = 1, - directed = TRUE -) { - # Argument checks - nodes <- as.numeric(nodes) - types <- as.numeric(types) - 1 - pref[] <- as.numeric(pref) - edges_per_step <- as.numeric(edges_per_step) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_citing_cited_type_game, - nodes, - types, - pref, - edges_per_step, - directed - ) - - res -} - -forest_fire_game_impl <- function( - nodes, - fw_prob, - bw_factor = 1, - ambs = 1, - directed = TRUE -) { - # Argument checks - nodes <- as.numeric(nodes) - fw_prob <- as.numeric(fw_prob) - bw_factor <- as.numeric(bw_factor) - ambs <- as.numeric(ambs) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_forest_fire_game, - nodes, - fw_prob, - bw_factor, - ambs, - directed - ) - - if (igraph_opt("add.params")) { - res$name <- 'Forest fire model' - res$fw_prob <- fw_prob - res$bw_factor <- bw_factor - res$ambs <- ambs - } - - res -} - -simple_interconnected_islands_game_impl <- function( - islands_n, - islands_size, - islands_pin, - n_inter -) { - # Argument checks - islands_n <- as.numeric(islands_n) - islands_size <- as.numeric(islands_size) - islands_pin <- as.numeric(islands_pin) - n_inter <- as.numeric(n_inter) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_simple_interconnected_islands_game, - islands_n, - islands_size, - islands_pin, - n_inter - ) - - if (igraph_opt("add.params")) { - res$name <- 'Interconnected islands model' - res$islands_n <- islands_n - res$islands_size <- islands_size - res$islands_pin <- islands_pin - res$n_inter <- n_inter - } - - res -} - -chung_lu_game_impl <- function( - out_weights, - in_weights = NULL, - ..., - loops = TRUE, - variant = c("original", "maxent", "nr") -) { - # Argument checks - check_dots_empty() - out_weights <- as.numeric(out_weights) - if (!is.null(in_weights)) { - in_weights <- as.numeric(in_weights) - } - loops <- as.logical(loops) - variant <- switch_igraph_arg(variant, "original" = 0L, "maxent" = 1L, "nr" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_chung_lu_game, - out_weights, - in_weights, - loops, - variant - ) - - if (igraph_opt("add.params")) { - res$name <- 'Chung-Lu model' - res$variant <- variant - } - - res -} - -static_fitness_game_impl <- function( - no_of_edges, - fitness_out, - fitness_in = NULL, - loops = FALSE, - multiple = FALSE -) { - # Argument checks - no_of_edges <- as.numeric(no_of_edges) - fitness_out <- as.numeric(fitness_out) - if (!is.null(fitness_in)) { - fitness_in <- as.numeric(fitness_in) - } - loops <- as.logical(loops) - multiple <- as.logical(multiple) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_static_fitness_game, - no_of_edges, - fitness_out, - fitness_in, - loops, - multiple - ) - - if (igraph_opt("add.params")) { - res$name <- 'Static fitness model' - res$loops <- loops - res$multiple <- multiple - } - - res -} - -static_power_law_game_impl <- function( - no_of_nodes, - no_of_edges, - exponent_out, - exponent_in = -1, - loops = FALSE, - multiple = FALSE, - finite_size_correction = TRUE -) { - # Argument checks - no_of_nodes <- as.numeric(no_of_nodes) - no_of_edges <- as.numeric(no_of_edges) - exponent_out <- as.numeric(exponent_out) - exponent_in <- as.numeric(exponent_in) - loops <- as.logical(loops) - multiple <- as.logical(multiple) - finite_size_correction <- as.logical(finite_size_correction) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_static_power_law_game, - no_of_nodes, - no_of_edges, - exponent_out, - exponent_in, - loops, - multiple, - finite_size_correction - ) - - if (igraph_opt("add.params")) { - res$name <- 'Static power law model' - res$exponent_out <- exponent_out - res$exponent_in <- exponent_in - res$loops <- loops - res$multiple <- multiple - res$finite_size_correction <- finite_size_correction - } - - res -} - -k_regular_game_impl <- function( - no_of_nodes, - k, - directed = FALSE, - multiple = FALSE -) { - # Argument checks - no_of_nodes <- as.numeric(no_of_nodes) - k <- as.numeric(k) - directed <- as.logical(directed) - multiple <- as.logical(multiple) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_k_regular_game, - no_of_nodes, - k, - directed, - multiple - ) - - if (igraph_opt("add.params")) { - res$name <- 'k-regular graph' - res$k <- k - } - - res -} - -sbm_game_impl <- function( - n, - pref_matrix, - block_sizes, - directed = FALSE, - loops = FALSE -) { - # Argument checks - n <- as.numeric(n) - pref_matrix[] <- as.numeric(pref_matrix) - block_sizes <- as.numeric(block_sizes) - directed <- as.logical(directed) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_sbm_game, - n, - pref_matrix, - block_sizes, - directed, - loops - ) - - if (igraph_opt("add.params")) { - res$name <- 'Stochastic block model' - res$loops <- loops - } - - res -} - -hsbm_game_impl <- function( - n, - m, - rho, - C, - p -) { - # Argument checks - n <- as.numeric(n) - m <- as.numeric(m) - rho <- as.numeric(rho) - C[] <- as.numeric(C) - p <- as.numeric(p) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hsbm_game, - n, - m, - rho, - C, - p - ) - - if (igraph_opt("add.params")) { - res$name <- 'Hierarchical stochastic block model' - res$m <- m - res$rho <- rho - res$C <- C - res$p <- p - } - - res -} - -hsbm_list_game_impl <- function( - n, - mlist, - rholist, - Clist, - p -) { - # Argument checks - n <- as.numeric(n) - mlist <- as.numeric(mlist) - if (!is.list(Clist)) { - cli::cli_abort("{.arg Clist} must be a list of matrices") - } - Clist <- lapply(Clist, function(m) { - if (!is.matrix(m)) { - cli::cli_abort("{.arg Clist} must be a list of matrices") - } - m[] <- as.numeric(m) - m - }) - p <- as.numeric(p) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hsbm_list_game, - n, - mlist, - rholist, - Clist, - p - ) - - if (igraph_opt("add.params")) { - res$name <- 'Hierarchical stochastic block model' - res$p <- p - } - - res -} - -correlated_game_impl <- function( - old_graph, - corr, - p = edge_density(old_graph), - permutation = NULL -) { - # Argument checks - ensure_igraph(old_graph) - corr <- as.numeric(corr) - p <- as.numeric(p) - if (!is.null(permutation)) { - permutation <- as.numeric(permutation) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_correlated_game, - old_graph, - corr, - p, - permutation - ) - - if (igraph_opt("add.params")) { - res$name <- 'Correlated random graph' - res$corr <- corr - res$p <- p - } - - res -} - -correlated_pair_game_impl <- function( - n, - corr, - p, - directed = FALSE, - permutation = NULL -) { - # Argument checks - n <- as.numeric(n) - corr <- as.numeric(corr) - p <- as.numeric(p) - directed <- as.logical(directed) - if (!is.null(permutation)) { - permutation <- as.numeric(permutation) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_correlated_pair_game, - n, - corr, - p, - directed, - permutation - ) - - res -} - -dot_product_game_impl <- function( - vecs, - directed = FALSE -) { - # Argument checks - vecs[] <- as.numeric(vecs) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_dot_product_game, - vecs, - directed - ) - - res -} - -sample_sphere_surface_impl <- function( - dim, - n = 1, - radius = 1, - positive = TRUE -) { - # Argument checks - dim <- as.numeric(dim) - n <- as.numeric(n) - radius <- as.numeric(radius) - positive <- as.logical(positive) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_sample_sphere_surface, - dim, - n, - radius, - positive - ) - - res -} - -sample_sphere_volume_impl <- function( - dim, - n = 1, - radius = 1, - positive = TRUE -) { - # Argument checks - dim <- as.numeric(dim) - n <- as.numeric(n) - radius <- as.numeric(radius) - positive <- as.logical(positive) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_sample_sphere_volume, - dim, - n, - radius, - positive - ) - - res -} - -sample_dirichlet_impl <- function( - n, - alpha -) { - # Argument checks - n <- as.numeric(n) - alpha <- as.numeric(alpha) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_sample_dirichlet, - n, - alpha - ) - - res -} - -are_adjacent_impl <- function( - graph, - v1, - v2 -) { - # Argument checks - ensure_igraph(graph) - v1 <- as_igraph_vs(graph, v1) - if (length(v1) != 1) { - cli::cli_abort( - "{.arg v1} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - v2 <- as_igraph_vs(graph, v2) - if (length(v2) != 1) { - cli::cli_abort( - "{.arg v2} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_are_adjacent, - graph, - v1 - 1, - v2 - 1 - ) - - res -} - -are_connected_impl <- function( - graph, - v1, - v2 -) { - # Argument checks - ensure_igraph(graph) - v1 <- as_igraph_vs(graph, v1) - if (length(v1) != 1) { - cli::cli_abort( - "{.arg v1} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - v2 <- as_igraph_vs(graph, v2) - if (length(v2) != 1) { - cli::cli_abort( - "{.arg v2} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_are_connected, - graph, - v1 - 1, - v2 - 1 - ) - - res -} - -diameter_impl <- function( - graph, - directed = TRUE, - unconnected = TRUE -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - unconnected <- as.logical(unconnected) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_diameter, - graph, - directed, - unconnected - ) - - res -} - -diameter_dijkstra_impl <- function( - graph, - weights = NULL, - directed = TRUE, - unconnected = TRUE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - directed <- as.logical(directed) - unconnected <- as.logical(unconnected) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_diameter_dijkstra, - graph, - weights, - directed, - unconnected - ) - - res -} - -closeness_impl <- function( - graph, - vids = V(graph), - mode = c("out", "in", "all", "total"), - weights = NULL, - normalized = FALSE -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_closeness, - graph, - vids - 1, - mode, - weights, - normalized - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$res) <- vertex_attr(graph, "name", vids) - } - res -} - -closeness_cutoff_impl <- function( - graph, - vids = V(graph), - mode = c("out", "in", "all", "total"), - weights = NULL, - normalized = FALSE, - cutoff = -1 -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - normalized <- as.logical(normalized) - cutoff <- as.numeric(cutoff) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_closeness_cutoff, - graph, - vids - 1, - mode, - weights, - normalized, - cutoff - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$res) <- vertex_attr(graph, "name", vids) - } - res -} - -distances_impl <- function( - graph, - from = V(graph), - to = V(graph), - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_distances, - graph, - from - 1, - to - 1, - mode - ) - - res -} - -distances_cutoff_impl <- function( - graph, - from = V(graph), - to = V(graph), - mode = c("out", "in", "all", "total"), - cutoff = -1 -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - cutoff <- as.numeric(cutoff) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_distances_cutoff, - graph, - from - 1, - to - 1, - mode, - cutoff - ) - - res -} - -get_shortest_path_impl <- function( - graph, - from, - to, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (length(to) != 1) { - cli::cli_abort( - "{.arg to} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_shortest_path, - graph, - from - 1, - to - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- create_vs(graph, res$vertices) - } - if (igraph_opt("return.vs.es")) { - res$edges <- create_es(graph, res$edges) - } - res -} - -get_shortest_path_bellman_ford_impl <- function( - graph, - from, - to, - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (length(to) != 1) { - cli::cli_abort( - "{.arg to} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_shortest_path_bellman_ford, - graph, - from - 1, - to - 1, - weights, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- create_vs(graph, res$vertices) - } - if (igraph_opt("return.vs.es")) { - res$edges <- create_es(graph, res$edges) - } - res -} - -get_shortest_path_dijkstra_impl <- function( - graph, - from, - to, - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (length(to) != 1) { - cli::cli_abort( - "{.arg to} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_shortest_path_dijkstra, - graph, - from - 1, - to - 1, - weights, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- create_vs(graph, res$vertices) - } - if (igraph_opt("return.vs.es")) { - res$edges <- create_es(graph, res$edges) - } - res -} - -get_shortest_path_astar_impl <- function( - graph, - from, - to, - weights = NULL, - mode = c("out", "in", "all", "total"), - heuristic = NULL -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (length(to) != 1) { - cli::cli_abort( - "{.arg to} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_shortest_path_astar, - graph, - from - 1, - to - 1, - weights, - mode, - heuristic - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- create_vs(graph, res$vertices) - } - if (igraph_opt("return.vs.es")) { - res$edges <- create_es(graph, res$edges) - } - res -} - -get_shortest_paths_impl <- function( - graph, - from, - to = V(graph), - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_shortest_paths, - graph, - from - 1, - to - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -get_all_shortest_paths_impl <- function( - graph, - from, - to, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_all_shortest_paths, - graph, - from - 1, - to - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vpaths <- lapply(res$vpaths, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$epaths <- lapply(res$epaths, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -distances_dijkstra_impl <- function( - graph, - from = V(graph), - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_distances_dijkstra, - graph, - from - 1, - to - 1, - weights, - mode - ) - - res -} - -distances_dijkstra_cutoff_impl <- function( - graph, - from = V(graph), - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total"), - cutoff = -1 -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - cutoff <- as.numeric(cutoff) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_distances_dijkstra_cutoff, - graph, - from - 1, - to - 1, - weights, - mode, - cutoff - ) - - res -} - -get_shortest_paths_dijkstra_impl <- function( - graph, - from, - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_shortest_paths_dijkstra, - graph, - from - 1, - to - 1, - weights, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -get_shortest_paths_bellman_ford_impl <- function( - graph, - from, - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_shortest_paths_bellman_ford, - graph, - from - 1, - to - 1, - weights, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -get_all_shortest_paths_dijkstra_impl <- function( - graph, - from, - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_all_shortest_paths_dijkstra, - graph, - from - 1, - to - 1, - weights, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vpaths <- lapply(res$vpaths, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$epaths <- lapply(res$epaths, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -distances_bellman_ford_impl <- function( - graph, - from = V(graph), - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_distances_bellman_ford, - graph, - from - 1, - to - 1, - weights, - mode - ) - - res -} - -distances_johnson_impl <- function( - graph, - from = V(graph), - to = V(graph), - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_distances_johnson, - graph, - from - 1, - to - 1, - weights - ) - - res -} - -distances_floyd_warshall_impl <- function( - graph, - from = V(graph), - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total"), - method = c("automatic", "original", "tree") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - method <- switch_igraph_arg(method, "automatic" = 0L, "original" = 1L, "tree" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_distances_floyd_warshall, - graph, - from - 1, - to - 1, - weights, - mode, - method - ) - - res -} - -voronoi_impl <- function( - graph, - generators, - ..., - weights = NULL, - mode = c("out", "in", "all", "total"), - tiebreaker = c("random", "first", "last") -) { - # Argument checks - check_dots_empty() - ensure_igraph(graph) - generators <- as_igraph_vs(graph, generators) - generators <- generators - 1 - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - tiebreaker <- switch_igraph_arg(tiebreaker, "first" = 0L, "last" = 1L, "random" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_voronoi, - graph, - generators, - weights, - mode, - tiebreaker - ) - - res -} - -get_all_simple_paths_impl <- function( - graph, - from, - to = V(graph), - cutoff = -1, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - cutoff <- as.numeric(cutoff) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_all_simple_paths, - graph, - from - 1, - to - 1, - cutoff, - mode - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -get_k_shortest_paths_impl <- function( - graph, - from, - to, - ..., - k, - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - check_dots_empty() - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - k <- as.numeric(k) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (length(to) != 1) { - cli::cli_abort( - "{.arg to} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_k_shortest_paths, - graph, - weights, - k, - from - 1, - to - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vpaths <- lapply(res$vpaths, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$epaths <- lapply(res$epaths, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -get_widest_path_impl <- function( - graph, - from, - to, - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (length(to) != 1) { - cli::cli_abort( - "{.arg to} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_widest_path, - graph, - from - 1, - to - 1, - weights, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- create_vs(graph, res$vertices) - } - if (igraph_opt("return.vs.es")) { - res$edges <- create_es(graph, res$edges) - } - res -} - -get_widest_paths_impl <- function( - graph, - from, - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - if (length(from) != 1) { - cli::cli_abort( - "{.arg from} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_widest_paths, - graph, - from - 1, - to - 1, - weights, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -widest_path_widths_dijkstra_impl <- function( - graph, - from = V(graph), - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_widest_path_widths_dijkstra, - graph, - from - 1, - to - 1, - weights, - mode - ) - - res -} - -widest_path_widths_floyd_warshall_impl <- function( - graph, - from = V(graph), - to = V(graph), - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - from <- as_igraph_vs(graph, from) - to <- as_igraph_vs(graph, to) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_widest_path_widths_floyd_warshall, - graph, - from - 1, - to - 1, - weights, - mode - ) - - res -} - -spanner_impl <- function( - graph, - stretch, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - stretch <- as.numeric(stretch) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_spanner, - graph, - stretch, - weights - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -subcomponent_impl <- function( - graph, - vid, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - vid <- as_igraph_vs(graph, vid) - if (length(vid) != 1) { - cli::cli_abort( - "{.arg vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_subcomponent, - graph, - vid - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -betweenness_impl <- function( - graph, - vids = V(graph), - directed = TRUE, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - directed <- as.logical(directed) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_betweenness, - graph, - vids - 1, - directed, - weights - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -betweenness_cutoff_impl <- function( - graph, - vids = V(graph), - directed = TRUE, - weights = NULL, - cutoff = -1 -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - directed <- as.logical(directed) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - cutoff <- as.numeric(cutoff) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_betweenness_cutoff, - graph, - vids - 1, - directed, - weights, - cutoff - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -betweenness_subset_impl <- function( - graph, - vids = V(graph), - directed = TRUE, - sources = V(graph), - targets = V(graph), - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - directed <- as.logical(directed) - sources <- as_igraph_vs(graph, sources) - targets <- as_igraph_vs(graph, targets) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_betweenness_subset, - graph, - vids - 1, - directed, - sources - 1, - targets - 1, - weights - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -edge_betweenness_impl <- function( - graph, - directed = TRUE, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_edge_betweenness, - graph, - directed, - weights - ) - - res -} - -edge_betweenness_cutoff_impl <- function( - graph, - directed = TRUE, - weights = NULL, - cutoff = -1 -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - cutoff <- as.numeric(cutoff) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_edge_betweenness_cutoff, - graph, - directed, - weights, - cutoff - ) - - res -} - -edge_betweenness_subset_impl <- function( - graph, - eids = E(graph), - directed = TRUE, - sources = V(graph), - targets = V(graph), - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - directed <- as.logical(directed) - sources <- as_igraph_vs(graph, sources) - targets <- as_igraph_vs(graph, targets) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_edge_betweenness_subset, - graph, - eids - 1, - directed, - sources - 1, - targets - 1, - weights - ) - - res -} - -harmonic_centrality_impl <- function( - graph, - vids = V(graph), - mode = c("out", "in", "all", "total"), - weights = NULL, - normalized = FALSE -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_harmonic_centrality, - graph, - vids - 1, - mode, - weights, - normalized - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -harmonic_centrality_cutoff_impl <- function( - graph, - vids = V(graph), - mode = c("out", "in", "all", "total"), - weights = NULL, - normalized = FALSE, - cutoff = -1 -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - normalized <- as.logical(normalized) - cutoff <- as.numeric(cutoff) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_harmonic_centrality_cutoff, - graph, - vids - 1, - mode, - weights, - normalized, - cutoff - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -pagerank_impl <- function( - graph, - algo = c("prpack", "arpack"), - vids = V(graph), - directed = TRUE, - damping = 0.85, - weights = NULL, - options = NULL -) { - # Argument checks - ensure_igraph(graph) - algo <- switch_igraph_arg(algo, "arpack" = 1L, "prpack" = 2L) - vids <- as_igraph_vs(graph, vids) - directed <- as.logical(directed) - damping <- as.numeric(damping) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (is.null(options)) { - if (algo == 0L) { - options <- list(niter = 1000, eps = 0.001) - } else if (algo == 1L) { - options <- arpack_defaults() - } else { - options <- NULL - } - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_pagerank, - graph, - algo, - vids - 1, - directed, - damping, - weights, - options - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$vector) <- vertex_attr(graph, "name", vids) - } - res -} - -personalized_pagerank_impl <- function( - graph, - algo = c("prpack", "arpack"), - vids = V(graph), - directed = TRUE, - damping = 0.85, - personalized = NULL, - weights = NULL, - options = NULL -) { - # Argument checks - ensure_igraph(graph) - algo <- switch_igraph_arg(algo, "arpack" = 1L, "prpack" = 2L) - vids <- as_igraph_vs(graph, vids) - directed <- as.logical(directed) - damping <- as.numeric(damping) - if (!is.null(personalized)) { - personalized <- as.numeric(personalized) - } - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (is.null(options)) { - if (algo == 0L) { - options <- list(niter = 1000, eps = 0.001) - } else if (algo == 1L) { - options <- arpack_defaults() - } else { - options <- NULL - } - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_personalized_pagerank, - graph, - algo, - vids - 1, - directed, - damping, - personalized, - weights, - options - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$vector) <- vertex_attr(graph, "name", vids) - } - res -} - -personalized_pagerank_vs_impl <- function( - graph, - algo = c("prpack", "arpack"), - vids = V(graph), - directed = TRUE, - damping = 0.85, - reset_vids, - weights = NULL, - options = NULL, - details = FALSE -) { - # Argument checks - ensure_igraph(graph) - algo <- switch_igraph_arg(algo, "arpack" = 1L, "prpack" = 2L) - vids <- as_igraph_vs(graph, vids) - directed <- as.logical(directed) - damping <- as.numeric(damping) - reset_vids <- as_igraph_vs(graph, reset_vids) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (is.null(options)) { - if (algo == 0L) { - options <- list(niter = 1000, eps = 0.001) - } else if (algo == 1L) { - options <- arpack_defaults() - } else { - options <- NULL - } - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_personalized_pagerank_vs, - graph, - algo, - vids - 1, - directed, - damping, - reset_vids - 1, - weights, - options - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$vector) <- vertex_attr(graph, "name", vids) - } - if (!details) { - res <- res$vector - } - res -} - -rewire_impl <- function( - rewire, - n, - mode = c("simple", "simple_loops") -) { - # Argument checks - ensure_igraph(rewire) - n <- as.numeric(n) - mode <- switch_igraph_arg(mode, "simple" = 0L, "simple_loops" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_rewire, - rewire, - n, - mode - ) - - res -} - -induced_subgraph_impl <- function( - graph, - vids, - impl = c("auto", "copy_and_delete", "create_from_scratch") -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - impl <- switch_igraph_arg( - impl, - "auto" = 0L, - "copy_and_delete" = 1L, - "create_from_scratch" = 2L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_induced_subgraph, - graph, - vids - 1, - impl - ) - - res -} - -subgraph_from_edges_impl <- function( - graph, - eids, - delete_vertices = TRUE -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - delete_vertices <- as.logical(delete_vertices) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_subgraph_from_edges, - graph, - eids - 1, - delete_vertices - ) - - res -} - -reverse_edges_impl <- function( - graph, - eids = E(graph) -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_reverse_edges, - graph, - eids - 1 - ) - - res -} - -average_path_length_impl <- function( - graph, - directed = TRUE, - unconn = TRUE, - details = FALSE -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - unconn <- as.logical(unconn) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_average_path_length, - graph, - directed, - unconn - ) - if (!details) { - res <- res$res - } - res -} - -average_path_length_dijkstra_impl <- function( - graph, - weights = NULL, - directed = TRUE, - unconnected = TRUE, - details = FALSE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - directed <- as.logical(directed) - unconnected <- as.logical(unconnected) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_average_path_length_dijkstra, - graph, - weights, - directed, - unconnected - ) - if (!details) { - res <- res$res - } - res -} - -path_length_hist_impl <- function( - graph, - directed = TRUE -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_path_length_hist, - graph, - directed - ) - - res -} - -simplify_impl <- function( - graph, - remove_multiple = TRUE, - remove_loops = TRUE, - edge_attr_comb = igraph_opt("edge.attr.comb") -) { - # Argument checks - ensure_igraph(graph) - remove_multiple <- as.logical(remove_multiple) - remove_loops <- as.logical(remove_loops) - edge_attr_comb <- igraph.i.attribute.combination(edge_attr_comb) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_simplify, - graph, - remove_multiple, - remove_loops, - edge_attr_comb - ) - - res -} - -transitivity_undirected_impl <- function( - graph, - mode = c("nan", "zero") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg(mode, "nan" = 0L, "zero" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_transitivity_undirected, - graph, - mode - ) - - res -} - -transitivity_local_undirected_impl <- function( - graph, - vids = V(graph), - mode = c("nan", "zero") -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg(mode, "nan" = 0L, "zero" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_transitivity_local_undirected, - graph, - vids - 1, - mode - ) - - res -} - -transitivity_avglocal_undirected_impl <- function( - graph, - mode = c("nan", "zero") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg(mode, "nan" = 0L, "zero" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_transitivity_avglocal_undirected, - graph, - mode - ) - - res -} - -transitivity_barrat_impl <- function( - graph, - vids = V(graph), - weights = NULL, - mode = c("nan", "zero") -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg(mode, "nan" = 0L, "zero" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_transitivity_barrat, - graph, - vids - 1, - weights, - mode - ) - - res -} - -ecc_impl <- function( - graph, - eids = E(graph), - k = 3, - offset = FALSE, - normalize = TRUE -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - k <- as.numeric(k) - offset <- as.logical(offset) - normalize <- as.logical(normalize) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_ecc, - graph, - eids - 1, - k, - offset, - normalize - ) - - res -} - -reciprocity_impl <- function( - graph, - ignore_loops = TRUE, - mode = c("default", "ratio") -) { - # Argument checks - ensure_igraph(graph) - ignore_loops <- as.logical(ignore_loops) - mode <- switch_igraph_arg(mode, "default" = 0L, "ratio" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_reciprocity, - graph, - ignore_loops, - mode - ) - - res -} - -constraint_impl <- function( - graph, - vids = V(graph), - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_constraint, - graph, - vids - 1, - weights - ) - - 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_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 -} - -density_impl <- function( - graph, - loops = FALSE -) { - # Argument checks - ensure_igraph(graph) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_density, - graph, - loops - ) - - res -} - -mean_degree_impl <- function( - graph, - loops = TRUE -) { - # Argument checks - ensure_igraph(graph) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_mean_degree, - graph, - loops - ) - - res -} - -neighborhood_size_impl <- function( - graph, - vids, - order, - mode = c("all", "out", "in", "total"), - mindist = 0 -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - order <- as.numeric(order) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - mindist <- as.numeric(mindist) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_neighborhood_size, - graph, - vids - 1, - order, - mode, - mindist - ) - - res -} - -neighborhood_impl <- function( - graph, - vids, - order, - mode = c("all", "out", "in", "total"), - mindist = 0 -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - order <- as.numeric(order) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - mindist <- as.numeric(mindist) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_neighborhood, - graph, - vids - 1, - order, - mode, - mindist - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -neighborhood_graphs_impl <- function( - graph, - vids, - order, - mode = c("all", "out", "in", "total"), - mindist = 0 -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - order <- as.numeric(order) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - mindist <- as.numeric(mindist) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_neighborhood_graphs, - graph, - vids - 1, - order, - mode, - mindist - ) - - res -} - -topological_sorting_impl <- function( - graph, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_topological_sorting, - graph, - mode - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -feedback_arc_set_impl <- function( - graph, - weights = NULL, - algo = c("approx_eades", "exact_ip") -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - algo <- switch_igraph_arg(algo, "exact_ip" = 0L, "approx_eades" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_feedback_arc_set, - graph, - weights, - algo - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -feedback_vertex_set_impl <- function( - graph, - weights = NULL, - algo = c("exact_ip") -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% vertex_attr_names(graph)) { - weights <- V(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - algo <- switch_igraph_arg(algo, "exact_ip" = 0L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_feedback_vertex_set, - graph, - weights, - algo - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -is_loop_impl <- function( - graph, - eids = E(graph) -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_loop, - graph, - eids - 1 - ) - - res -} - -is_dag_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_dag, - graph - ) - - res -} - -is_acyclic_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_acyclic, - graph - ) - - res -} - -is_simple_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_simple, - graph - ) - - res -} - -is_multiple_impl <- function( - graph, - eids = E(graph) -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_multiple, - graph, - eids - 1 - ) - - res -} - -has_loop_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_has_loop, - graph - ) - - res -} - -has_multiple_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_has_multiple, - graph - ) - - res -} - -count_loops_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_count_loops, - graph - ) - - res -} - -count_multiple_impl <- function( - graph, - eids = E(graph) -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_count_multiple, - graph, - eids - 1 - ) - - res -} - -girth_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_girth, - graph - ) - if (igraph_opt("return.vs.es")) { - res$circle <- create_vs(graph, res$circle) - } - res -} - -is_perfect_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_perfect, - graph - ) - - res -} - -add_edge_impl <- function( - graph, - from, - to -) { - # Argument checks - ensure_igraph(graph) - from <- as.numeric(from) - to <- as.numeric(to) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_add_edge, - graph, - from, - to - ) - - res -} - -eigenvector_centrality_impl <- function( - graph, - directed = FALSE, - scale = TRUE, - weights = NULL, - options = arpack_defaults() -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - scale <- as.logical(scale) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_eigenvector_centrality, - graph, - directed, - scale, - weights, - options - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$vector) <- vertex_attr(graph, "name", V(graph)) - } - res -} - -hub_score_impl <- function( - graph, - scale = TRUE, - weights = NULL, - options = arpack_defaults() -) { - # Argument checks - ensure_igraph(graph) - scale <- as.logical(scale) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hub_score, - graph, - scale, - weights, - options - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$vector) <- vertex_attr(graph, "name", V(graph)) - } - res -} - -authority_score_impl <- function( - graph, - scale = TRUE, - weights = NULL, - options = arpack_defaults() -) { - # Argument checks - ensure_igraph(graph) - scale <- as.logical(scale) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_authority_score, - graph, - scale, - weights, - options - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$vector) <- vertex_attr(graph, "name", V(graph)) - } - res -} - -hub_and_authority_scores_impl <- function( - graph, - scale = TRUE, - weights = NULL, - options = arpack_defaults() -) { - # Argument checks - ensure_igraph(graph) - scale <- as.logical(scale) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hub_and_authority_scores, - graph, - scale, - weights, - options - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$hub) <- vertex_attr(graph, "name", V(graph)) - } - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$authority) <- vertex_attr(graph, "name", V(graph)) - } - res -} - -unfold_tree_impl <- function( - graph, - mode = c("all", "out", "in", "total"), - roots -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - roots <- as.numeric(roots) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_unfold_tree, - graph, - mode, - roots - ) - - res -} - -is_mutual_impl <- function( - graph, - eids = E(graph), - loops = TRUE -) { - # Argument checks - ensure_igraph(graph) - eids <- as_igraph_es(graph, eids) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_mutual, - graph, - eids - 1, - loops - ) - - res -} - -has_mutual_impl <- function( - graph, - loops = TRUE -) { - # Argument checks - ensure_igraph(graph) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_has_mutual, - graph, - loops - ) - - res -} - -maximum_cardinality_search_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximum_cardinality_search, - graph - ) - if (igraph_opt("return.vs.es")) { - res$alpham1 <- create_vs(graph, res$alpham1) - } - res -} - -is_chordal_impl <- function( - graph, - alpha = NULL, - alpham1 = NULL -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(alpha)) { - alpha <- as.numeric(alpha) - 1 - } - if (!is.null(alpham1)) { - alpham1 <- as_igraph_vs(graph, alpham1) - alpham1 <- alpham1 - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_chordal, - graph, - alpha, - alpham1 - ) - - res -} - -avg_nearest_neighbor_degree_impl <- function( - graph, - vids = V(graph), - mode = c("all", "out", "in", "total"), - neighbor_degree_mode = c("all", "out", "in", "total"), - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - neighbor_degree_mode <- switch_igraph_arg( - neighbor_degree_mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_avg_nearest_neighbor_degree, - graph, - vids - 1, - mode, - neighbor_degree_mode, - weights - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$knn) <- vertex_attr(graph, "name", vids) - } - res -} - -degree_correlation_vector_impl <- function( - graph, - weights = NULL, - from_mode = c("out", "in", "all", "total"), - to_mode = c("in", "out", "all", "total"), - directed_neighbors = TRUE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - from_mode <- switch_igraph_arg( - from_mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - to_mode <- switch_igraph_arg( - to_mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - directed_neighbors <- as.logical(directed_neighbors) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_degree_correlation_vector, - graph, - weights, - from_mode, - to_mode, - directed_neighbors - ) - - res -} - -rich_club_sequence_impl <- function( - graph, - weights = NULL, - vertex_order, - normalized = TRUE, - loops = FALSE, - directed = TRUE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - vertex_order <- as.numeric(vertex_order) - 1 - normalized <- as.logical(normalized) - loops <- as.logical(loops) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_rich_club_sequence, - graph, - weights, - vertex_order, - normalized, - loops, - directed - ) - - res -} - -strength_impl <- function( - graph, - vids = V(graph), - mode = c("all", "out", "in", "total"), - loops = TRUE, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - loops <- as.logical(loops) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_strength, - graph, - vids - 1, - mode, - loops, - weights - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -centralization_impl <- function( - scores, - theoretical_max = 0, - normalized = TRUE -) { - # Argument checks - scores <- as.numeric(scores) - theoretical_max <- as.numeric(theoretical_max) - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_centralization, - scores, - theoretical_max, - normalized - ) - - res -} - -centralization_degree_impl <- function( - graph, - mode = c("all", "out", "in", "total"), - loops = TRUE, - normalized = TRUE -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - loops <- as.logical(loops) - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_centralization_degree, - graph, - mode, - loops, - normalized - ) - - res -} - -centralization_degree_tmax_impl <- function( - graph = NULL, - nodes = 0, - mode = c("all", "out", "in", "total"), - loops -) { - # Argument checks - if (!is.null(graph)) { - ensure_igraph(graph) - } - nodes <- as.numeric(nodes) - mode <- switch_igraph_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_centralization_degree_tmax, - graph, - nodes, - mode, - loops - ) - - res -} - -centralization_betweenness_impl <- function( - graph, - directed = TRUE, - normalized = TRUE -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_centralization_betweenness, - graph, - directed, - normalized - ) - - res -} - -centralization_betweenness_tmax_impl <- function( - graph = NULL, - nodes = 0, - directed = TRUE -) { - # Argument checks - if (!is.null(graph)) { - ensure_igraph(graph) - } - nodes <- as.numeric(nodes) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_centralization_betweenness_tmax, - graph, - nodes, - directed - ) - - res -} - -centralization_closeness_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - normalized = TRUE -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_centralization_closeness, - graph, - mode, - normalized - ) - - res -} - -centralization_closeness_tmax_impl <- function( - graph = NULL, - nodes = 0, - mode = c("out", "in", "all", "total") -) { - # Argument checks - if (!is.null(graph)) { - ensure_igraph(graph) - } - nodes <- as.numeric(nodes) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_centralization_closeness_tmax, - graph, - nodes, - mode - ) - - res -} - -centralization_eigenvector_centrality_impl <- function( - graph, - directed = FALSE, - scale = TRUE, - options = arpack_defaults(), - normalized = TRUE -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - scale <- as.logical(scale) - options <- modify_list(arpack_defaults(), options) - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_centralization_eigenvector_centrality, - graph, - directed, - scale, - options, - normalized - ) - - res -} - -centralization_eigenvector_centrality_tmax_impl <- function( - graph = NULL, - nodes = 0, - directed = FALSE, - scale = TRUE -) { - # Argument checks - if (!is.null(graph)) { - ensure_igraph(graph) - } - nodes <- as.numeric(nodes) - directed <- as.logical(directed) - scale <- as.logical(scale) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_centralization_eigenvector_centrality_tmax, - graph, - nodes, - directed, - scale - ) - - res -} - -assortativity_nominal_impl <- function( - graph, - types, - directed = TRUE, - normalized = TRUE -) { - # Argument checks - ensure_igraph(graph) - types <- as.numeric(types) - 1 - directed <- as.logical(directed) - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_assortativity_nominal, - graph, - types, - directed, - normalized - ) - - res -} - -assortativity_impl <- function( - graph, - values, - values_in = NULL, - directed = TRUE, - normalized = TRUE -) { - # Argument checks - ensure_igraph(graph) - values <- as.numeric(values) - if (!is.null(values_in)) { - values_in <- as.numeric(values_in) - } - directed <- as.logical(directed) - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_assortativity, - graph, - values, - values_in, - directed, - normalized - ) - - res -} - -assortativity_degree_impl <- function( - graph, - directed = TRUE -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_assortativity_degree, - graph, - directed - ) - - res -} - -joint_degree_matrix_impl <- function( - graph, - weights = NULL, - max_out_degree = -1, - max_in_degree = -1 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - max_out_degree <- as.numeric(max_out_degree) - max_in_degree <- as.numeric(max_in_degree) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_joint_degree_matrix, - graph, - weights, - max_out_degree, - max_in_degree - ) - - res -} - -joint_degree_distribution_impl <- function( - graph, - weights = NULL, - from_mode = c("out", "in", "all", "total"), - to_mode = c("in", "out", "all", "total"), - directed_neighbors = TRUE, - normalized = TRUE, - max_from_degree = -1, - max_to_degree = -1 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - from_mode <- switch_igraph_arg( - from_mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - to_mode <- switch_igraph_arg( - to_mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - directed_neighbors <- as.logical(directed_neighbors) - normalized <- as.logical(normalized) - max_from_degree <- as.numeric(max_from_degree) - max_to_degree <- as.numeric(max_to_degree) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_joint_degree_distribution, - graph, - weights, - from_mode, - to_mode, - directed_neighbors, - normalized, - max_from_degree, - max_to_degree - ) - - res -} - -joint_type_distribution_impl <- function( - graph, - weights = NULL, - from_types, - to_types = NULL, - directed = TRUE, - normalized = TRUE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - from_types <- as.numeric(from_types) - 1 - if (!is.null(to_types)) { - to_types <- as.numeric(to_types) - 1 - } - directed <- as.logical(directed) - normalized <- as.logical(normalized) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_joint_type_distribution, - graph, - weights, - from_types, - to_types, - directed, - normalized - ) - - res -} - -contract_vertices_impl <- function( - graph, - mapping, - vertex_attr_comb = igraph_opt("vertex.attr.comb") -) { - # Argument checks - ensure_igraph(graph) - mapping <- as.numeric(mapping) - 1 - vertex_attr_comb <- igraph.i.attribute.combination(vertex_attr_comb) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_contract_vertices, - graph, - mapping, - vertex_attr_comb - ) - - res -} - -eccentricity_impl <- function( - graph, - vids = V(graph), - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_eccentricity, - graph, - vids - 1, - mode - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -eccentricity_dijkstra_impl <- function( - graph, - vids = V(graph), - ..., - weights = NULL, - mode = c("all", "out", "in", "total") -) { - # Argument checks - check_dots_empty() - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_eccentricity_dijkstra, - graph, - weights, - vids - 1, - mode - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -graph_center_impl <- function( - graph, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_graph_center, - graph, - mode - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -graph_center_dijkstra_impl <- function( - graph, - ..., - weights = NULL, - mode = c("all", "out", "in", "total") -) { - # Argument checks - check_dots_empty() - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_graph_center_dijkstra, - graph, - weights, - mode - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -radius_impl <- function( - graph, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_radius, - graph, - mode - ) - - res -} - -radius_dijkstra_impl <- function( - graph, - ..., - weights = NULL, - mode = c("all", "out", "in", "total") -) { - # Argument checks - check_dots_empty() - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_radius_dijkstra, - graph, - weights, - mode - ) - - res -} - -pseudo_diameter_impl <- function( - graph, - start_vid, - directed = TRUE, - unconnected = TRUE -) { - # Argument checks - ensure_igraph(graph) - start_vid <- as_igraph_vs(graph, start_vid) - if (length(start_vid) != 1) { - cli::cli_abort( - "{.arg start_vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - directed <- as.logical(directed) - unconnected <- as.logical(unconnected) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_pseudo_diameter, - graph, - start_vid - 1, - directed, - unconnected - ) - - res -} - -pseudo_diameter_dijkstra_impl <- function( - graph, - weights = NULL, - start_vid, - directed = TRUE, - unconnected = TRUE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - start_vid <- as_igraph_vs(graph, start_vid) - if (length(start_vid) != 1) { - cli::cli_abort( - "{.arg start_vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - directed <- as.logical(directed) - unconnected <- as.logical(unconnected) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_pseudo_diameter_dijkstra, - graph, - weights, - start_vid - 1, - directed, - unconnected - ) - - res -} - -diversity_impl <- function( - graph, - weights = NULL, - vids = V(graph) -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - vids <- as_igraph_vs(graph, vids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_diversity, - graph, - weights, - vids - 1 - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -random_walk_impl <- function( - graph, - start, - steps, - weights = NULL, - mode = c("out", "in", "all", "total"), - stuck = c("return", "error") -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - start <- as_igraph_vs(graph, start) - if (length(start) != 1) { - cli::cli_abort( - "{.arg start} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - steps <- as.numeric(steps) - stuck <- switch_igraph_arg(stuck, "error" = 0L, "return" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_random_walk, - graph, - weights, - start - 1, - mode, - steps, - stuck - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- create_vs(graph, res$vertices) - } - if (igraph_opt("return.vs.es")) { - res$edges <- create_es(graph, res$edges) - } - res -} - -random_edge_walk_impl <- function( - graph, - weights = NULL, - start, - mode = c("out", "in", "all", "total"), - steps, - stuck = c("return", "error") -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - start <- as_igraph_vs(graph, start) - if (length(start) != 1) { - cli::cli_abort( - "{.arg start} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - steps <- as.numeric(steps) - stuck <- switch_igraph_arg(stuck, "error" = 0L, "return" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_random_edge_walk, - graph, - weights, - start - 1, - mode, - steps, - stuck - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -global_efficiency_impl <- function( - graph, - weights = NULL, - directed = TRUE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_global_efficiency, - graph, - weights, - directed - ) - - res -} - -local_efficiency_impl <- function( - graph, - vids = V(graph), - weights = NULL, - directed = TRUE, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - directed <- as.logical(directed) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_efficiency, - graph, - vids - 1, - weights, - directed, - mode - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name", vids) - } - res -} - -average_local_efficiency_impl <- function( - graph, - weights = NULL, - directed = TRUE, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - directed <- as.logical(directed) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_average_local_efficiency, - graph, - weights, - directed, - mode - ) - - res -} - -transitive_closure_dag_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_transitive_closure_dag, - graph - ) - - res -} - -transitive_closure_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_transitive_closure, - graph - ) - - res -} - -trussness_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_trussness, - graph - ) - - res -} - -is_bigraphical_impl <- function( - degrees1, - degrees2, - allowed_edge_types = c("simple", "loops", "multi", "all") -) { - # Argument checks - degrees1 <- as.numeric(degrees1) - degrees2 <- as.numeric(degrees2) - allowed_edge_types <- switch_igraph_arg( - allowed_edge_types, - "simple" = 0L, - "loop" = 1L, - "loops" = 1L, - "multi" = 6L, - "multiple" = 6L, - "all" = 7L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_bigraphical, - degrees1, - degrees2, - allowed_edge_types - ) - - res -} - -is_graphical_impl <- function( - out_deg, - in_deg = NULL, - allowed_edge_types = c("simple", "loops", "multi", "all") -) { - # Argument checks - out_deg <- as.numeric(out_deg) - if (!is.null(in_deg)) { - in_deg <- as.numeric(in_deg) - } - allowed_edge_types <- switch_igraph_arg( - allowed_edge_types, - "simple" = 0L, - "loop" = 1L, - "loops" = 1L, - "multi" = 6L, - "multiple" = 6L, - "all" = 7L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_graphical, - out_deg, - in_deg, - allowed_edge_types - ) - - res -} - -bfs_simple_impl <- function( - graph, - root, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - root <- as_igraph_vs(graph, root) - if (length(root) != 1) { - cli::cli_abort( - "{.arg root} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bfs_simple, - graph, - root - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res$order <- create_vs(graph, res$order) - } - res -} - -bipartite_projection_size_impl <- function( - graph, - types = NULL -) { - # Argument checks - ensure_igraph(graph) - types <- handle_vertex_type_arg(types, graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bipartite_projection_size, - graph, - types - ) - - res -} - -bipartite_projection_impl <- function( - graph, - types, - probe1 = -1 -) { - # Argument checks - ensure_igraph(graph) - types <- handle_vertex_type_arg(types, graph) - probe1 <- as.numeric(probe1) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bipartite_projection, - graph, - types, - probe1 - ) - - res -} - -create_bipartite_impl <- function( - types, - edges, - directed = FALSE -) { - # Argument checks - types <- handle_vertex_type_arg(types, res$graph) - edges <- as.numeric(edges) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_create_bipartite, - types, - edges, - directed - ) - - res -} - -biadjacency_impl <- function( - incidence, - directed = FALSE, - mode = c("all", "out", "in", "total"), - multiple = FALSE -) { - # Argument checks - incidence[] <- as.numeric(incidence) - directed <- as.logical(directed) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - multiple <- as.logical(multiple) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_biadjacency, - incidence, - directed, - mode, - multiple - ) - if (igraph_opt("add.vertex.names") && is_named(res$graph)) { - names(res$types) <- vertex_attr(res$graph, "name", V(res$graph)) - } - res -} - -get_biadjacency_impl <- function( - graph, - types -) { - # Argument checks - ensure_igraph(graph) - types <- handle_vertex_type_arg(types, graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_biadjacency, - graph, - types - ) - - res -} - -is_bipartite_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_bipartite, - graph - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$type) <- vertex_attr(graph, "name", V(graph)) - } - res -} - -bipartite_game_gnp_impl <- function( - n1, - n2, - p, - directed = FALSE, - mode = c("all", "out", "in", "total") -) { - # Argument checks - n1 <- as.numeric(n1) - n2 <- as.numeric(n2) - p <- as.numeric(p) - directed <- as.logical(directed) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bipartite_game_gnp, - n1, - n2, - p, - directed, - mode - ) - - res -} - -bipartite_game_gnm_impl <- function( - n1, - n2, - m, - directed = FALSE, - mode = c("all", "out", "in", "total") -) { - # Argument checks - n1 <- as.numeric(n1) - n2 <- as.numeric(n2) - m <- as.numeric(m) - directed <- as.logical(directed) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bipartite_game_gnm, - n1, - n2, - m, - directed, - mode - ) - - res -} - -bipartite_game_impl <- function( - type, - n1, - n2, - p = 0.0, - m = 0, - directed = FALSE, - mode = c("all", "out", "in", "total") -) { - # Argument checks - type <- switch_igraph_arg(type, "gnp" = 0L, "gnm" = 1L) - n1 <- as.numeric(n1) - n2 <- as.numeric(n2) - p <- as.numeric(p) - m <- as.numeric(m) - directed <- as.logical(directed) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bipartite_game, - type, - n1, - n2, - p, - m, - directed, - mode - ) - if (igraph_opt("add.vertex.names") && is_named(res$graph)) { - names(res$types) <- vertex_attr(res$graph, "name", V(res$graph)) - } - res -} - -get_laplacian_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - normalization = c("unnormalized", "symmetric", "left", "right"), - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - normalization <- switch_igraph_arg( - normalization, - "unnormalized" = 0L, - "symmetric" = 1L, - "left" = 2L, - "right" = 3L - ) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_laplacian, - graph, - mode, - normalization, - weights - ) - - res -} - -get_laplacian_sparse_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - normalization = c("unnormalized", "symmetric", "left", "right"), - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - normalization <- switch_igraph_arg( - normalization, - "unnormalized" = 0L, - "symmetric" = 1L, - "left" = 2L, - "right" = 3L - ) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_laplacian_sparse, - graph, - mode, - normalization, - weights - ) - - res -} - -connected_components_impl <- function( - graph, - mode = c("weak", "strong"), - details = FALSE -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg(mode, "weak" = 1L, "strong" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_connected_components, - graph, - mode - ) - if (!details) { - res <- res$membership - } - res -} - -is_connected_impl <- function( - graph, - mode = c("weak", "strong") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg(mode, "weak" = 1L, "strong" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_connected, - graph, - mode - ) - - res -} - -decompose_impl <- function( - graph, - mode = c("weak", "strong"), - maxcompno = -1, - minelements = 1 -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg(mode, "weak" = 1L, "strong" = 2L) - maxcompno <- as.numeric(maxcompno) - minelements <- as.numeric(minelements) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_decompose, - graph, - mode, - maxcompno, - minelements - ) - - res -} - -articulation_points_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_articulation_points, - graph - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -biconnected_components_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_biconnected_components, - graph - ) - if (igraph_opt("return.vs.es")) { - res$tree_edges <- lapply(res$tree_edges, unsafe_create_es, graph = graph, es = E(graph)) - } - if (igraph_opt("return.vs.es")) { - res$component_edges <- lapply(res$component_edges, unsafe_create_es, graph = graph, es = E(graph)) - } - if (igraph_opt("return.vs.es")) { - res$components <- lapply(res$components, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$articulation_points <- create_vs(graph, res$articulation_points) - } - res -} - -bridges_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bridges, - graph - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -is_biconnected_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_biconnected, - graph - ) - - res -} - -count_reachable_impl <- function( - graph, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_count_reachable, - graph, - mode - ) - - res -} - -bond_percolation_impl <- function( - graph, - edge_order = NULL -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(edge_order)) { - edge_order <- as_igraph_es(graph, edge_order) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bond_percolation, - graph, - edge_order - 1 - ) - - res -} - -site_percolation_impl <- function( - graph, - vertex_order = NULL -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(vertex_order)) { - vertex_order <- as_igraph_vs(graph, vertex_order) - vertex_order <- vertex_order - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_site_percolation, - graph, - vertex_order - ) - - res -} - -edgelist_percolation_impl <- function( - edges -) { - # Argument checks - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_edgelist_percolation, - edges - 1 - ) - - res -} - -is_clique_impl <- function( - graph, - candidate, - directed = FALSE -) { - # Argument checks - ensure_igraph(graph) - candidate <- as_igraph_vs(graph, candidate) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_clique, - graph, - candidate - 1, - directed - ) - - res -} - -cliques_impl <- function( - graph, - min = 0, - max = 0 -) { - # Argument checks - ensure_igraph(graph) - min <- as.numeric(min) - max <- as.numeric(max) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_cliques, - graph, - min, - max - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -clique_size_hist_impl <- function( - graph, - min_size = 0, - max_size = 0 -) { - # Argument checks - ensure_igraph(graph) - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_clique_size_hist, - graph, - min_size, - max_size - ) - - res -} - -largest_cliques_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_largest_cliques, - graph - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -maximal_cliques_impl <- function( - graph, - min_size = 0, - max_size = 0 -) { - # Argument checks - ensure_igraph(graph) - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximal_cliques, - graph, - min_size, - max_size - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -maximal_cliques_subset_impl <- function( - graph, - subset, - outfile = NULL, - min_size = 0, - max_size = 0, - details = FALSE -) { - # Argument checks - ensure_igraph(graph) - subset <- as_igraph_vs(graph, subset) - subset <- subset - 1 - if (!is.null(outfile)) { - check_string(outfile) - - } - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximal_cliques_subset, - graph, - subset, - outfile, - min_size, - max_size - ) - if (igraph_opt("return.vs.es")) { - res$res <- lapply(res$res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (!details) { - res <- res$res - } - res -} - -maximal_cliques_count_impl <- function( - graph, - min_size = 0, - max_size = 0 -) { - # Argument checks - ensure_igraph(graph) - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximal_cliques_count, - graph, - min_size, - max_size - ) - - res -} - -maximal_cliques_file_impl <- function( - graph, - res, - min_size = 0, - max_size = 0 -) { - # Argument checks - ensure_igraph(graph) - check_string(res) - - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximal_cliques_file, - graph, - res, - min_size, - max_size - ) - - res -} - -maximal_cliques_hist_impl <- function( - graph, - min_size = 0, - max_size = 0 -) { - # Argument checks - ensure_igraph(graph) - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximal_cliques_hist, - graph, - min_size, - max_size - ) - - res -} - -clique_number_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_clique_number, - graph - ) - - res -} - -weighted_cliques_impl <- function( - graph, - vertex_weights = NULL, - min_weight = 0, - max_weight = 0, - maximal = FALSE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(vertex_weights) && "weight" %in% vertex_attr_names(graph)) { - vertex_weights <- V(graph)$weight - } - if (!is.null(vertex_weights) && !all(is.na(vertex_weights))) { - vertex_weights <- as.numeric(vertex_weights) - } else { - vertex_weights <- NULL - } - min_weight <- as.numeric(min_weight) - max_weight <- as.numeric(max_weight) - maximal <- as.logical(maximal) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_weighted_cliques, - graph, - vertex_weights, - min_weight, - max_weight, - maximal - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -largest_weighted_cliques_impl <- function( - graph, - vertex_weights = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(vertex_weights) && "weight" %in% vertex_attr_names(graph)) { - vertex_weights <- V(graph)$weight - } - if (!is.null(vertex_weights) && !all(is.na(vertex_weights))) { - vertex_weights <- as.numeric(vertex_weights) - } else { - vertex_weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_largest_weighted_cliques, - graph, - vertex_weights - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -weighted_clique_number_impl <- function( - graph, - vertex_weights = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(vertex_weights) && "weight" %in% vertex_attr_names(graph)) { - vertex_weights <- V(graph)$weight - } - if (!is.null(vertex_weights) && !all(is.na(vertex_weights))) { - vertex_weights <- as.numeric(vertex_weights) - } else { - vertex_weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_weighted_clique_number, - graph, - vertex_weights - ) - - res -} - -is_independent_vertex_set_impl <- function( - graph, - candidate -) { - # Argument checks - ensure_igraph(graph) - candidate <- as_igraph_vs(graph, candidate) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_independent_vertex_set, - graph, - candidate - 1 - ) - - res -} - -independent_vertex_sets_impl <- function( - graph, - min_size = 0, - max_size = 0 -) { - # Argument checks - ensure_igraph(graph) - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_independent_vertex_sets, - graph, - min_size, - max_size - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -largest_independent_vertex_sets_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_largest_independent_vertex_sets, - graph - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -maximal_independent_vertex_sets_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximal_independent_vertex_sets, - graph - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -independence_number_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_independence_number, - graph - ) - - res -} - -layout_random_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_random, - graph - ) - - res -} - -layout_circle_impl <- function( - graph, - order = V(graph) -) { - # Argument checks - ensure_igraph(graph) - order <- as_igraph_vs(graph, order) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_circle, - graph, - order - 1 - ) - - res -} - -layout_star_impl <- function( - graph, - center = V(graph)[1], - order = NULL -) { - # Argument checks - ensure_igraph(graph) - center <- as_igraph_vs(graph, center) - if (length(center) != 1) { - cli::cli_abort( - "{.arg center} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (!is.null(order)) { - order <- as.numeric(order) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_star, - graph, - center - 1, - order - ) - - res -} - -layout_grid_impl <- function( - graph, - width = 0 -) { - # Argument checks - ensure_igraph(graph) - width <- as.numeric(width) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_grid, - graph, - width - ) - - res -} - -layout_grid_3d_impl <- function( - graph, - width = 0, - height = 0 -) { - # Argument checks - ensure_igraph(graph) - width <- as.numeric(width) - height <- as.numeric(height) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_grid_3d, - graph, - width, - height - ) - - res -} - -layout_fruchterman_reingold_impl <- function( - graph, - coords = NULL, - use_seed = FALSE, - niter = 500, - start_temp = sqrt(vcount(graph)), - grid = c("auto", "grid", "nogrid"), - weights = NULL, - minx = NULL, - maxx = NULL, - miny = NULL, - maxy = NULL, - coolexp = NULL, - maxdelta = NULL, - area = NULL, - repulserad = NULL -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(coords)) { - coords[] <- as.numeric(coords) - } - use_seed <- as.logical(use_seed) - niter <- as.numeric(niter) - start_temp <- as.numeric(start_temp) - grid <- switch_igraph_arg(grid, "grid" = 0L, "nogrid" = 1L, "auto" = 2L) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(minx)) { - minx <- as.numeric(minx) - } - if (!is.null(maxx)) { - maxx <- as.numeric(maxx) - } - if (!is.null(miny)) { - miny <- as.numeric(miny) - } - if (!is.null(maxy)) { - maxy <- as.numeric(maxy) - } - if (!missing(coolexp)) { warning("Argument `coolexp' is deprecated and has no effect") } - if (!missing(maxdelta)) { warning("Argument `maxdelta' is deprecated and has no effect") } - if (!missing(area)) { warning("Argument `area' is deprecated and has no effect") } - if (!missing(repulserad)) { warning("Argument `repulserad' is deprecated and has no effect") } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_fruchterman_reingold, - graph, - coords, - use_seed, - niter, - start_temp, - grid, - weights, - minx, - maxx, - miny, - maxy - ) - - res -} - -layout_kamada_kawai_impl <- function( - graph, - coords, - use_seed = FALSE, - maxiter = 500, - epsilon = 0.0, - kkconst = vcount(graph), - weights = NULL, - minx = NULL, - maxx = NULL, - miny = NULL, - maxy = NULL -) { - # Argument checks - ensure_igraph(graph) - coords[] <- as.numeric(coords) - use_seed <- as.logical(use_seed) - maxiter <- as.numeric(maxiter) - epsilon <- as.numeric(epsilon) - kkconst <- as.numeric(kkconst) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(minx)) { - minx <- as.numeric(minx) - } - if (!is.null(maxx)) { - maxx <- as.numeric(maxx) - } - if (!is.null(miny)) { - miny <- as.numeric(miny) - } - if (!is.null(maxy)) { - maxy <- as.numeric(maxy) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_kamada_kawai, - graph, - coords, - use_seed, - maxiter, - epsilon, - kkconst, - weights, - minx, - maxx, - miny, - maxy - ) - - res -} - -layout_lgl_impl <- function( - graph, - maxiter = 150, - maxdelta = vcount(graph), - area = vcount(graph)^2, - coolexp = 1.5, - repulserad = vcount(graph)^3, - cellsize = vcount(graph), - root = -1 -) { - # Argument checks - ensure_igraph(graph) - maxiter <- as.numeric(maxiter) - maxdelta <- as.numeric(maxdelta) - area <- as.numeric(area) - coolexp <- as.numeric(coolexp) - repulserad <- as.numeric(repulserad) - cellsize <- as.numeric(cellsize) - root <- as.numeric(root) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_lgl, - graph, - maxiter, - maxdelta, - area, - coolexp, - repulserad, - cellsize, - root - ) - - res -} - -layout_reingold_tilford_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - roots = NULL, - rootlevel = NULL -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - if (!is.null(roots)) { - roots <- as_igraph_vs(graph, roots) - roots <- roots - 1 - } - if (!is.null(rootlevel)) { - rootlevel <- as.numeric(rootlevel) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_reingold_tilford, - graph, - mode, - roots, - rootlevel - ) - - res -} - -layout_reingold_tilford_circular_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - roots = NULL, - rootlevel = NULL -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - if (!is.null(roots)) { - roots <- as_igraph_vs(graph, roots) - roots <- roots - 1 - } - if (!is.null(rootlevel)) { - rootlevel <- as.numeric(rootlevel) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_reingold_tilford_circular, - graph, - mode, - roots, - rootlevel - ) - - res -} - -roots_for_tree_layout_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - heuristic -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_roots_for_tree_layout, - graph, - mode, - heuristic - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -layout_random_3d_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_random_3d, - graph - ) - - res -} - -layout_sphere_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_sphere, - graph - ) - - res -} - -layout_fruchterman_reingold_3d_impl <- function( - graph, - coords = NULL, - use_seed = FALSE, - niter = 500, - start_temp = sqrt(vcount(graph)), - weights = NULL, - minx = NULL, - maxx = NULL, - miny = NULL, - maxy = NULL, - minz = NULL, - maxz = NULL, - coolexp = NULL, - maxdelta = NULL, - area = NULL, - repulserad = NULL -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(coords)) { - coords[] <- as.numeric(coords) - } - use_seed <- as.logical(use_seed) - niter <- as.numeric(niter) - start_temp <- as.numeric(start_temp) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(minx)) { - minx <- as.numeric(minx) - } - if (!is.null(maxx)) { - maxx <- as.numeric(maxx) - } - if (!is.null(miny)) { - miny <- as.numeric(miny) - } - if (!is.null(maxy)) { - maxy <- as.numeric(maxy) - } - if (!is.null(minz)) { - minz <- as.numeric(minz) - } - if (!is.null(maxz)) { - maxz <- as.numeric(maxz) - } - if (!missing(coolexp)) { warning("Argument `coolexp' is deprecated and has no effect") } - if (!missing(maxdelta)) { warning("Argument `maxdelta' is deprecated and has no effect") } - if (!missing(area)) { warning("Argument `area' is deprecated and has no effect") } - if (!missing(repulserad)) { warning("Argument `repulserad' is deprecated and has no effect") } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_fruchterman_reingold_3d, - graph, - coords, - use_seed, - niter, - start_temp, - weights, - minx, - maxx, - miny, - maxy, - minz, - maxz - ) - - res -} - -layout_kamada_kawai_3d_impl <- function( - graph, - coords, - use_seed = FALSE, - maxiter = 500, - epsilon = 0.0, - kkconst = vcount(graph), - weights = NULL, - minx = NULL, - maxx = NULL, - miny = NULL, - maxy = NULL, - minz = NULL, - maxz = NULL -) { - # Argument checks - ensure_igraph(graph) - coords[] <- as.numeric(coords) - use_seed <- as.logical(use_seed) - maxiter <- as.numeric(maxiter) - epsilon <- as.numeric(epsilon) - kkconst <- as.numeric(kkconst) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(minx)) { - minx <- as.numeric(minx) - } - if (!is.null(maxx)) { - maxx <- as.numeric(maxx) - } - if (!is.null(miny)) { - miny <- as.numeric(miny) - } - if (!is.null(maxy)) { - maxy <- as.numeric(maxy) - } - if (!is.null(minz)) { - minz <- as.numeric(minz) - } - if (!is.null(maxz)) { - maxz <- as.numeric(maxz) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_kamada_kawai_3d, - graph, - coords, - use_seed, - maxiter, - epsilon, - kkconst, - weights, - minx, - maxx, - miny, - maxy, - minz, - maxz - ) - - res -} - -layout_graphopt_impl <- function( - graph, - res, - niter = 500, - node_charge = 0.001, - node_mass = 30, - spring_length = 0, - spring_constant = 1, - max_sa_movement = 5, - use_seed = FALSE -) { - # Argument checks - ensure_igraph(graph) - res[] <- as.numeric(res) - niter <- as.numeric(niter) - node_charge <- as.numeric(node_charge) - node_mass <- as.numeric(node_mass) - spring_length <- as.numeric(spring_length) - spring_constant <- as.numeric(spring_constant) - max_sa_movement <- as.numeric(max_sa_movement) - use_seed <- as.logical(use_seed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_graphopt, - graph, - res, - niter, - node_charge, - node_mass, - spring_length, - spring_constant, - max_sa_movement, - use_seed - ) - - res -} - -layout_drl_impl <- function( - graph, - res, - use_seed = FALSE, - options = drl_defaults$default, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - res[] <- as.numeric(res) - use_seed <- as.logical(use_seed) - options <- modify_list(drl_defaults$default, options) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_drl, - graph, - res, - use_seed, - options, - weights - ) - - res -} - -layout_drl_3d_impl <- function( - graph, - res, - use_seed = FALSE, - options = drl_defaults$default, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - res[] <- as.numeric(res) - use_seed <- as.logical(use_seed) - options <- modify_list(drl_defaults$default, options) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_drl_3d, - graph, - res, - use_seed, - options, - weights - ) - - res -} - -layout_merge_dla_impl <- function( - graphs, - coords -) { - # Argument checks - if (!is.list(graphs)) { - cli::cli_abort("{.arg graphs} must be a list of igraph objects") - } - graphs <- lapply(graphs, function(g) { - if (!inherits(g, "igraph")) { - cli::cli_abort("{.arg graphs} must be a list of igraph objects") - } - g - }) - if (!is.list(coords)) { - cli::cli_abort("{.arg coords} must be a list of matrices") - } - coords <- lapply(coords, function(m) { - if (!is.matrix(m)) { - cli::cli_abort("{.arg coords} must be a list of matrices") - } - m[] <- as.numeric(m) - m - }) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_merge_dla, - graphs, - coords - ) - - res -} - -layout_sugiyama_impl <- function( - graph, - layers = NULL, - hgap = 1, - vgap = 1, - maxiter = 100, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(layers)) { - layers <- as.numeric(layers) - 1 - } - hgap <- as.numeric(hgap) - vgap <- as.numeric(vgap) - maxiter <- as.numeric(maxiter) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_sugiyama, - graph, - layers, - hgap, - vgap, - maxiter, - weights - ) - - res -} - -layout_mds_impl <- function( - graph, - dist = NULL, - dim = 2 -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(dist)) { - dist[] <- as.numeric(dist) - } - dim <- as.numeric(dim) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_mds, - graph, - dist, - dim - ) - - res -} - -layout_bipartite_impl <- function( - graph, - types, - hgap = 1, - vgap = 1, - maxiter = 100 -) { - # Argument checks - ensure_igraph(graph) - types <- handle_vertex_type_arg(types, graph) - hgap <- as.numeric(hgap) - vgap <- as.numeric(vgap) - maxiter <- as.numeric(maxiter) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_bipartite, - graph, - types, - hgap, - vgap, - maxiter - ) - - res -} - -layout_gem_impl <- function( - graph, - res = matrix(), - use_seed = FALSE, - maxiter = 40, - temp_max = vcount(graph), - temp_min = 1, - temp_init = sqrt(vcount(graph)) -) { - # Argument checks - ensure_igraph(graph) - res[] <- as.numeric(res) - use_seed <- as.logical(use_seed) - maxiter <- as.numeric(maxiter) - temp_max <- as.numeric(temp_max) - temp_min <- as.numeric(temp_min) - temp_init <- as.numeric(temp_init) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_gem, - graph, - res, - use_seed, - maxiter, - temp_max, - temp_min, - temp_init - ) - - res -} - -layout_davidson_harel_impl <- function( - graph, - res = matrix(), - use_seed = FALSE, - maxiter = 10, - fineiter = max(10, log2(vcount(graph))), - cool_fact = 0.75, - weight_node_dist = 1.0, - weight_border = 0.0, - weight_edge_lengths = edge_density(graph) / 10, - weight_edge_crossings = 1.0 - sqrt(edge_density(graph)), - weight_node_edge_dist = 0.2 * (1 - edge_density(graph)) -) { - # Argument checks - ensure_igraph(graph) - res[] <- as.numeric(res) - use_seed <- as.logical(use_seed) - maxiter <- as.numeric(maxiter) - fineiter <- as.numeric(fineiter) - cool_fact <- as.numeric(cool_fact) - weight_node_dist <- as.numeric(weight_node_dist) - weight_border <- as.numeric(weight_border) - weight_edge_lengths <- as.numeric(weight_edge_lengths) - weight_edge_crossings <- as.numeric(weight_edge_crossings) - weight_node_edge_dist <- as.numeric(weight_node_edge_dist) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_davidson_harel, - graph, - res, - use_seed, - maxiter, - fineiter, - cool_fact, - weight_node_dist, - weight_border, - weight_edge_lengths, - weight_edge_crossings, - weight_node_edge_dist - ) - - res -} - -layout_umap_impl <- function( - graph, - res, - use_seed = FALSE, - distances = NULL, - min_dist = 0.0, - epochs = 200, - distances_are_weights = FALSE -) { - # Argument checks - ensure_igraph(graph) - res[] <- as.numeric(res) - use_seed <- as.logical(use_seed) - if (!is.null(distances)) { - distances <- as.numeric(distances) - } - min_dist <- as.numeric(min_dist) - epochs <- as.numeric(epochs) - distances_are_weights <- as.logical(distances_are_weights) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_umap, - graph, - res, - use_seed, - distances, - min_dist, - epochs, - distances_are_weights - ) - - res -} - -layout_umap_3d_impl <- function( - graph, - res, - use_seed = FALSE, - distances = NULL, - min_dist = 0.0, - epochs = 200, - distances_are_weights = FALSE -) { - # Argument checks - ensure_igraph(graph) - res[] <- as.numeric(res) - use_seed <- as.logical(use_seed) - if (!is.null(distances)) { - distances <- as.numeric(distances) - } - min_dist <- as.numeric(min_dist) - epochs <- as.numeric(epochs) - distances_are_weights <- as.logical(distances_are_weights) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_umap_3d, - graph, - res, - use_seed, - distances, - min_dist, - epochs, - distances_are_weights - ) - - res -} - -layout_umap_compute_weights_impl <- function( - graph, - distances, - weights -) { - # Argument checks - ensure_igraph(graph) - distances <- as.numeric(distances) - weights <- as.numeric(weights) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_umap_compute_weights, - graph, - distances, - weights - ) - - res -} - -layout_align_impl <- function( - graph, - layout -) { - # Argument checks - ensure_igraph(graph) - layout[] <- as.numeric(layout) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_layout_align, - graph, - layout - ) - - res -} - -cocitation_impl <- function( - graph, - vids = V(graph) -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_cocitation, - graph, - vids - 1 - ) - - res -} - -bibcoupling_impl <- function( - graph, - vids = V(graph) -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bibcoupling, - graph, - vids - 1 - ) - - res -} - -similarity_dice_impl <- function( - graph, - vids = V(graph), - mode = c("all", "out", "in", "total"), - loops = FALSE -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_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_similarity_dice, - graph, - vids - 1, - mode, - loops - ) - - res -} - -similarity_dice_es_impl <- function( - graph, - es = E(graph), - mode = c("all", "out", "in", "total"), - loops = FALSE -) { - # Argument checks - ensure_igraph(graph) - es <- as_igraph_es(graph, es) - mode <- switch_igraph_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_similarity_dice_es, - graph, - es - 1, - mode, - loops - ) - - res -} - -similarity_dice_pairs_impl <- function( - graph, - pairs, - mode = c("all", "out", "in", "total"), - loops = FALSE -) { - # Argument checks - ensure_igraph(graph) - pairs <- as_igraph_vs(graph, pairs) - mode <- switch_igraph_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_similarity_dice_pairs, - graph, - pairs - 1, - mode, - loops - ) - - res -} - -similarity_inverse_log_weighted_impl <- function( - graph, - vids = V(graph), - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_similarity_inverse_log_weighted, - graph, - vids - 1, - mode - ) - - res -} - -similarity_jaccard_impl <- function( - graph, - vids = V(graph), - mode = c("all", "out", "in", "total"), - loops = FALSE -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - mode <- switch_igraph_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_similarity_jaccard, - graph, - vids - 1, - mode, - loops - ) - - res -} - -similarity_jaccard_es_impl <- function( - graph, - es = E(graph), - mode = c("all", "out", "in", "total"), - loops = FALSE -) { - # Argument checks - ensure_igraph(graph) - es <- as_igraph_es(graph, es) - mode <- switch_igraph_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_similarity_jaccard_es, - graph, - es - 1, - mode, - loops - ) - - res -} - -similarity_jaccard_pairs_impl <- function( - graph, - pairs, - mode = c("all", "out", "in", "total"), - loops = FALSE -) { - # Argument checks - ensure_igraph(graph) - pairs <- as_igraph_vs(graph, pairs) - mode <- switch_igraph_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_similarity_jaccard_pairs, - graph, - pairs - 1, - mode, - loops - ) - - res -} - -compare_communities_impl <- function( - comm1, - comm2, - method = c("vi", "nmi", "split.join", "rand", "adjusted.rand") -) { - # Argument checks - comm1 <- as.numeric(comm1) - comm2 <- as.numeric(comm2) - method <- switch_igraph_arg( - method, - "vi" = 0L, - "nmi" = 1L, - "split.join" = 2L, - "rand" = 3L, - "adjusted.rand" = 4L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_compare_communities, - comm1, - comm2, - method - ) - - res -} - -community_spinglass_impl <- function( - graph, - weights = NULL, - spins = 25, - parupdate = FALSE, - starttemp = 1, - stoptemp = 0.01, - coolfact = 0.99, - update_rule = c("config", "simple"), - gamma = 1.0, - implementation = c("orig", "neg"), - lambda = 1.0 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - spins <- as.numeric(spins) - parupdate <- as.logical(parupdate) - starttemp <- as.numeric(starttemp) - stoptemp <- as.numeric(stoptemp) - coolfact <- as.numeric(coolfact) - update_rule <- switch_igraph_arg(update_rule, "simple" = 0L, "config" = 1L) - gamma <- as.numeric(gamma) - implementation <- switch_igraph_arg(implementation, "orig" = 0L, "neg" = 1L) - lambda <- as.numeric(lambda) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_spinglass, - graph, - weights, - spins, - parupdate, - starttemp, - stoptemp, - coolfact, - update_rule, - gamma, - implementation, - lambda - ) - - res -} - -community_spinglass_single_impl <- function( - graph, - weights = NULL, - vertex, - spins = 25, - update_rule = c("config", "simple"), - gamma = 1.0 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - vertex <- as.numeric(vertex) - spins <- as.numeric(spins) - update_rule <- switch_igraph_arg(update_rule, "simple" = 0L, "config" = 1L) - gamma <- as.numeric(gamma) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_spinglass_single, - graph, - weights, - vertex, - spins, - update_rule, - gamma - ) - - res -} - -community_walktrap_impl <- function( - graph, - weights = NULL, - steps = 4 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - steps <- as.numeric(steps) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_walktrap, - graph, - weights, - steps - ) - - res -} - -community_edge_betweenness_impl <- function( - graph, - directed = TRUE, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_edge_betweenness, - graph, - directed, - weights - ) - - res -} - -community_eb_get_merges_impl <- function( - graph, - directed, - edges, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - directed <- as.logical(directed) - edges <- as_igraph_es(graph, edges) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_eb_get_merges, - graph, - directed, - edges - 1, - weights - ) - - res -} - -community_fastgreedy_impl <- function( - graph, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_fastgreedy, - graph, - weights - ) - - res -} - -community_to_membership_impl <- function( - merges, - nodes, - steps -) { - # Argument checks - nodes <- as.numeric(nodes) - steps <- as.numeric(steps) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_to_membership, - merges, - nodes, - steps - ) - - res -} - -le_community_to_membership_impl <- function( - merges, - steps, - membership -) { - # Argument checks - steps <- as.numeric(steps) - membership <- as.numeric(membership) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_le_community_to_membership, - merges, - steps, - membership - ) - - res -} - -modularity_impl <- function( - graph, - membership, - weights = NULL, - resolution = 1.0, - directed = TRUE -) { - # Argument checks - ensure_igraph(graph) - membership <- as.numeric(membership) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - resolution <- as.numeric(resolution) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_modularity, - graph, - membership, - weights, - resolution, - directed - ) - - res -} - -modularity_matrix_impl <- function( - graph, - weights = NULL, - resolution = 1.0, - directed = TRUE -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - resolution <- as.numeric(resolution) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_modularity_matrix, - graph, - weights, - resolution, - directed - ) - - res -} - -reindex_membership_impl <- function( - membership -) { - # Argument checks - membership <- as.numeric(membership) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_reindex_membership, - membership - ) - - res -} - -community_fluid_communities_impl <- function( - graph, - no_of_communities -) { - # Argument checks - ensure_igraph(graph) - no_of_communities <- as.numeric(no_of_communities) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_fluid_communities, - graph, - no_of_communities - ) - - res -} - -community_label_propagation_impl <- function( - graph, - mode = c("all", "out", "in", "total"), - weights = NULL, - initial = NULL, - fixed = NULL -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(initial)) { - initial <- as.numeric(initial) - 1 - } - if (!is.null(fixed)) { - fixed <- as.logical(fixed) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_label_propagation, - graph, - mode, - weights, - initial, - fixed - ) - - res -} - -community_multilevel_impl <- function( - graph, - weights = NULL, - resolution = 1.0 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - resolution <- as.numeric(resolution) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_multilevel, - graph, - weights, - resolution - ) - - res -} - -community_optimal_modularity_impl <- function( - graph, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_optimal_modularity, - graph, - weights - ) - - res -} - -community_leiden_impl <- function( - graph, - weights = NULL, - vertex_weights = NULL, - resolution, - beta = 0.01, - start, - n_iterations = 2, - membership = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (is.null(vertex_weights) && "weight" %in% vertex_attr_names(graph)) { - vertex_weights <- V(graph)$weight - } - if (!is.null(vertex_weights) && !all(is.na(vertex_weights))) { - vertex_weights <- as.numeric(vertex_weights) - } else { - vertex_weights <- NULL - } - resolution <- as.numeric(resolution) - beta <- as.numeric(beta) - start <- as.logical(start) - n_iterations <- as.numeric(n_iterations) - if (!is.null(membership)) { - membership <- as.numeric(membership) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_leiden, - graph, - weights, - vertex_weights, - resolution, - beta, - start, - n_iterations, - membership - ) - - res -} - -split_join_distance_impl <- function( - comm1, - comm2 -) { - # Argument checks - comm1 <- as.numeric(comm1) - comm2 <- as.numeric(comm2) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_split_join_distance, - comm1, - comm2 - ) - - res -} - -community_infomap_impl <- function( - graph, - e_weights = NULL, - v_weights = NULL, - nb_trials = 10 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(e_weights) && "weight" %in% edge_attr_names(graph)) { - e_weights <- E(graph)$weight - } - if (!is.null(e_weights) && !all(is.na(e_weights))) { - e_weights <- as.numeric(e_weights) - } else { - e_weights <- NULL - } - if (is.null(v_weights) && "weight" %in% vertex_attr_names(graph)) { - v_weights <- V(graph)$weight - } - if (!is.null(v_weights) && !all(is.na(v_weights))) { - v_weights <- as.numeric(v_weights) - } else { - v_weights <- NULL - } - nb_trials <- as.numeric(nb_trials) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_infomap, - graph, - e_weights, - v_weights, - nb_trials - ) - - res -} - -community_voronoi_impl <- function( - graph, - lengths = NULL, - weights = NULL, - mode = c("out", "in", "all", "total"), - radius = -1 -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(lengths) && !all(is.na(lengths))) { - lengths <- as.numeric(lengths) - } else { - lengths <- NULL - } - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - radius <- as.numeric(radius) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_voronoi, - graph, - lengths, - weights, - mode, - radius - ) - if (igraph_opt("return.vs.es")) { - res$generators <- create_vs(graph, res$generators) - } - res -} - -graphlets_impl <- function( - graph, - weights = NULL, - niter = 1000 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - niter <- as.numeric(niter) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_graphlets, - graph, - weights, - niter - ) - if (igraph_opt("return.vs.es")) { - res$cliques <- lapply(res$cliques, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -graphlets_candidate_basis_impl <- function( - graph, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_graphlets_candidate_basis, - graph, - weights - ) - if (igraph_opt("return.vs.es")) { - res$cliques <- lapply(res$cliques, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -graphlets_project_impl <- function( - graph, - weights = NULL, - cliques, - Muc, - startMu = FALSE, - niter = 1000 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(cliques) && !is.list(cliques)) { - cli::cli_abort( - "{.arg cliques} must be a list or NULL", - call = rlang::caller_env() - ) - } - Muc <- as.numeric(Muc) - startMu <- as.logical(startMu) - niter <- as.numeric(niter) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_graphlets_project, - graph, - weights, - if (!is.null(cliques)) lapply(cliques, function(.x) .x - 1), - Muc, - startMu, - niter - ) - - res -} - -hrg_fit_impl <- function( - graph, - hrg = NULL, - start = FALSE, - steps = 0 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - start <- as.logical(start) - steps <- as.numeric(steps) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_fit, - graph, - hrg, - start, - steps - ) - - res -} - -hrg_sample_impl <- function( - hrg -) { - # Argument checks - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_sample, - hrg - ) - - res -} - -hrg_sample_many_impl <- function( - hrg, - num_samples -) { - # Argument checks - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - num_samples <- as.numeric(num_samples) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_sample_many, - hrg, - num_samples - ) - - res -} - -hrg_game_impl <- function( - hrg -) { - # Argument checks - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_game, - hrg - ) - - if (igraph_opt("add.params")) { - res$name <- 'Hierarchical random graph model' - } - - res -} - -hrg_consensus_impl <- function( - graph, - hrg = NULL, - start = FALSE, - num_samples = 10000 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - start <- as.logical(start) - num_samples <- as.numeric(num_samples) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_consensus, - graph, - hrg, - start, - num_samples - ) - - res -} - -hrg_predict_impl <- function( - graph, - hrg = NULL, - start = FALSE, - num_samples = 10000, - num_bins = 25 -) { - # Argument checks - ensure_igraph(graph) - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - start <- as.logical(start) - num_samples <- as.numeric(num_samples) - num_bins <- as.numeric(num_bins) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_predict, - graph, - hrg, - start, - num_samples, - num_bins - ) - if (igraph_opt("return.vs.es")) { - res$edges <- create_vs(graph, res$edges) - } - res -} - -hrg_create_impl <- function( - graph, - prob -) { - # Argument checks - ensure_igraph(graph) - prob <- as.numeric(prob) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_create, - graph, - prob - ) - - class(res) <- "igraphHRG" - res -} - -hrg_resize_impl <- function( - hrg, - newsize -) { - # Argument checks - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - newsize <- as.numeric(newsize) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_resize, - hrg, - newsize - ) - - res -} - -hrg_size_impl <- function( - hrg -) { - # Argument checks - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_hrg_size, - hrg - ) - - res -} - -from_hrg_dendrogram_impl <- function( - hrg -) { - # Argument checks - if (is.null(hrg)) { - hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) - } - hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_from_hrg_dendrogram, - hrg - ) - - res -} - -get_adjacency_impl <- function( - graph, - type = c("both", "upper", "lower"), - weights = NULL, - loops = c("once", "none", "twice") -) { - # Argument checks - ensure_igraph(graph) - type <- switch_igraph_arg(type, "upper" = 0L, "lower" = 1L, "both" = 2L) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_adjacency, - graph, - type, - weights, - loops - ) - - res -} - -get_adjacency_sparse_impl <- function( - graph, - type = c("both", "upper", "lower"), - weights = NULL, - loops = c("once", "none", "twice") -) { - # Argument checks - ensure_igraph(graph) - type <- switch_igraph_arg(type, "upper" = 0L, "lower" = 1L, "both" = 2L) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_adjacency_sparse, - graph, - type, - weights, - loops - ) - - res -} - -get_edgelist_impl <- function( - graph, - bycol = FALSE -) { - # Argument checks - ensure_igraph(graph) - bycol <- as.logical(bycol) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_edgelist, - graph, - bycol - ) - - res -} - -get_stochastic_impl <- function( - graph, - column_wise = FALSE, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - column_wise <- as.logical(column_wise) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_stochastic, - graph, - column_wise, - weights - ) - - res -} - -get_stochastic_sparse_impl <- function( - graph, - column_wise = FALSE, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - column_wise <- as.logical(column_wise) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_stochastic_sparse, - graph, - column_wise, - weights - ) - - res -} - -to_directed_impl <- function( - graph, - mode = c("mutual", "arbitrary", "random", "acyclic") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "arbitrary" = 0L, - "mutual" = 1L, - "random" = 2L, - "acyclic" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_to_directed, - graph, - mode - ) - - res -} - -to_undirected_impl <- function( - graph, - mode = c("collapse", "each", "mutual"), - edge_attr_comb = igraph_opt("edge.attr.comb") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg(mode, "collapse" = 1L, "each" = 0L, "mutual" = 2L) - edge_attr_comb <- igraph.i.attribute.combination(edge_attr_comb) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_to_undirected, - graph, - mode, - edge_attr_comb - ) - - res -} - -read_graph_edgelist_impl <- function( - instream, - n = 0, - directed = TRUE -) { - # Argument checks - check_string(instream) - - n <- as.numeric(n) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_edgelist, - instream, - n, - directed - ) - - res -} - -read_graph_ncol_impl <- function( - instream, - predefnames = NULL, - names = TRUE, - weights = TRUE, - directed = TRUE -) { - # Argument checks - check_string(instream) - - names <- as.logical(names) - weights <- switch_igraph_arg(weights, "no" = 0L, "yes" = 1L, "auto" = 2L) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_ncol, - instream, - predefnames, - names, - weights, - directed - ) - - res -} - -read_graph_lgl_impl <- function( - instream, - names = TRUE, - weights = TRUE, - directed = TRUE -) { - # Argument checks - check_string(instream) - - names <- as.logical(names) - weights <- switch_igraph_arg(weights, "no" = 0L, "yes" = 1L, "auto" = 2L) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_lgl, - instream, - names, - weights, - directed - ) - - res -} - -read_graph_pajek_impl <- function( - instream -) { - # Argument checks - check_string(instream) - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_pajek, - instream - ) - - res -} - -read_graph_graphml_impl <- function( - instream, - index = 0 -) { - # Argument checks - check_string(instream) - - index <- as.numeric(index) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_graphml, - instream, - index - ) - - res -} - -read_graph_dimacs_flow_impl <- function( - instream, - directed = TRUE -) { - # Argument checks - check_string(instream) - - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_dimacs_flow, - instream, - directed - ) - - res -} - -read_graph_graphdb_impl <- function( - instream, - directed = FALSE -) { - # Argument checks - check_string(instream) - - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_graphdb, - instream, - directed - ) - - res -} - -read_graph_gml_impl <- function( - instream -) { - # Argument checks - check_string(instream) - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_gml, - instream - ) - - res -} - -read_graph_dl_impl <- function( - instream, - directed = TRUE -) { - # Argument checks - check_string(instream) - - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_read_graph_dl, - instream, - directed - ) - - res -} - -write_graph_edgelist_impl <- function( - graph, - outstream -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_edgelist, - graph, - outstream - ) - - res -} - -write_graph_ncol_impl <- function( - graph, - outstream, - names = "name", - weights = "weight" -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_ncol, - graph, - outstream, - names, - weights - ) - - res -} - -write_graph_lgl_impl <- function( - graph, - outstream, - names = "name", - weights = "weight", - isolates = TRUE -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - isolates <- as.logical(isolates) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_lgl, - graph, - outstream, - names, - weights, - isolates - ) - - res -} - -write_graph_leda_impl <- function( - graph, - outstream, - names = "name", - weights = "weight" -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_leda, - graph, - outstream, - names, - weights - ) - - res -} - -write_graph_graphml_impl <- function( - graph, - outstream, - prefixattr = TRUE -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - prefixattr <- as.logical(prefixattr) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_graphml, - graph, - outstream, - prefixattr - ) - - res -} - -write_graph_pajek_impl <- function( - graph, - outstream -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_pajek, - graph, - outstream - ) - - res -} - -write_graph_dimacs_flow_impl <- function( - graph, - outstream, - source = 0, - target = 0, - capacity -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - capacity <- as.numeric(capacity) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_dimacs_flow, - graph, - outstream, - source - 1, - target - 1, - capacity - ) - - res -} - -write_graph_gml_impl <- function( - graph, - outstream, - options = c("default", "encode_only_quot"), - id, - creator = NULL -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - options <- switch_igraph_arg(options, "default" = 0L, "encode_only_quot" = 1L) - id <- as.numeric(id) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_gml, - graph, - outstream, - options, - id, - creator - ) - - res -} - -write_graph_dot_impl <- function( - graph, - outstream -) { - # Argument checks - ensure_igraph(graph) - check_string(outstream) - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_write_graph_dot, - graph, - outstream - ) - - res -} - -motifs_randesu_impl <- function( - graph, - size = 3, - cut_prob = NULL -) { - # Argument checks - ensure_igraph(graph) - size <- as.numeric(size) - if (!is.null(cut_prob)) { - cut_prob <- as.numeric(cut_prob) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_motifs_randesu, - graph, - size, - cut_prob - ) - - res -} - -motifs_randesu_estimate_impl <- function( - graph, - size = 3, - cut_prob = NULL, - sample_size, - sample = NULL -) { - # Argument checks - ensure_igraph(graph) - size <- as.numeric(size) - if (!is.null(cut_prob)) { - cut_prob <- as.numeric(cut_prob) - } - sample_size <- as.numeric(sample_size) - if (!is.null(sample)) { - sample <- as.numeric(sample) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_motifs_randesu_estimate, - graph, - size, - cut_prob, - sample_size, - sample - ) - - res -} - -motifs_randesu_no_impl <- function( - graph, - size = 3, - cut_prob = NULL -) { - # Argument checks - ensure_igraph(graph) - size <- as.numeric(size) - if (!is.null(cut_prob)) { - cut_prob <- as.numeric(cut_prob) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_motifs_randesu_no, - graph, - size, - cut_prob - ) - - res -} - -dyad_census_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_dyad_census, - graph - ) - - res -} - -triad_census_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_triad_census, - graph - ) - - res -} - -count_adjacent_triangles_impl <- function( - graph, - vids = V(graph) -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_count_adjacent_triangles, - graph, - vids - 1 - ) - - res -} - -count_triangles_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_count_triangles, - graph - ) - - res -} - -local_scan_0_impl <- function( - graph, - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_scan_0, - graph, - weights, - mode - ) - - res -} - -local_scan_0_them_impl <- function( - us, - them, - weights_them = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(us) - ensure_igraph(them) - if (is.null(weights_them) && "weight" %in% edge_attr_names(them)) { - weights_them <- E(them)$weight - } - if (!is.null(weights_them) && !all(is.na(weights_them))) { - weights_them <- as.numeric(weights_them) - } else { - weights_them <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_scan_0_them, - us, - them, - weights_them, - mode - ) - - res -} - -local_scan_1_ecount_impl <- function( - graph, - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_scan_1_ecount, - graph, - weights, - mode - ) - - res -} - -local_scan_1_ecount_them_impl <- function( - us, - them, - weights_them = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(us) - ensure_igraph(them) - if (is.null(weights_them) && "weight" %in% edge_attr_names(them)) { - weights_them <- E(them)$weight - } - if (!is.null(weights_them) && !all(is.na(weights_them))) { - weights_them <- as.numeric(weights_them) - } else { - weights_them <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_scan_1_ecount_them, - us, - them, - weights_them, - mode - ) - - res -} - -local_scan_k_ecount_impl <- function( - graph, - k, - weights = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - k <- as.numeric(k) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_scan_k_ecount, - graph, - k, - weights, - mode - ) - - res -} - -local_scan_k_ecount_them_impl <- function( - us, - them, - k, - weights_them = NULL, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(us) - ensure_igraph(them) - k <- as.numeric(k) - if (is.null(weights_them) && "weight" %in% edge_attr_names(them)) { - weights_them <- E(them)$weight - } - if (!is.null(weights_them) && !all(is.na(weights_them))) { - weights_them <- as.numeric(weights_them) - } else { - weights_them <- NULL - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_scan_k_ecount_them, - us, - them, - k, - weights_them, - mode - ) - - res -} - -local_scan_neighborhood_ecount_impl <- function( - graph, - weights = NULL, - neighborhoods -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(neighborhoods) && !is.list(neighborhoods)) { - cli::cli_abort( - "{.arg neighborhoods} must be a list or NULL", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_scan_neighborhood_ecount, - graph, - weights, - if (!is.null(neighborhoods)) lapply(neighborhoods, function(.x) .x - 1) - ) - - res -} - -local_scan_subset_ecount_impl <- function( - graph, - weights = NULL, - subsets -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(subsets) && !is.list(subsets)) { - cli::cli_abort( - "{.arg subsets} must be a list or NULL", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_local_scan_subset_ecount, - graph, - weights, - if (!is.null(subsets)) lapply(subsets, function(.x) .x - 1) - ) - - res -} - -list_triangles_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_list_triangles, - graph - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -disjoint_union_impl <- function( - left, - right -) { - # Argument checks - ensure_igraph(left) - ensure_igraph(right) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_disjoint_union, - left, - right - ) - - res -} - -disjoint_union_many_impl <- function( - graphs -) { - # Argument checks - if (!is.list(graphs)) { - cli::cli_abort("{.arg graphs} must be a list of igraph objects") - } - graphs <- lapply(graphs, function(g) { - if (!inherits(g, "igraph")) { - cli::cli_abort("{.arg graphs} must be a list of igraph objects") - } - g - }) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_disjoint_union_many, - graphs - ) - - res -} - -join_impl <- function( - left, - right -) { - # Argument checks - ensure_igraph(left) - ensure_igraph(right) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_join, - left, - right - ) - - res -} - -union_impl <- function( - left, - right -) { - # Argument checks - ensure_igraph(left) - ensure_igraph(right) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_union, - left, - right - ) - - res -} - -union_many_impl <- function( - graphs -) { - # Argument checks - if (!is.list(graphs)) { - cli::cli_abort("{.arg graphs} must be a list of igraph objects") - } - graphs <- lapply(graphs, function(g) { - if (!inherits(g, "igraph")) { - cli::cli_abort("{.arg graphs} must be a list of igraph objects") - } - g - }) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_union_many, - graphs - ) - - res -} - -intersection_impl <- function( - left, - right -) { - # Argument checks - ensure_igraph(left) - ensure_igraph(right) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_intersection, - left, - right - ) - - res -} - -intersection_many_impl <- function( - graphs -) { - # Argument checks - if (!is.list(graphs)) { - cli::cli_abort("{.arg graphs} must be a list of igraph objects") - } - graphs <- lapply(graphs, function(g) { - if (!inherits(g, "igraph")) { - cli::cli_abort("{.arg graphs} must be a list of igraph objects") - } - g - }) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_intersection_many, - graphs - ) - - res -} - -difference_impl <- function( - orig, - sub -) { - # Argument checks - ensure_igraph(orig) - ensure_igraph(sub) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_difference, - orig, - sub - ) - - res -} - -complementer_impl <- function( - graph, - loops = FALSE -) { - # Argument checks - ensure_igraph(graph) - loops <- as.logical(loops) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_complementer, - graph, - loops - ) - - res -} - -compose_impl <- function( - g1, - g2 -) { - # Argument checks - ensure_igraph(g1) - ensure_igraph(g2) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_compose, - g1, - g2 - ) - - res -} - -induced_subgraph_map_impl <- function( - graph, - vids, - impl = c("auto", "copy_and_delete", "create_from_scratch") -) { - # Argument checks - ensure_igraph(graph) - vids <- as_igraph_vs(graph, vids) - impl <- switch_igraph_arg( - impl, - "auto" = 0L, - "copy_and_delete" = 1L, - "create_from_scratch" = 2L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_induced_subgraph_map, - graph, - vids - 1, - impl - ) - - res -} - -mycielskian_impl <- function( - graph, - k = 1 -) { - # Argument checks - ensure_igraph(graph) - k <- as.numeric(k) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_mycielskian, - graph, - k - ) - - res -} - -product_impl <- function( - g1, - g2, - type = c("cartesian", "lexicographic", "strong", "tensor", "modular") -) { - # Argument checks - ensure_igraph(g1) - ensure_igraph(g2) - type <- switch_igraph_arg( - type, - "cartesian" = 0L, - "lexicographic" = 1L, - "strong" = 2L, - "tensor" = 3L, - "modular" = 4L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_product, - g1, - g2, - type - ) - - res -} - -rooted_product_impl <- function( - g1, - g2, - root -) { - # Argument checks - ensure_igraph(g1) - ensure_igraph(g2) - root <- as_igraph_vs(g2, root) - if (length(root) != 1) { - cli::cli_abort( - "{.arg root} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_rooted_product, - g1, - g2, - root - 1 - ) - - res -} - -gomory_hu_tree_impl <- function( - graph, - capacity = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_gomory_hu_tree, - graph, - capacity - ) - - res -} - -maxflow_impl <- function( - graph, - source, - target, - capacity = NULL -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maxflow, - graph, - source - 1, - target - 1, - capacity - ) - if (igraph_opt("return.vs.es")) { - res$cut <- create_es(graph, res$cut) - } - if (igraph_opt("return.vs.es")) { - res$partition1 <- create_vs(graph, res$partition1) - } - if (igraph_opt("return.vs.es")) { - res$partition2 <- create_vs(graph, res$partition2) - } - res -} - -maxflow_value_impl <- function( - graph, - source, - target, - capacity = NULL -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maxflow_value, - graph, - source - 1, - target - 1, - capacity - ) - - res -} - -mincut_impl <- function( - graph, - capacity = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_mincut, - graph, - capacity - ) - if (igraph_opt("return.vs.es")) { - res$partition1 <- create_vs(graph, res$partition1) - } - if (igraph_opt("return.vs.es")) { - res$partition2 <- create_vs(graph, res$partition2) - } - if (igraph_opt("return.vs.es")) { - res$cut <- create_es(graph, res$cut) - } - res -} - -mincut_value_impl <- function( - graph, - capacity = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_mincut_value, - graph, - capacity - ) - - res -} - -residual_graph_impl <- function( - graph, - capacity, - flow -) { - # Argument checks - ensure_igraph(graph) - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - flow <- as.numeric(flow) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_residual_graph, - graph, - capacity, - flow - ) - - res -} - -reverse_residual_graph_impl <- function( - graph, - capacity, - flow -) { - # Argument checks - ensure_igraph(graph) - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - flow <- as.numeric(flow) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_reverse_residual_graph, - graph, - capacity, - flow - ) - - res -} - -st_mincut_impl <- function( - graph, - source, - target, - capacity = NULL -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_st_mincut, - graph, - source - 1, - target - 1, - capacity - ) - if (igraph_opt("return.vs.es")) { - res$cut <- create_es(graph, res$cut) - } - if (igraph_opt("return.vs.es")) { - res$partition1 <- create_vs(graph, res$partition1) - } - if (igraph_opt("return.vs.es")) { - res$partition2 <- create_vs(graph, res$partition2) - } - res -} - -st_mincut_value_impl <- function( - graph, - source, - target, - capacity = NULL -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_st_mincut_value, - graph, - source - 1, - target - 1, - capacity - ) - - res -} - -st_vertex_connectivity_impl <- function( - graph, - source, - target, - neighbors = c("number_of_nodes", "error", "ignore", "negative") -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - neighbors <- switch_igraph_arg( - neighbors, - "error" = 0L, - "number_of_nodes" = 1L, - "ignore" = 2L, - "negative" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_st_vertex_connectivity, - graph, - source - 1, - target - 1, - neighbors - ) - - res -} - -vertex_connectivity_impl <- function( - graph, - checks = TRUE -) { - # Argument checks - ensure_igraph(graph) - checks <- as.logical(checks) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_vertex_connectivity, - graph, - checks - ) - - res -} - -st_edge_connectivity_impl <- function( - graph, - source, - target -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_st_edge_connectivity, - graph, - source - 1, - target - 1 - ) - - res -} - -edge_connectivity_impl <- function( - graph, - checks = TRUE -) { - # Argument checks - ensure_igraph(graph) - checks <- as.logical(checks) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_edge_connectivity, - graph, - checks - ) - - res -} - -edge_disjoint_paths_impl <- function( - graph, - source, - target -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_edge_disjoint_paths, - graph, - source - 1, - target - 1 - ) - - res -} - -vertex_disjoint_paths_impl <- function( - graph, - source, - target -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_vertex_disjoint_paths, - graph, - source - 1, - target - 1 - ) - - res -} - -adhesion_impl <- function( - graph, - checks = TRUE -) { - # Argument checks - ensure_igraph(graph) - checks <- as.logical(checks) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_adhesion, - graph, - checks - ) - - res -} - -cohesion_impl <- function( - graph, - checks = TRUE -) { - # Argument checks - ensure_igraph(graph) - checks <- as.logical(checks) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_cohesion, - graph, - checks - ) - - res -} - -dominator_tree_impl <- function( - graph, - root, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - root <- as_igraph_vs(graph, root) - if (length(root) != 1) { - cli::cli_abort( - "{.arg root} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_dominator_tree, - graph, - root - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res$leftout <- create_vs(graph, res$leftout) - } - res -} - -all_st_cuts_impl <- function( - graph, - source, - target -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_all_st_cuts, - graph, - source - 1, - target - 1 - ) - if (igraph_opt("return.vs.es")) { - res$cuts <- lapply(res$cuts, unsafe_create_es, graph = graph, es = E(graph)) - } - if (igraph_opt("return.vs.es")) { - res$partition1s <- lapply(res$partition1s, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -all_st_mincuts_impl <- function( - graph, - source, - target, - capacity = NULL -) { - # Argument checks - ensure_igraph(graph) - source <- as_igraph_vs(graph, source) - if (length(source) != 1) { - cli::cli_abort( - "{.arg source} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - target <- as_igraph_vs(graph, target) - if (length(target) != 1) { - cli::cli_abort( - "{.arg target} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { - capacity <- E(graph)$capacity - } - if (!is.null(capacity) && !all(is.na(capacity))) { - capacity <- as.numeric(capacity) - } else { - capacity <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_all_st_mincuts, - graph, - source - 1, - target - 1, - capacity - ) - if (igraph_opt("return.vs.es")) { - res$cuts <- lapply(res$cuts, unsafe_create_es, graph = graph, es = E(graph)) - } - if (igraph_opt("return.vs.es")) { - res$partition1s <- lapply(res$partition1s, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -even_tarjan_reduction_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_even_tarjan_reduction, - graph - ) - - res -} - -is_separator_impl <- function( - graph, - candidate -) { - # Argument checks - ensure_igraph(graph) - candidate <- as_igraph_vs(graph, candidate) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_separator, - graph, - candidate - 1 - ) - - res -} - -is_minimal_separator_impl <- function( - graph, - candidate -) { - # Argument checks - ensure_igraph(graph) - candidate <- as_igraph_vs(graph, candidate) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_minimal_separator, - graph, - candidate - 1 - ) - - res -} - -all_minimal_st_separators_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_all_minimal_st_separators, - graph - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -minimum_size_separators_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_minimum_size_separators, - graph - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) - } - res -} - -cohesive_blocks_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_cohesive_blocks, - graph - ) - if (igraph_opt("return.vs.es")) { - res$blocks <- lapply(res$blocks, unsafe_create_vs, graph = graph, verts = V(graph)) - } - class(res) <- "cohesiveBlocks" - res -} - -coreness_impl <- function( - graph, - mode = c("all", "out", "in", "total") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_coreness, - graph, - mode - ) - - res -} - -isoclass_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_isoclass, - graph - ) - - res -} - -isomorphic_impl <- function( - graph1, - graph2 -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_isomorphic, - graph1, - graph2 - ) - - res -} - -isoclass_subgraph_impl <- function( - graph, - vids -) { - # Argument checks - ensure_igraph(graph) - vids <- as.numeric(vids) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_isoclass_subgraph, - graph, - vids - ) - - res -} - -isoclass_create_impl <- function( - size, - number, - directed = TRUE -) { - # Argument checks - size <- as.numeric(size) - number <- as.numeric(number) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_isoclass_create, - size, - number, - directed - ) - - res -} - -isomorphic_vf2_impl <- function( - graph1, - graph2, - vertex_color1 = NULL, - vertex_color2 = NULL, - edge_color1 = NULL, - edge_color2 = NULL -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(vertex_color1)) { - if ("color" %in% vertex_attr_names(graph1)) { - vertex_color1 <- V(graph1)$color - } else { - vertex_color1 <- NULL - } - } - if (!is.null(vertex_color1)) { - vertex_color1 <- as.numeric(vertex_color1) - 1 - } - if (is_missing(vertex_color2)) { - if ("color" %in% vertex_attr_names(graph2)) { - vertex_color2 <- V(graph2)$color - } else { - vertex_color2 <- NULL - } - } - if (!is.null(vertex_color2)) { - vertex_color2 <- as.numeric(vertex_color2) - 1 - } - if (is_missing(edge_color1)) { - if ("color" %in% edge_attr_names(graph1)) { - edge_color1 <- E(graph1)$color - } else { - edge_color1 <- NULL - } - } - if (!is.null(edge_color1)) { - edge_color1 <- as.numeric(edge_color1) - 1 - } - if (is_missing(edge_color2)) { - if ("color" %in% edge_attr_names(graph2)) { - edge_color2 <- E(graph2)$color - } else { - edge_color2 <- NULL - } - } - if (!is.null(edge_color2)) { - edge_color2 <- as.numeric(edge_color2) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_isomorphic_vf2, - graph1, - graph2, - vertex_color1, - vertex_color2, - edge_color1, - edge_color2 - ) - - res -} - -count_isomorphisms_vf2_impl <- function( - graph1, - graph2, - vertex_color1 = NULL, - vertex_color2 = NULL, - edge_color1 = NULL, - edge_color2 = NULL -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(vertex_color1)) { - if ("color" %in% vertex_attr_names(graph1)) { - vertex_color1 <- V(graph1)$color - } else { - vertex_color1 <- NULL - } - } - if (!is.null(vertex_color1)) { - vertex_color1 <- as.numeric(vertex_color1) - 1 - } - if (is_missing(vertex_color2)) { - if ("color" %in% vertex_attr_names(graph2)) { - vertex_color2 <- V(graph2)$color - } else { - vertex_color2 <- NULL - } - } - if (!is.null(vertex_color2)) { - vertex_color2 <- as.numeric(vertex_color2) - 1 - } - if (is_missing(edge_color1)) { - if ("color" %in% edge_attr_names(graph1)) { - edge_color1 <- E(graph1)$color - } else { - edge_color1 <- NULL - } - } - if (!is.null(edge_color1)) { - edge_color1 <- as.numeric(edge_color1) - 1 - } - if (is_missing(edge_color2)) { - if ("color" %in% edge_attr_names(graph2)) { - edge_color2 <- E(graph2)$color - } else { - edge_color2 <- NULL - } - } - if (!is.null(edge_color2)) { - edge_color2 <- as.numeric(edge_color2) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_count_isomorphisms_vf2, - graph1, - graph2, - vertex_color1, - vertex_color2, - edge_color1, - edge_color2 - ) - - res -} - -get_isomorphisms_vf2_impl <- function( - graph1, - graph2, - vertex_color1 = NULL, - vertex_color2 = NULL, - edge_color1 = NULL, - edge_color2 = NULL -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(vertex_color1)) { - if ("color" %in% vertex_attr_names(graph1)) { - vertex_color1 <- V(graph1)$color - } else { - vertex_color1 <- NULL - } - } - if (!is.null(vertex_color1)) { - vertex_color1 <- as.numeric(vertex_color1) - 1 - } - if (is_missing(vertex_color2)) { - if ("color" %in% vertex_attr_names(graph2)) { - vertex_color2 <- V(graph2)$color - } else { - vertex_color2 <- NULL - } - } - if (!is.null(vertex_color2)) { - vertex_color2 <- as.numeric(vertex_color2) - 1 - } - if (is_missing(edge_color1)) { - if ("color" %in% edge_attr_names(graph1)) { - edge_color1 <- E(graph1)$color - } else { - edge_color1 <- NULL - } - } - if (!is.null(edge_color1)) { - edge_color1 <- as.numeric(edge_color1) - 1 - } - if (is_missing(edge_color2)) { - if ("color" %in% edge_attr_names(graph2)) { - edge_color2 <- E(graph2)$color - } else { - edge_color2 <- NULL - } - } - if (!is.null(edge_color2)) { - edge_color2 <- as.numeric(edge_color2) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_isomorphisms_vf2, - graph1, - graph2, - vertex_color1, - vertex_color2, - edge_color1, - edge_color2 - ) - - res -} - -subisomorphic_impl <- function( - graph1, - graph2 -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_subisomorphic, - graph1, - graph2 - ) - - res -} - -subisomorphic_vf2_impl <- function( - graph1, - graph2, - vertex_color1 = NULL, - vertex_color2 = NULL, - edge_color1 = NULL, - edge_color2 = NULL -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(vertex_color1)) { - if ("color" %in% vertex_attr_names(graph1)) { - vertex_color1 <- V(graph1)$color - } else { - vertex_color1 <- NULL - } - } - if (!is.null(vertex_color1)) { - vertex_color1 <- as.numeric(vertex_color1) - 1 - } - if (is_missing(vertex_color2)) { - if ("color" %in% vertex_attr_names(graph2)) { - vertex_color2 <- V(graph2)$color - } else { - vertex_color2 <- NULL - } - } - if (!is.null(vertex_color2)) { - vertex_color2 <- as.numeric(vertex_color2) - 1 - } - if (is_missing(edge_color1)) { - if ("color" %in% edge_attr_names(graph1)) { - edge_color1 <- E(graph1)$color - } else { - edge_color1 <- NULL - } - } - if (!is.null(edge_color1)) { - edge_color1 <- as.numeric(edge_color1) - 1 - } - if (is_missing(edge_color2)) { - if ("color" %in% edge_attr_names(graph2)) { - edge_color2 <- E(graph2)$color - } else { - edge_color2 <- NULL - } - } - if (!is.null(edge_color2)) { - edge_color2 <- as.numeric(edge_color2) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_subisomorphic_vf2, - graph1, - graph2, - vertex_color1, - vertex_color2, - edge_color1, - edge_color2 - ) - - res -} - -count_subisomorphisms_vf2_impl <- function( - graph1, - graph2, - vertex_color1 = NULL, - vertex_color2 = NULL, - edge_color1 = NULL, - edge_color2 = NULL -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(vertex_color1)) { - if ("color" %in% vertex_attr_names(graph1)) { - vertex_color1 <- V(graph1)$color - } else { - vertex_color1 <- NULL - } - } - if (!is.null(vertex_color1)) { - vertex_color1 <- as.numeric(vertex_color1) - 1 - } - if (is_missing(vertex_color2)) { - if ("color" %in% vertex_attr_names(graph2)) { - vertex_color2 <- V(graph2)$color - } else { - vertex_color2 <- NULL - } - } - if (!is.null(vertex_color2)) { - vertex_color2 <- as.numeric(vertex_color2) - 1 - } - if (is_missing(edge_color1)) { - if ("color" %in% edge_attr_names(graph1)) { - edge_color1 <- E(graph1)$color - } else { - edge_color1 <- NULL - } - } - if (!is.null(edge_color1)) { - edge_color1 <- as.numeric(edge_color1) - 1 - } - if (is_missing(edge_color2)) { - if ("color" %in% edge_attr_names(graph2)) { - edge_color2 <- E(graph2)$color - } else { - edge_color2 <- NULL - } - } - if (!is.null(edge_color2)) { - edge_color2 <- as.numeric(edge_color2) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_count_subisomorphisms_vf2, - graph1, - graph2, - vertex_color1, - vertex_color2, - edge_color1, - edge_color2 - ) - - res -} - -get_subisomorphisms_vf2_impl <- function( - graph1, - graph2, - vertex_color1 = NULL, - vertex_color2 = NULL, - edge_color1 = NULL, - edge_color2 = NULL -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(vertex_color1)) { - if ("color" %in% vertex_attr_names(graph1)) { - vertex_color1 <- V(graph1)$color - } else { - vertex_color1 <- NULL - } - } - if (!is.null(vertex_color1)) { - vertex_color1 <- as.numeric(vertex_color1) - 1 - } - if (is_missing(vertex_color2)) { - if ("color" %in% vertex_attr_names(graph2)) { - vertex_color2 <- V(graph2)$color - } else { - vertex_color2 <- NULL - } - } - if (!is.null(vertex_color2)) { - vertex_color2 <- as.numeric(vertex_color2) - 1 - } - if (is_missing(edge_color1)) { - if ("color" %in% edge_attr_names(graph1)) { - edge_color1 <- E(graph1)$color - } else { - edge_color1 <- NULL - } - } - if (!is.null(edge_color1)) { - edge_color1 <- as.numeric(edge_color1) - 1 - } - if (is_missing(edge_color2)) { - if ("color" %in% edge_attr_names(graph2)) { - edge_color2 <- E(graph2)$color - } else { - edge_color2 <- NULL - } - } - if (!is.null(edge_color2)) { - edge_color2 <- as.numeric(edge_color2) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_subisomorphisms_vf2, - graph1, - graph2, - vertex_color1, - vertex_color2, - edge_color1, - edge_color2 - ) - - res -} - -canonical_permutation_impl <- function( - graph, - colors = NULL, - sh = c("fm", "f", "fs", "fl", "flm", "fsm") -) { - # Argument checks - ensure_igraph(graph) - if (is_missing(colors)) { - if ("color" %in% vertex_attr_names(graph)) { - colors <- V(graph)$color - } else { - colors <- NULL - } - } - if (!is.null(colors)) { - colors <- as.numeric(colors) - 1 - } - sh <- switch_igraph_arg( - sh, - "f" = 0L, - "fl" = 1L, - "fs" = 2L, - "fm" = 3L, - "flm" = 4L, - "fsm" = 5L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_canonical_permutation, - graph, - colors, - sh - ) - - res -} - -permute_vertices_impl <- function( - graph, - permutation -) { - # Argument checks - ensure_igraph(graph) - permutation <- as.numeric(permutation) - 1 - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_permute_vertices, - graph, - permutation - ) - - res -} - -isomorphic_bliss_impl <- function( - graph1, - graph2, - colors1 = NULL, - colors2 = NULL, - sh = c("fm", "f", "fs", "fl", "flm", "fsm") -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(colors1)) { - if ("color" %in% vertex_attr_names(graph1)) { - colors1 <- V(graph1)$color - } else { - colors1 <- NULL - } - } - if (!is.null(colors1)) { - colors1 <- as.numeric(colors1) - 1 - } - if (is_missing(colors2)) { - if ("color" %in% vertex_attr_names(graph2)) { - colors2 <- V(graph2)$color - } else { - colors2 <- NULL - } - } - if (!is.null(colors2)) { - colors2 <- as.numeric(colors2) - 1 - } - sh <- switch_igraph_arg( - sh, - "f" = 0L, - "fl" = 1L, - "fs" = 2L, - "fm" = 3L, - "flm" = 4L, - "fsm" = 5L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_isomorphic_bliss, - graph1, - graph2, - colors1, - colors2, - sh - ) - - res -} - -count_automorphisms_impl <- function( - graph, - colors = NULL, - sh = c("fm", "f", "fs", "fl", "flm", "fsm") -) { - # Argument checks - ensure_igraph(graph) - if (is_missing(colors)) { - if ("color" %in% vertex_attr_names(graph)) { - colors <- V(graph)$color - } else { - colors <- NULL - } - } - if (!is.null(colors)) { - colors <- as.numeric(colors) - 1 - } - sh <- switch_igraph_arg( - sh, - "f" = 0L, - "fl" = 1L, - "fs" = 2L, - "fm" = 3L, - "flm" = 4L, - "fsm" = 5L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_count_automorphisms, - graph, - colors, - sh - ) - - res -} - -automorphism_group_impl <- function( - graph, - colors = NULL, - sh = c("fm", "f", "fs", "fl", "flm", "fsm"), - details = FALSE -) { - # Argument checks - ensure_igraph(graph) - if (is_missing(colors)) { - if ("color" %in% vertex_attr_names(graph)) { - colors <- V(graph)$color - } else { - colors <- NULL - } - } - if (!is.null(colors)) { - colors <- as.numeric(colors) - 1 - } - sh <- switch_igraph_arg( - sh, - "f" = 0L, - "fl" = 1L, - "fs" = 2L, - "fm" = 3L, - "flm" = 4L, - "fsm" = 5L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_automorphism_group, - graph, - colors, - sh - ) - if (igraph_opt("return.vs.es")) { - res$generators <- lapply(res$generators, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (!details) { - res <- res$generators - } - res -} - -subisomorphic_lad_impl <- function( - pattern, - target, - domains = NULL, - induced, - time_limit -) { - # Argument checks - ensure_igraph(pattern) - ensure_igraph(target) - if (!is.null(domains) && !is.list(domains)) { - cli::cli_abort( - "{.arg domains} must be a list or NULL", - call = rlang::caller_env() - ) - } - induced <- as.logical(induced) - time_limit <- as.numeric(time_limit) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_subisomorphic_lad, - pattern, - target, - if (!is.null(domains)) lapply(domains, function(.x) .x - 1), - induced, - time_limit - ) - - res -} - -simplify_and_colorize_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_simplify_and_colorize, - graph - ) - - res -} - -graph_count_impl <- function( - n, - directed = FALSE -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_graph_count, - n, - directed - ) - - res -} - -is_matching_impl <- function( - graph, - types = NULL, - matching -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(types)) { - types <- handle_vertex_type_arg(types, graph) - } - matching <- as.numeric(matching) - 1 - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_matching, - graph, - types, - matching - ) - - res -} - -is_maximal_matching_impl <- function( - graph, - types = NULL, - matching -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(types)) { - types <- handle_vertex_type_arg(types, graph) - } - matching <- as.numeric(matching) - 1 - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_maximal_matching, - graph, - types, - matching - ) - - res -} - -maximum_bipartite_matching_impl <- function( - graph, - types, - weights = NULL, - eps = .Machine$double.eps -) { - # Argument checks - ensure_igraph(graph) - types <- handle_vertex_type_arg(types, graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - eps <- as.numeric(eps) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximum_bipartite_matching, - graph, - types, - weights, - eps - ) - - res -} - -adjacency_spectral_embedding_impl <- function( - graph, - no, - weights = NULL, - which = c("lm", "la", "sa"), - scaled = TRUE, - cvec = strength(graph, weights = weights) / (vcount(graph) - 1), - options = arpack_defaults() -) { - # Argument checks - ensure_igraph(graph) - no <- as.numeric(no) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - which <- switch_igraph_arg(which, "lm" = 0L, "la" = 2L, "sa" = 3L) - scaled <- as.logical(scaled) - cvec <- as.numeric(cvec) - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_adjacency_spectral_embedding, - graph, - no, - weights, - which, - scaled, - cvec, - options - ) - - res -} - -laplacian_spectral_embedding_impl <- function( - graph, - no, - weights = NULL, - which = c("lm", "la", "sa"), - type = c("default", "D-A", "DAD", "I-DAD", "OAP"), - scaled = TRUE, - options = arpack_defaults() -) { - # Argument checks - ensure_igraph(graph) - no <- as.numeric(no) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - which <- switch_igraph_arg(which, "lm" = 0L, "la" = 2L, "sa" = 3L) - type <- switch_igraph_arg(type, "default" = if (is_directed(graph)) 3L else 0L, - "da" = 0L, "d-a" = 0L, "idad" = 1L, "i-dad" = 1L, "dad" = 2L, - "oap" = 3L) - scaled <- as.logical(scaled) - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_laplacian_spectral_embedding, - graph, - no, - weights, - which, - type, - scaled, - options - ) - - res -} - -eigen_adjacency_impl <- function( - graph, - algorithm = c("arpack", "auto", "lapack", "comp_auto", "comp_lapack", "comp_arpack"), - which = list(), - options = arpack_defaults() -) { - # Argument checks - ensure_igraph(graph) - algorithm <- switch_igraph_arg( - algorithm, - "auto" = 0L, - "lapack" = 1L, - "arpack" = 2L, - "comp_auto" = 3L, - "comp_lapack" = 4L, - "comp_arpack" = 5L - ) - which.tmp <- eigen_defaults() - which.tmp[names(which)] <- which - which <- which.tmp - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_eigen_adjacency, - graph, - algorithm, - which, - options - ) - - res -} - -power_law_fit_impl <- function( - data, - xmin = -1, - force_continuous = FALSE -) { - # Argument checks - data <- as.numeric(data) - xmin <- as.numeric(xmin) - force_continuous <- as.logical(force_continuous) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_power_law_fit, - data, - xmin, - force_continuous - ) - - res -} - -sir_impl <- function( - graph, - beta, - gamma, - no_sim = 100 -) { - # Argument checks - ensure_igraph(graph) - beta <- as.numeric(beta) - gamma <- as.numeric(gamma) - no_sim <- as.numeric(no_sim) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_sir, - graph, - beta, - gamma, - no_sim - ) - - class(res) <- "sir" - res -} - -running_mean_impl <- function( - data, - binwidth -) { - # Argument checks - data <- as.numeric(data) - binwidth <- as.numeric(binwidth) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_running_mean, - data, - binwidth - ) - - res -} - -random_sample_impl <- function( - l, - h, - length -) { - # Argument checks - l <- as.numeric(l) - h <- as.numeric(h) - length <- as.numeric(length) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_random_sample, - l, - h, - length - ) - - res -} - -convex_hull_2d_impl <- function( - data -) { - # Argument checks - data[] <- as.numeric(data) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_convex_hull_2d, - data - ) - - res -} - -dim_select_impl <- function( - sv -) { - # Argument checks - sv <- as.numeric(sv) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_dim_select, - sv - ) - - res -} - -almost_equals_impl <- function( - a, - b, - eps -) { - # Argument checks - a <- as.numeric(a) - b <- as.numeric(b) - eps <- as.numeric(eps) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_almost_equals, - a, - b, - eps - ) - - res -} - -cmp_epsilon_impl <- function( - a, - b, - eps -) { - # Argument checks - a <- as.numeric(a) - b <- as.numeric(b) - eps <- as.numeric(eps) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_cmp_epsilon, - a, - b, - eps - ) - - res -} - -eigen_matrix_impl <- function( - A, - sA, - fun, - n, - algorithm, - which, - options = arpack_defaults() -) { - # Argument checks - A[] <- as.numeric(A) - requireNamespace("Matrix", quietly = TRUE) - sA <- as(as(as(sA, "dMatrix"), "generalMatrix"), "CsparseMatrix") - n <- as.integer(n) - algorithm <- switch_igraph_arg( - algorithm, - "auto" = 0L, - "lapack" = 1L, - "arpack" = 2L, - "comp_auto" = 3L, - "comp_lapack" = 4L, - "comp_arpack" = 5L - ) - which.tmp <- eigen_defaults() - which.tmp[names(which)] <- which - which <- which.tmp - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_eigen_matrix, - A, - sA, - fun, - n, - algorithm, - which, - options - ) - - res -} - -eigen_matrix_symmetric_impl <- function( - A, - sA, - fun, - n, - algorithm, - which, - options = arpack_defaults() -) { - # Argument checks - A[] <- as.numeric(A) - requireNamespace("Matrix", quietly = TRUE) - sA <- as(as(as(sA, "dMatrix"), "generalMatrix"), "CsparseMatrix") - n <- as.integer(n) - algorithm <- switch_igraph_arg( - algorithm, - "auto" = 0L, - "lapack" = 1L, - "arpack" = 2L, - "comp_auto" = 3L, - "comp_lapack" = 4L, - "comp_arpack" = 5L - ) - which.tmp <- eigen_defaults() - which.tmp[names(which)] <- which - which <- which.tmp - options <- modify_list(arpack_defaults(), options) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_eigen_matrix_symmetric, - A, - sA, - fun, - n, - algorithm, - which, - options - ) - - res -} - -solve_lsap_impl <- function( - c, - n -) { - # Argument checks - c[] <- as.numeric(c) - n <- as.numeric(n) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_solve_lsap, - c, - n - ) - - res -} - -find_cycle_impl <- function( - graph, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_find_cycle, - graph, - mode - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- create_vs(graph, res$vertices) - } - if (igraph_opt("return.vs.es")) { - res$edges <- create_es(graph, res$edges) - } - res -} - -simple_cycles_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - min_cycle_length = -1, - max_cycle_length = -1 -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - min_cycle_length <- as.numeric(min_cycle_length) - max_cycle_length <- as.numeric(max_cycle_length) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_simple_cycles, - graph, - mode, - min_cycle_length, - max_cycle_length - ) - if (igraph_opt("return.vs.es")) { - res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) - } - if (igraph_opt("return.vs.es")) { - res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -is_eulerian_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_eulerian, - graph - ) - - res -} - -eulerian_path_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_eulerian_path, - graph - ) - if (igraph_opt("return.vs.es")) { - res$epath <- create_es(graph, res$epath) - } - if (igraph_opt("return.vs.es")) { - res$vpath <- create_vs(graph, res$vpath) - } - res -} - -eulerian_cycle_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_eulerian_cycle, - graph - ) - if (igraph_opt("return.vs.es")) { - res$epath <- create_es(graph, res$epath) - } - if (igraph_opt("return.vs.es")) { - res$vpath <- create_vs(graph, res$vpath) - } - res -} - -fundamental_cycles_impl <- function( - graph, - start = NULL, - bfs_cutoff = -1, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(start)) { - start <- as_igraph_vs(graph, start) - if (length(start) != 1) { - cli::cli_abort( - "{.arg start} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - } - bfs_cutoff <- as.numeric(bfs_cutoff) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_fundamental_cycles, - graph, - start - 1, - bfs_cutoff, - weights - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -minimum_cycle_basis_impl <- function( - graph, - bfs_cutoff = -1, - complete = TRUE, - use_cycle_order = TRUE, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - bfs_cutoff <- as.numeric(bfs_cutoff) - complete <- as.logical(complete) - use_cycle_order <- as.logical(use_cycle_order) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_minimum_cycle_basis, - graph, - bfs_cutoff, - complete, - use_cycle_order, - weights - ) - if (igraph_opt("return.vs.es")) { - res <- lapply(res, unsafe_create_es, graph = graph, es = E(graph)) - } - res -} - -is_tree_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - details = FALSE -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_tree, - graph, - mode - ) - if (igraph_opt("return.vs.es") && vcount(graph) != 0) { - res$root <- create_vs(graph, res$root) - } - if (!details) { - res <- res$res - } - res -} - -is_forest_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - details = FALSE -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_forest, - graph, - mode - ) - if (igraph_opt("return.vs.es")) { - res$roots <- create_vs(graph, res$roots) - } - if (!details) { - res <- res$res - } - res -} - -from_prufer_impl <- function( - prufer -) { - # Argument checks - prufer <- as.numeric(prufer) - 1 - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_from_prufer, - prufer - ) - - if (igraph_opt("add.params")) { - res$name <- 'Tree from Prufer sequence' - res$prufer <- prufer - } - - res -} - -to_prufer_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_to_prufer, - graph - ) - - res -} - -tree_from_parent_vector_impl <- function( - parents, - type = c("out", "in", "undirected") -) { - # Argument checks - parents <- as.numeric(parents) - 1 - type <- switch_igraph_arg(type, "out" = 0L, "in" = 1L, "undirected" = 2L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_tree_from_parent_vector, - parents, - type - ) - - res -} - -is_complete_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_complete, - graph - ) - - res -} - -minimum_spanning_tree_impl <- function( - graph, - weights = NULL -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_minimum_spanning_tree, - graph, - weights - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -minimum_spanning_tree_unweighted_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_minimum_spanning_tree_unweighted, - graph - ) - - res -} - -minimum_spanning_tree_prim_impl <- function( - graph, - weights -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_minimum_spanning_tree_prim, - graph, - weights - ) - - res -} - -random_spanning_tree_impl <- function( - graph, - vid = 0 -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(vid)) { - vid <- as_igraph_vs(graph, vid) - if (length(vid) != 1) { - cli::cli_abort( - "{.arg vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_random_spanning_tree, - graph, - vid - 1 - ) - if (igraph_opt("return.vs.es")) { - res <- create_es(graph, res) - } - res -} - -tree_game_impl <- function( - n, - directed = FALSE, - method = c("lerw", "prufer") -) { - # Argument checks - n <- as.numeric(n) - directed <- as.logical(directed) - method <- switch_igraph_arg(method, "prufer" = 0L, "lerw" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_tree_game, - n, - directed, - method - ) - - res -} - -vertex_coloring_greedy_impl <- function( - graph, - heuristic = c("colored_neighbors", "dsatur") -) { - # Argument checks - ensure_igraph(graph) - heuristic <- switch_igraph_arg(heuristic, "colored_neighbors" = 0L, "dsatur" = 1L) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_vertex_coloring_greedy, - graph, - heuristic - ) - res <- res + 1 - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res) <- vertex_attr(graph, "name") - } - res -} - -is_vertex_coloring_impl <- function( - graph, - types -) { - # Argument checks - ensure_igraph(graph) - if (is_missing(types)) { - if ("color" %in% vertex_attr_names(graph)) { - types <- V(graph)$color - } else { - types <- NULL - } - } - if (!is.null(types)) { - types <- as.numeric(types) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_vertex_coloring, - graph, - types - ) - - res -} - -is_bipartite_coloring_impl <- function( - graph, - types -) { - # Argument checks - ensure_igraph(graph) - types <- handle_vertex_type_arg(types, graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_bipartite_coloring, - graph, - types - ) - - res -} - -is_edge_coloring_impl <- function( - graph, - types -) { - # Argument checks - ensure_igraph(graph) - if (is_missing(types)) { - if ("color" %in% edge_attr_names(graph)) { - types <- E(graph)$color - } else { - types <- NULL - } - } - if (!is.null(types)) { - types <- as.numeric(types) - 1 - } - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_is_edge_coloring, - graph, - types - ) - - res -} - -deterministic_optimal_imitation_impl <- function( - graph, - vid, - optimality = c("maximum", "minimum"), - quantities, - strategies, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - vid <- as_igraph_vs(graph, vid) - if (length(vid) != 1) { - cli::cli_abort( - "{.arg vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - optimality <- switch_igraph_arg(optimality, "minimum" = 0L, "maximum" = 1L) - strategies <- as.numeric(strategies) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_deterministic_optimal_imitation, - graph, - vid - 1, - optimality, - quantities, - strategies, - mode - ) - - res -} - -moran_process_impl <- function( - graph, - weights = NULL, - quantities, - strategies, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - strategies <- as.numeric(strategies) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_moran_process, - graph, - weights, - quantities, - strategies, - mode - ) - if (igraph_opt("add.vertex.names") && is_named(graph)) { - names(res$quantities) <- vertex_attr(graph, "name", V(graph)) - } - res -} - -roulette_wheel_imitation_impl <- function( - graph, - vid, - is_local, - quantities, - strategies, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - vid <- as_igraph_vs(graph, vid) - if (length(vid) != 1) { - cli::cli_abort( - "{.arg vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - is_local <- as.logical(is_local) - strategies <- as.numeric(strategies) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_roulette_wheel_imitation, - graph, - vid - 1, - is_local, - quantities, - strategies, - mode - ) - - res -} - -stochastic_imitation_impl <- function( - graph, - vid, - algo, - quantities, - strategies, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - vid <- as_igraph_vs(graph, vid) - if (length(vid) != 1) { - cli::cli_abort( - "{.arg vid} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - strategies <- as.numeric(strategies) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_stochastic_imitation, - graph, - vid - 1, - algo, - quantities, - strategies, - mode - ) - - res -} - -convergence_degree_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_convergence_degree, - graph - ) - - res -} - -has_attribute_table_impl <- function( -) { - # Argument checks - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_has_attribute_table - ) - - res -} - -progress_impl <- function( - message, - percent -) { - # Argument checks - percent <- as.numeric(percent) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_progress, - message, - percent - ) - - res -} - -status_impl <- function( - message -) { - # Argument checks - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_status, - message - ) - - res -} - -strerror_impl <- function( - igraph_errno -) { - # Argument checks - igraph_errno <- as.numeric(igraph_errno) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_strerror, - igraph_errno - ) - - res -} - -expand_path_to_pairs_impl <- function( - path -) { - # Argument checks - path <- as_igraph_vs(path, path) - path <- path - 1 - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_expand_path_to_pairs, - path - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(path, res) - } - res -} - -invalidate_cache_impl <- function( - graph -) { - # Argument checks - ensure_igraph(graph) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_invalidate_cache, - graph - ) - - res -} - -vertex_path_from_edge_path_impl <- function( - graph, - start = NULL, - edge_path, - mode = c("out", "in", "all", "total") -) { - # Argument checks - ensure_igraph(graph) - if (!is.null(start)) { - start <- as_igraph_vs(graph, start) - if (length(start) != 1) { - cli::cli_abort( - "{.arg start} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - } - edge_path <- as_igraph_es(graph, edge_path) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_vertex_path_from_edge_path, - graph, - start - 1, - edge_path - 1, - mode - ) - if (igraph_opt("return.vs.es")) { - res <- create_vs(graph, res) - } - res -} - -version_impl <- function( -) { - # Argument checks - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_version - ) - - res -} - -bfs_closure_impl <- function( - graph, - root, - roots = NULL, - mode = c("out", "in", "all", "total"), - unreachable, - restricted = NULL, - callback -) { - # Argument checks - ensure_igraph(graph) - root <- as_igraph_vs(graph, root) - if (length(root) != 1) { - cli::cli_abort( - "{.arg root} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - if (!is.null(roots)) { - roots <- as_igraph_vs(graph, roots) - roots <- roots - 1 - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - unreachable <- as.logical(unreachable) - if (!is.null(restricted)) { - restricted <- as_igraph_vs(graph, restricted) - restricted <- restricted - 1 - } - if (!is.null(callback)) { - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - { - out <- callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_bfs_closure, - graph, - root - 1, - roots, - mode, - unreachable, - restricted, - callback_wrapped - ) - if (igraph_opt("return.vs.es")) { - res$order <- create_vs(graph, res$order) - } - res -} - -dfs_closure_impl <- function( - graph, - root, - mode = c("out", "in", "all", "total"), - unreachable, - in_callback, - out_callback -) { - # Argument checks - ensure_igraph(graph) - root <- as_igraph_vs(graph, root) - if (length(root) != 1) { - cli::cli_abort( - "{.arg root} must specify exactly one vertex", - call = rlang::caller_env() - ) - } - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - unreachable <- as.logical(unreachable) - if (!is.null(in_callback)) { - if (!is.function(in_callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - in_callback_wrapped <- function(...) { - tryCatch( - { - out <- in_callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - in_callback_wrapped <- NULL - } - - if (!is.null(out_callback)) { - if (!is.function(out_callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - out_callback_wrapped <- function(...) { - tryCatch( - { - out <- out_callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - out_callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_dfs_closure, - graph, - root - 1, - mode, - unreachable, - in_callback_wrapped, - out_callback_wrapped - ) - if (igraph_opt("return.vs.es")) { - res$order <- create_vs(graph, res$order) - } - if (igraph_opt("return.vs.es")) { - res$order_out <- create_vs(graph, res$order_out) - } - res -} - -cliques_callback_closure_impl <- function( - graph, - min_size = 0, - max_size = 0, - callback -) { - # Argument checks - ensure_igraph(graph) - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - if (!is.null(callback)) { - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - { - out <- callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_cliques_callback_closure, - graph, - min_size, - max_size, - callback_wrapped - ) - - res -} - -maximal_cliques_callback_closure_impl <- function( - graph, - min_size = 0, - max_size = 0, - callback -) { - # Argument checks - ensure_igraph(graph) - min_size <- as.numeric(min_size) - max_size <- as.numeric(max_size) - if (!is.null(callback)) { - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - { - out <- callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_maximal_cliques_callback_closure, - graph, - min_size, - max_size, - callback_wrapped - ) - - res -} - -community_leading_eigenvector_callback_closure_impl <- function( - graph, - weights = NULL, - membership = NULL, - steps = -1, - options = arpack_defaults(), - start = FALSE, - callback = NULL, - extra = NULL, - env = parent.frame(), - env_arp = environment(igraph.i.levc.arp) -) { - # Argument checks - ensure_igraph(graph) - if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { - weights <- E(graph)$weight - } - if (!is.null(weights) && !all(is.na(weights))) { - weights <- as.numeric(weights) - } else { - weights <- NULL - } - if (!is.null(membership)) { - membership <- as.numeric(membership) - } - steps <- as.numeric(steps) - options <- modify_list(arpack_defaults(), options) - start <- as.logical(start) - if (!is.null(callback)) { - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - { - out <- callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_leading_eigenvector_callback_closure, - graph, - weights, - membership, - steps, - options, - start, - callback_wrapped, - extra, - env, - env_arp - ) - - class(res) <- "igraph.eigenc" - res -} - -get_isomorphisms_vf2_callback_closure_impl <- function( - graph1, - graph2, - vertex_color1 = NULL, - vertex_color2 = NULL, - edge_color1 = NULL, - edge_color2 = NULL, - callback -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(vertex_color1)) { - if ("color" %in% vertex_attr_names(graph1)) { - vertex_color1 <- V(graph1)$color - } else { - vertex_color1 <- NULL - } - } - if (!is.null(vertex_color1)) { - vertex_color1 <- as.numeric(vertex_color1) - 1 - } - if (is_missing(vertex_color2)) { - if ("color" %in% vertex_attr_names(graph2)) { - vertex_color2 <- V(graph2)$color - } else { - vertex_color2 <- NULL - } - } - if (!is.null(vertex_color2)) { - vertex_color2 <- as.numeric(vertex_color2) - 1 - } - if (is_missing(edge_color1)) { - if ("color" %in% edge_attr_names(graph1)) { - edge_color1 <- E(graph1)$color - } else { - edge_color1 <- NULL - } - } - if (!is.null(edge_color1)) { - edge_color1 <- as.numeric(edge_color1) - 1 - } - if (is_missing(edge_color2)) { - if ("color" %in% edge_attr_names(graph2)) { - edge_color2 <- E(graph2)$color - } else { - edge_color2 <- NULL - } - } - if (!is.null(edge_color2)) { - edge_color2 <- as.numeric(edge_color2) - 1 - } - if (!is.null(callback)) { - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - { - out <- callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_isomorphisms_vf2_callback_closure, - graph1, - graph2, - vertex_color1, - vertex_color2, - edge_color1, - edge_color2, - callback_wrapped - ) - - res -} - -get_subisomorphisms_vf2_callback_closure_impl <- function( - graph1, - graph2, - vertex_color1 = NULL, - vertex_color2 = NULL, - edge_color1 = NULL, - edge_color2 = NULL, - callback -) { - # Argument checks - ensure_igraph(graph1) - ensure_igraph(graph2) - if (is_missing(vertex_color1)) { - if ("color" %in% vertex_attr_names(graph1)) { - vertex_color1 <- V(graph1)$color - } else { - vertex_color1 <- NULL - } - } - if (!is.null(vertex_color1)) { - vertex_color1 <- as.numeric(vertex_color1) - 1 - } - if (is_missing(vertex_color2)) { - if ("color" %in% vertex_attr_names(graph2)) { - vertex_color2 <- V(graph2)$color - } else { - vertex_color2 <- NULL - } - } - if (!is.null(vertex_color2)) { - vertex_color2 <- as.numeric(vertex_color2) - 1 - } - if (is_missing(edge_color1)) { - if ("color" %in% edge_attr_names(graph1)) { - edge_color1 <- E(graph1)$color - } else { - edge_color1 <- NULL - } - } - if (!is.null(edge_color1)) { - edge_color1 <- as.numeric(edge_color1) - 1 - } - if (is_missing(edge_color2)) { - if ("color" %in% edge_attr_names(graph2)) { - edge_color2 <- E(graph2)$color - } else { - edge_color2 <- NULL - } - } - if (!is.null(edge_color2)) { - edge_color2 <- as.numeric(edge_color2) - 1 - } - if (!is.null(callback)) { - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - { - out <- callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_get_subisomorphisms_vf2_callback_closure, - graph1, - graph2, - vertex_color1, - vertex_color2, - edge_color1, - edge_color2, - callback_wrapped - ) - - res -} - -simple_cycles_callback_closure_impl <- function( - graph, - mode = c("out", "in", "all", "total"), - min_cycle_length = -1, - max_cycle_length = -1, - callback -) { - # Argument checks - ensure_igraph(graph) - mode <- switch_igraph_arg( - mode, - "out" = 1L, - "in" = 2L, - "all" = 3L, - "total" = 3L - ) - min_cycle_length <- as.numeric(min_cycle_length) - max_cycle_length <- as.numeric(max_cycle_length) - if (!is.null(callback)) { - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - { - out <- callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_simple_cycles_callback_closure, - graph, - mode, - min_cycle_length, - max_cycle_length, - callback_wrapped - ) - - res -} - -motifs_randesu_callback_closure_impl <- function( - graph, - size, - cut_prob = NULL, - callback -) { - # Argument checks - ensure_igraph(graph) - size <- as.numeric(size) - if (!is.null(cut_prob)) { - cut_prob <- as.numeric(cut_prob) - } - if (!is.null(callback)) { - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - { - out <- callback(...) - if (is.logical(out) && length(out) == 1 && !is.na(out)) { - out - } else { - rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") - } - }, - error = function(e) e, - interrupt = function(e) e - ) - } - } else { - callback_wrapped <- NULL - } - - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_motifs_randesu_callback_closure, - graph, - size, - cut_prob, - callback_wrapped - ) - - res -} - diff --git a/R/aaa-basicigraph.R b/R/aaa-basicigraph.R new file mode 100644 index 00000000000..5c5f2474cad --- /dev/null +++ b/R/aaa-basicigraph.R @@ -0,0 +1,534 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== adding-and-deleting-vertices-and-edges ==== + +add_edge_impl <- function( + graph, + from, + to +) { + # Argument checks + ensure_igraph(graph) + from <- as.numeric(from) + to <- as.numeric(to) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_add_edge, + graph, + from, + to + ) + + res +} + +add_edges_impl <- function( + graph, + edges +) { + # Argument checks + ensure_igraph(graph) + edges <- as_igraph_vs(graph, edges) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_add_edges, + graph, + edges - 1 + ) + + res +} + +add_vertices_impl <- function( + graph, + nv +) { + # Argument checks + ensure_igraph(graph) + nv <- as.numeric(nv) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_add_vertices, + graph, + nv + ) + + res +} + +delete_edges_impl <- function( + graph, + edges +) { + # Argument checks + ensure_igraph(graph) + edges <- as_igraph_es(graph, edges) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_delete_edges, + graph, + edges - 1 + ) + + res +} + +delete_vertices_idx_impl <- function( + graph, + vertices +) { + # Argument checks + ensure_igraph(graph) + vertices <- as_igraph_vs(graph, vertices) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_delete_vertices_idx, + graph, + vertices - 1 + ) + + res +} + +delete_vertices_impl <- function( + graph, + vertices +) { + # Argument checks + ensure_igraph(graph) + vertices <- as_igraph_vs(graph, vertices) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_delete_vertices, + graph, + vertices - 1 + ) + + res +} + +# ==== basic-query-operations ==== + +degree_impl <- function( + graph, + vids = V(graph), + mode = c("all", "out", "in", "total"), + loops = TRUE +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_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_degree, + graph, + vids - 1, + mode, + loops + ) + + res +} + +ecount_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_ecount, + graph + ) + + res +} + +edge_impl <- function( + graph, + eid +) { + # Argument checks + ensure_igraph(graph) + eid <- as.numeric(eid) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_edge, + graph, + eid + ) + + res +} + +edges_impl <- function( + graph, + eids +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_edges, + graph, + eids - 1 + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +get_all_eids_between_impl <- function( + graph, + from, + to, + directed = TRUE +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (length(to) != 1) { + cli::cli_abort( + "{.arg to} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_all_eids_between, + graph, + from - 1, + to - 1, + directed + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +get_eid_impl <- function( + graph, + from, + to, + directed = TRUE, + error = TRUE +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (length(to) != 1) { + cli::cli_abort( + "{.arg to} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + directed <- as.logical(directed) + error <- as.logical(error) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_eid, + graph, + from - 1, + to - 1, + directed, + error + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +get_eids_impl <- function( + graph, + pairs, + directed = TRUE, + error = TRUE +) { + # Argument checks + ensure_igraph(graph) + pairs <- as_igraph_vs(graph, pairs) + directed <- as.logical(directed) + error <- as.logical(error) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_eids, + graph, + pairs - 1, + directed, + error + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +incident_impl <- function( + graph, + vid, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + vid <- as_igraph_vs(graph, vid) + if (length(vid) != 1) { + cli::cli_abort( + "{.arg vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_incident, + graph, + vid - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +is_directed_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_directed, + graph + ) + + res +} + +neighbors_impl <- function( + graph, + vid, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + vid <- as_igraph_vs(graph, vid) + if (length(vid) != 1) { + cli::cli_abort( + "{.arg vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_neighbors, + graph, + vid - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +vcount_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_vcount, + graph + ) + + res +} + +# ==== graph-constructors-and-destructors ==== + +copy_impl <- function( + from +) { + # Argument checks + ensure_igraph(from) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_copy, + from + ) + + res +} + +empty_attrs_impl <- function( + n, + directed +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_empty_attrs, + n, + directed + ) + + res +} + +empty_impl <- function( + n = 0, + directed = TRUE +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_empty, + n, + directed + ) + + res +} + +# ==== misc-helper-functions ==== + +expand_path_to_pairs_impl <- function( + path +) { + # Argument checks + path <- as_igraph_vs(path, path) + path <- path - 1 + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_expand_path_to_pairs, + path + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(path, res) + } + res +} + +invalidate_cache_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_invalidate_cache, + graph + ) + + res +} + +is_same_graph_impl <- function( + graph1, + graph2 +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_same_graph, + graph1, + graph2 + ) + + res +} diff --git a/R/aaa-bipartite.R b/R/aaa-bipartite.R new file mode 100644 index 00000000000..fd97cb788f8 --- /dev/null +++ b/R/aaa-bipartite.R @@ -0,0 +1,286 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== bipartite-adjacency-matrices ==== + +biadjacency_impl <- function( + incidence, + directed = FALSE, + mode = c("all", "out", "in", "total"), + multiple = FALSE +) { + # Argument checks + incidence[] <- as.numeric(incidence) + directed <- as.logical(directed) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + multiple <- as.logical(multiple) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_biadjacency, + incidence, + directed, + mode, + multiple + ) + if (igraph_opt("add.vertex.names") && is_named(res$graph)) { + names(res$types) <- vertex_attr(res$graph, "name", V(res$graph)) + } + res +} + +get_biadjacency_impl <- function( + graph, + types +) { + # Argument checks + ensure_igraph(graph) + types <- handle_vertex_type_arg(types, graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_biadjacency, + graph, + types + ) + + res +} + +# ==== create-two-mode-networks ==== + +bipartite_game_gnm_impl <- function( + n1, + n2, + m, + directed = FALSE, + mode = c("all", "out", "in", "total") +) { + # Argument checks + n1 <- as.numeric(n1) + n2 <- as.numeric(n2) + m <- as.numeric(m) + directed <- as.logical(directed) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bipartite_game_gnm, + n1, + n2, + m, + directed, + mode + ) + + res +} + +bipartite_game_gnp_impl <- function( + n1, + n2, + p, + directed = FALSE, + mode = c("all", "out", "in", "total") +) { + # Argument checks + n1 <- as.numeric(n1) + n2 <- as.numeric(n2) + p <- as.numeric(p) + directed <- as.logical(directed) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bipartite_game_gnp, + n1, + n2, + p, + directed, + mode + ) + + res +} + +bipartite_game_impl <- function( + type, + n1, + n2, + p = 0.0, + m = 0, + directed = FALSE, + mode = c("all", "out", "in", "total") +) { + # Argument checks + type <- switch_igraph_arg(type, "gnp" = 0L, "gnm" = 1L) + n1 <- as.numeric(n1) + n2 <- as.numeric(n2) + p <- as.numeric(p) + m <- as.numeric(m) + directed <- as.logical(directed) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bipartite_game, + type, + n1, + n2, + p, + m, + directed, + mode + ) + if (igraph_opt("add.vertex.names") && is_named(res$graph)) { + names(res$types) <- vertex_attr(res$graph, "name", V(res$graph)) + } + res +} + +create_bipartite_impl <- function( + types, + edges, + directed = FALSE +) { + # Argument checks + types <- handle_vertex_type_arg(types, res$graph) + edges <- as.numeric(edges) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_create_bipartite, + types, + edges, + directed + ) + + res +} + +full_bipartite_impl <- function( + n1, + n2, + directed = FALSE, + mode = c("all", "out", "in", "total") +) { + # Argument checks + n1 <- as.numeric(n1) + n2 <- as.numeric(n2) + directed <- as.logical(directed) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_full_bipartite, + n1, + n2, + directed, + mode + ) + if (igraph_opt("add.vertex.names") && is_named(res$graph)) { + names(res$types) <- vertex_attr(res$graph, "name") + } + res +} + +# ==== other-operations-on-bipartite-graphs ==== + +is_bipartite_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_bipartite, + graph + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$type) <- vertex_attr(graph, "name", V(graph)) + } + res +} + +# ==== project-two-mode-graphs ==== + +bipartite_projection_impl <- function( + graph, + types, + probe1 = -1 +) { + # Argument checks + ensure_igraph(graph) + types <- handle_vertex_type_arg(types, graph) + probe1 <- as.numeric(probe1) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bipartite_projection, + graph, + types, + probe1 + ) + + res +} + +bipartite_projection_size_impl <- function( + graph, + types = NULL +) { + # Argument checks + ensure_igraph(graph) + types <- handle_vertex_type_arg(types, graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bipartite_projection_size, + graph, + types + ) + + res +} diff --git a/R/aaa-cliques.R b/R/aaa-cliques.R new file mode 100644 index 00000000000..ede50a325fe --- /dev/null +++ b/R/aaa-cliques.R @@ -0,0 +1,536 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== cliques ==== + +clique_number_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_clique_number, + graph + ) + + res +} + +clique_size_hist_impl <- function( + graph, + min_size = 0, + max_size = 0 +) { + # Argument checks + ensure_igraph(graph) + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_clique_size_hist, + graph, + min_size, + max_size + ) + + res +} + +cliques_callback_closure_impl <- function( + graph, + min_size = 0, + max_size = 0, + callback +) { + # Argument checks + ensure_igraph(graph) + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + { + out <- callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_cliques_callback_closure, + graph, + min_size, + max_size, + callback_wrapped + ) + + res +} + +cliques_impl <- function( + graph, + min = 0, + max = 0 +) { + # Argument checks + ensure_igraph(graph) + min <- as.numeric(min) + max <- as.numeric(max) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_cliques, + graph, + min, + max + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +is_clique_impl <- function( + graph, + candidate, + directed = FALSE +) { + # Argument checks + ensure_igraph(graph) + candidate <- as_igraph_vs(graph, candidate) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_clique, + graph, + candidate - 1, + directed + ) + + res +} + +is_complete_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_complete, + graph + ) + + res +} + +largest_cliques_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_largest_cliques, + graph + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +maximal_cliques_callback_closure_impl <- function( + graph, + min_size = 0, + max_size = 0, + callback +) { + # Argument checks + ensure_igraph(graph) + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + { + out <- callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximal_cliques_callback_closure, + graph, + min_size, + max_size, + callback_wrapped + ) + + res +} + +maximal_cliques_count_impl <- function( + graph, + min_size = 0, + max_size = 0 +) { + # Argument checks + ensure_igraph(graph) + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximal_cliques_count, + graph, + min_size, + max_size + ) + + res +} + +maximal_cliques_file_impl <- function( + graph, + res, + min_size = 0, + max_size = 0 +) { + # Argument checks + ensure_igraph(graph) + check_string(res) + + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximal_cliques_file, + graph, + res, + min_size, + max_size + ) + + res +} + +maximal_cliques_hist_impl <- function( + graph, + min_size = 0, + max_size = 0 +) { + # Argument checks + ensure_igraph(graph) + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximal_cliques_hist, + graph, + min_size, + max_size + ) + + res +} + +maximal_cliques_impl <- function( + graph, + min_size = 0, + max_size = 0 +) { + # Argument checks + ensure_igraph(graph) + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximal_cliques, + graph, + min_size, + max_size + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +maximal_cliques_subset_impl <- function( + graph, + subset, + outfile = NULL, + min_size = 0, + max_size = 0, + details = FALSE +) { + # Argument checks + ensure_igraph(graph) + subset <- as_igraph_vs(graph, subset) + subset <- subset - 1 + if (!is.null(outfile)) { + check_string(outfile) + + } + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximal_cliques_subset, + graph, + subset, + outfile, + min_size, + max_size + ) + if (igraph_opt("return.vs.es")) { + res$res <- lapply(res$res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (!details) { + res <- res$res + } + res +} + +# ==== independent-vertex-sets ==== + +independence_number_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_independence_number, + graph + ) + + res +} + +independent_vertex_sets_impl <- function( + graph, + min_size = 0, + max_size = 0 +) { + # Argument checks + ensure_igraph(graph) + min_size <- as.numeric(min_size) + max_size <- as.numeric(max_size) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_independent_vertex_sets, + graph, + min_size, + max_size + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +is_independent_vertex_set_impl <- function( + graph, + candidate +) { + # Argument checks + ensure_igraph(graph) + candidate <- as_igraph_vs(graph, candidate) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_independent_vertex_set, + graph, + candidate - 1 + ) + + res +} + +largest_independent_vertex_sets_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_largest_independent_vertex_sets, + graph + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +maximal_independent_vertex_sets_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximal_independent_vertex_sets, + graph + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +# ==== weighted-cliques ==== + +largest_weighted_cliques_impl <- function( + graph, + vertex_weights = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(vertex_weights) && "weight" %in% vertex_attr_names(graph)) { + vertex_weights <- V(graph)$weight + } + if (!is.null(vertex_weights) && !all(is.na(vertex_weights))) { + vertex_weights <- as.numeric(vertex_weights) + } else { + vertex_weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_largest_weighted_cliques, + graph, + vertex_weights + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +weighted_clique_number_impl <- function( + graph, + vertex_weights = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(vertex_weights) && "weight" %in% vertex_attr_names(graph)) { + vertex_weights <- V(graph)$weight + } + if (!is.null(vertex_weights) && !all(is.na(vertex_weights))) { + vertex_weights <- as.numeric(vertex_weights) + } else { + vertex_weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_weighted_clique_number, + graph, + vertex_weights + ) + + res +} + +weighted_cliques_impl <- function( + graph, + vertex_weights = NULL, + min_weight = 0, + max_weight = 0, + maximal = FALSE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(vertex_weights) && "weight" %in% vertex_attr_names(graph)) { + vertex_weights <- V(graph)$weight + } + if (!is.null(vertex_weights) && !all(is.na(vertex_weights))) { + vertex_weights <- as.numeric(vertex_weights) + } else { + vertex_weights <- NULL + } + min_weight <- as.numeric(min_weight) + max_weight <- as.numeric(max_weight) + maximal <- as.logical(maximal) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_weighted_cliques, + graph, + vertex_weights, + min_weight, + max_weight, + maximal + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} diff --git a/R/aaa-coloring.R b/R/aaa-coloring.R new file mode 100644 index 00000000000..22bedd61de2 --- /dev/null +++ b/R/aaa-coloring.R @@ -0,0 +1,115 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +is_bipartite_coloring_impl <- function( + graph, + types +) { + # Argument checks + ensure_igraph(graph) + types <- handle_vertex_type_arg(types, graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_bipartite_coloring, + graph, + types + ) + + res +} + +is_edge_coloring_impl <- function( + graph, + types +) { + # Argument checks + ensure_igraph(graph) + if (is_missing(types)) { + if ("color" %in% edge_attr_names(graph)) { + types <- E(graph)$color + } else { + types <- NULL + } + } + if (!is.null(types)) { + types <- as.numeric(types) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_edge_coloring, + graph, + types + ) + + res +} + +is_perfect_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_perfect, + graph + ) + + res +} + +is_vertex_coloring_impl <- function( + graph, + types +) { + # Argument checks + ensure_igraph(graph) + if (is_missing(types)) { + if ("color" %in% vertex_attr_names(graph)) { + types <- V(graph)$color + } else { + types <- NULL + } + } + if (!is.null(types)) { + types <- as.numeric(types) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_vertex_coloring, + graph, + types + ) + + res +} + +vertex_coloring_greedy_impl <- function( + graph, + heuristic = c("colored_neighbors", "dsatur") +) { + # Argument checks + ensure_igraph(graph) + heuristic <- switch_igraph_arg(heuristic, "colored_neighbors" = 0L, "dsatur" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_vertex_coloring_greedy, + graph, + heuristic + ) + res <- res + 1 + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name") + } + res +} diff --git a/R/aaa-community.R b/R/aaa-community.R new file mode 100644 index 00000000000..17c67a5a5a7 --- /dev/null +++ b/R/aaa-community.R @@ -0,0 +1,731 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== common-functions-related-to-community-detection ==== + +community_optimal_modularity_impl <- function( + graph, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_optimal_modularity, + graph, + weights + ) + + res +} + +community_to_membership_impl <- function( + merges, + nodes, + steps +) { + # Argument checks + nodes <- as.numeric(nodes) + steps <- as.numeric(steps) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_to_membership, + merges, + nodes, + steps + ) + + res +} + +compare_communities_impl <- function( + comm1, + comm2, + method = c("vi", "nmi", "split.join", "rand", "adjusted.rand") +) { + # Argument checks + comm1 <- as.numeric(comm1) + comm2 <- as.numeric(comm2) + method <- switch_igraph_arg( + method, + "vi" = 0L, + "nmi" = 1L, + "split.join" = 2L, + "rand" = 3L, + "adjusted.rand" = 4L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_compare_communities, + comm1, + comm2, + method + ) + + res +} + +modularity_impl <- function( + graph, + membership, + weights = NULL, + resolution = 1.0, + directed = TRUE +) { + # Argument checks + ensure_igraph(graph) + membership <- as.numeric(membership) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + resolution <- as.numeric(resolution) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_modularity, + graph, + membership, + weights, + resolution, + directed + ) + + res +} + +modularity_matrix_impl <- function( + graph, + weights = NULL, + resolution = 1.0, + directed = TRUE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + resolution <- as.numeric(resolution) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_modularity_matrix, + graph, + weights, + resolution, + directed + ) + + res +} + +reindex_membership_impl <- function( + membership +) { + # Argument checks + membership <- as.numeric(membership) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_reindex_membership, + membership + ) + + res +} + +split_join_distance_impl <- function( + comm1, + comm2 +) { + # Argument checks + comm1 <- as.numeric(comm1) + comm2 <- as.numeric(comm2) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_split_join_distance, + comm1, + comm2 + ) + + res +} + +# ==== community-detection-based-on-statistical-mechanics ==== + +community_spinglass_impl <- function( + graph, + weights = NULL, + spins = 25, + parupdate = FALSE, + starttemp = 1, + stoptemp = 0.01, + coolfact = 0.99, + update_rule = c("config", "simple"), + gamma = 1.0, + implementation = c("orig", "neg"), + lambda = 1.0 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + spins <- as.numeric(spins) + parupdate <- as.logical(parupdate) + starttemp <- as.numeric(starttemp) + stoptemp <- as.numeric(stoptemp) + coolfact <- as.numeric(coolfact) + update_rule <- switch_igraph_arg(update_rule, "simple" = 0L, "config" = 1L) + gamma <- as.numeric(gamma) + implementation <- switch_igraph_arg(implementation, "orig" = 0L, "neg" = 1L) + lambda <- as.numeric(lambda) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_spinglass, + graph, + weights, + spins, + parupdate, + starttemp, + stoptemp, + coolfact, + update_rule, + gamma, + implementation, + lambda + ) + + res +} + +community_spinglass_single_impl <- function( + graph, + weights = NULL, + vertex, + spins = 25, + update_rule = c("config", "simple"), + gamma = 1.0 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + vertex <- as.numeric(vertex) + spins <- as.numeric(spins) + update_rule <- switch_igraph_arg(update_rule, "simple" = 0L, "config" = 1L) + gamma <- as.numeric(gamma) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_spinglass_single, + graph, + weights, + vertex, + spins, + update_rule, + gamma + ) + + res +} + +# ==== community-structure-based-on-eigenvectors-of-matrices ==== + +community_leading_eigenvector_callback_closure_impl <- function( + graph, + weights = NULL, + membership = NULL, + steps = -1, + options = arpack_defaults(), + start = FALSE, + callback = NULL, + extra = NULL, + env = parent.frame(), + env_arp = environment(igraph.i.levc.arp) +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(membership)) { + membership <- as.numeric(membership) + } + steps <- as.numeric(steps) + options <- modify_list(arpack_defaults(), options) + start <- as.logical(start) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + { + out <- callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_leading_eigenvector_callback_closure, + graph, + weights, + membership, + steps, + options, + start, + callback_wrapped, + extra, + env, + env_arp + ) + + class(res) <- "igraph.eigenc" + res +} + +le_community_to_membership_impl <- function( + merges, + steps, + membership +) { + # Argument checks + steps <- as.numeric(steps) + membership <- as.numeric(membership) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_le_community_to_membership, + merges, + steps, + membership + ) + + res +} + +# ==== community-structure-based-on-the-optimization-of-modularity ==== + +community_fastgreedy_impl <- function( + graph, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_fastgreedy, + graph, + weights + ) + + res +} + +community_leiden_impl <- function( + graph, + weights = NULL, + vertex_weights = NULL, + resolution, + beta = 0.01, + start, + n_iterations = 2, + membership = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (is.null(vertex_weights) && "weight" %in% vertex_attr_names(graph)) { + vertex_weights <- V(graph)$weight + } + if (!is.null(vertex_weights) && !all(is.na(vertex_weights))) { + vertex_weights <- as.numeric(vertex_weights) + } else { + vertex_weights <- NULL + } + resolution <- as.numeric(resolution) + beta <- as.numeric(beta) + start <- as.logical(start) + n_iterations <- as.numeric(n_iterations) + if (!is.null(membership)) { + membership <- as.numeric(membership) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_leiden, + graph, + weights, + vertex_weights, + resolution, + beta, + start, + n_iterations, + membership + ) + + res +} + +community_multilevel_impl <- function( + graph, + weights = NULL, + resolution = 1.0 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + resolution <- as.numeric(resolution) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_multilevel, + graph, + weights, + resolution + ) + + res +} + +# ==== edge-betweenness-based-community-detection ==== + +community_eb_get_merges_impl <- function( + graph, + directed, + edges, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + edges <- as_igraph_es(graph, edges) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_eb_get_merges, + graph, + directed, + edges - 1, + weights + ) + + res +} + +community_edge_betweenness_impl <- function( + graph, + directed = TRUE, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_edge_betweenness, + graph, + directed, + weights + ) + + res +} + +# ==== fluid-communities ==== + +community_fluid_communities_impl <- function( + graph, + no_of_communities +) { + # Argument checks + ensure_igraph(graph) + no_of_communities <- as.numeric(no_of_communities) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_fluid_communities, + graph, + no_of_communities + ) + + res +} + +# ==== infomap-algorithm ==== + +community_infomap_impl <- function( + graph, + e_weights = NULL, + v_weights = NULL, + nb_trials = 10 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(e_weights) && "weight" %in% edge_attr_names(graph)) { + e_weights <- E(graph)$weight + } + if (!is.null(e_weights) && !all(is.na(e_weights))) { + e_weights <- as.numeric(e_weights) + } else { + e_weights <- NULL + } + if (is.null(v_weights) && "weight" %in% vertex_attr_names(graph)) { + v_weights <- V(graph)$weight + } + if (!is.null(v_weights) && !all(is.na(v_weights))) { + v_weights <- as.numeric(v_weights) + } else { + v_weights <- NULL + } + nb_trials <- as.numeric(nb_trials) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_infomap, + graph, + e_weights, + v_weights, + nb_trials + ) + + res +} + +# ==== label-propagation ==== + +community_label_propagation_impl <- function( + graph, + mode = c("all", "out", "in", "total"), + weights = NULL, + initial = NULL, + fixed = NULL +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(initial)) { + initial <- as.numeric(initial) - 1 + } + if (!is.null(fixed)) { + fixed <- as.logical(fixed) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_label_propagation, + graph, + mode, + weights, + initial, + fixed + ) + + res +} + +# ==== voronoi-communities ==== + +community_voronoi_impl <- function( + graph, + lengths = NULL, + weights = NULL, + mode = c("out", "in", "all", "total"), + radius = -1 +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(lengths) && !all(is.na(lengths))) { + lengths <- as.numeric(lengths) + } else { + lengths <- NULL + } + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + radius <- as.numeric(radius) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_voronoi, + graph, + lengths, + weights, + mode, + radius + ) + if (igraph_opt("return.vs.es")) { + res$generators <- create_vs(graph, res$generators) + } + res +} + +# ==== walktrap-community-structure-based-on-random-walks ==== + +community_walktrap_impl <- function( + graph, + weights = NULL, + steps = 4 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + steps <- as.numeric(steps) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_walktrap, + graph, + weights, + steps + ) + + res +} diff --git a/R/aaa-cycles.R b/R/aaa-cycles.R new file mode 100644 index 00000000000..f7671c6bde0 --- /dev/null +++ b/R/aaa-cycles.R @@ -0,0 +1,389 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== acyclic-graphs-feedback-sets ==== + +feedback_arc_set_impl <- function( + graph, + weights = NULL, + algo = c("approx_eades", "exact_ip") +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + algo <- switch_igraph_arg(algo, "exact_ip" = 0L, "approx_eades" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_feedback_arc_set, + graph, + weights, + algo + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +feedback_vertex_set_impl <- function( + graph, + weights = NULL, + algo = c("exact_ip") +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% vertex_attr_names(graph)) { + weights <- V(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + algo <- switch_igraph_arg(algo, "exact_ip" = 0L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_feedback_vertex_set, + graph, + weights, + algo + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +is_acyclic_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_acyclic, + graph + ) + + res +} + +is_dag_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_dag, + graph + ) + + res +} + +topological_sorting_impl <- function( + graph, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_topological_sorting, + graph, + mode + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +# ==== cycle-bases ==== + +fundamental_cycles_impl <- function( + graph, + start = NULL, + bfs_cutoff = -1, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(start)) { + start <- as_igraph_vs(graph, start) + if (length(start) != 1) { + cli::cli_abort( + "{.arg start} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + } + bfs_cutoff <- as.numeric(bfs_cutoff) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_fundamental_cycles, + graph, + start - 1, + bfs_cutoff, + weights + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +minimum_cycle_basis_impl <- function( + graph, + bfs_cutoff = -1, + complete = TRUE, + use_cycle_order = TRUE, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + bfs_cutoff <- as.numeric(bfs_cutoff) + complete <- as.logical(complete) + use_cycle_order <- as.logical(use_cycle_order) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_minimum_cycle_basis, + graph, + bfs_cutoff, + complete, + use_cycle_order, + weights + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +# ==== eulerian-cycles ==== + +eulerian_cycle_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_eulerian_cycle, + graph + ) + if (igraph_opt("return.vs.es")) { + res$epath <- create_es(graph, res$epath) + } + if (igraph_opt("return.vs.es")) { + res$vpath <- create_vs(graph, res$vpath) + } + res +} + +eulerian_path_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_eulerian_path, + graph + ) + if (igraph_opt("return.vs.es")) { + res$epath <- create_es(graph, res$epath) + } + if (igraph_opt("return.vs.es")) { + res$vpath <- create_vs(graph, res$vpath) + } + res +} + +is_eulerian_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_eulerian, + graph + ) + + res +} + +# ==== finding-cycles ==== + +find_cycle_impl <- function( + graph, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_find_cycle, + graph, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- create_vs(graph, res$vertices) + } + if (igraph_opt("return.vs.es")) { + res$edges <- create_es(graph, res$edges) + } + res +} + +simple_cycles_callback_closure_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + min_cycle_length = -1, + max_cycle_length = -1, + callback +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + min_cycle_length <- as.numeric(min_cycle_length) + max_cycle_length <- as.numeric(max_cycle_length) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + { + out <- callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_simple_cycles_callback_closure, + graph, + mode, + min_cycle_length, + max_cycle_length, + callback_wrapped + ) + + res +} + +simple_cycles_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + min_cycle_length = -1, + max_cycle_length = -1 +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + min_cycle_length <- as.numeric(min_cycle_length) + max_cycle_length <- as.numeric(max_cycle_length) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_simple_cycles, + graph, + mode, + min_cycle_length, + max_cycle_length + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} diff --git a/R/aaa-embedding.R b/R/aaa-embedding.R new file mode 100644 index 00000000000..60588c0b985 --- /dev/null +++ b/R/aaa-embedding.R @@ -0,0 +1,104 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== spectral-embedding ==== + +adjacency_spectral_embedding_impl <- function( + graph, + no, + weights = NULL, + which = c("lm", "la", "sa"), + scaled = TRUE, + cvec = strength(graph, weights = weights) / (vcount(graph) - 1), + options = arpack_defaults() +) { + # Argument checks + ensure_igraph(graph) + no <- as.numeric(no) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + which <- switch_igraph_arg(which, "lm" = 0L, "la" = 2L, "sa" = 3L) + scaled <- as.logical(scaled) + cvec <- as.numeric(cvec) + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_adjacency_spectral_embedding, + graph, + no, + weights, + which, + scaled, + cvec, + options + ) + + res +} + +dim_select_impl <- function( + sv +) { + # Argument checks + sv <- as.numeric(sv) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_dim_select, + sv + ) + + res +} + +laplacian_spectral_embedding_impl <- function( + graph, + no, + weights = NULL, + which = c("lm", "la", "sa"), + type = c("default", "D-A", "DAD", "I-DAD", "OAP"), + scaled = TRUE, + options = arpack_defaults() +) { + # Argument checks + ensure_igraph(graph) + no <- as.numeric(no) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + which <- switch_igraph_arg(which, "lm" = 0L, "la" = 2L, "sa" = 3L) + type <- switch_igraph_arg(type, "default" = if (is_directed(graph)) 3L else 0L, + "da" = 0L, "d-a" = 0L, "idad" = 1L, "i-dad" = 1L, "dad" = 2L, + "oap" = 3L) + scaled <- as.logical(scaled) + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_laplacian_spectral_embedding, + graph, + no, + weights, + which, + type, + scaled, + options + ) + + res +} diff --git a/R/aaa-error.R b/R/aaa-error.R new file mode 100644 index 00000000000..922e038587d --- /dev/null +++ b/R/aaa-error.R @@ -0,0 +1,20 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== error-codes ==== + +strerror_impl <- function( + igraph_errno +) { + # Argument checks + igraph_errno <- as.numeric(igraph_errno) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_strerror, + igraph_errno + ) + + res +} diff --git a/R/aaa-flows.R b/R/aaa-flows.R new file mode 100644 index 00000000000..9ff1d5ef11a --- /dev/null +++ b/R/aaa-flows.R @@ -0,0 +1,714 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== cohesive-blocks ==== + +cohesive_blocks_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_cohesive_blocks, + graph + ) + if (igraph_opt("return.vs.es")) { + res$blocks <- lapply(res$blocks, unsafe_create_vs, graph = graph, verts = V(graph)) + } + class(res) <- "cohesiveBlocks" + res +} + +# ==== connectivity ==== + +edge_connectivity_impl <- function( + graph, + checks = TRUE +) { + # Argument checks + ensure_igraph(graph) + checks <- as.logical(checks) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_edge_connectivity, + graph, + checks + ) + + res +} + +st_edge_connectivity_impl <- function( + graph, + source, + target +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_st_edge_connectivity, + graph, + source - 1, + target - 1 + ) + + res +} + +st_vertex_connectivity_impl <- function( + graph, + source, + target, + neighbors = c("number_of_nodes", "error", "ignore", "negative") +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + neighbors <- switch_igraph_arg( + neighbors, + "error" = 0L, + "number_of_nodes" = 1L, + "ignore" = 2L, + "negative" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_st_vertex_connectivity, + graph, + source - 1, + target - 1, + neighbors + ) + + res +} + +vertex_connectivity_impl <- function( + graph, + checks = TRUE +) { + # Argument checks + ensure_igraph(graph) + checks <- as.logical(checks) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_vertex_connectivity, + graph, + checks + ) + + res +} + +# ==== cuts-and-minimum-cuts ==== + +all_st_cuts_impl <- function( + graph, + source, + target +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_all_st_cuts, + graph, + source - 1, + target - 1 + ) + if (igraph_opt("return.vs.es")) { + res$cuts <- lapply(res$cuts, unsafe_create_es, graph = graph, es = E(graph)) + } + if (igraph_opt("return.vs.es")) { + res$partition1s <- lapply(res$partition1s, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +all_st_mincuts_impl <- function( + graph, + source, + target, + capacity = NULL +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_all_st_mincuts, + graph, + source - 1, + target - 1, + capacity + ) + if (igraph_opt("return.vs.es")) { + res$cuts <- lapply(res$cuts, unsafe_create_es, graph = graph, es = E(graph)) + } + if (igraph_opt("return.vs.es")) { + res$partition1s <- lapply(res$partition1s, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +gomory_hu_tree_impl <- function( + graph, + capacity = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_gomory_hu_tree, + graph, + capacity + ) + + res +} + +mincut_impl <- function( + graph, + capacity = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_mincut, + graph, + capacity + ) + if (igraph_opt("return.vs.es")) { + res$partition1 <- create_vs(graph, res$partition1) + } + if (igraph_opt("return.vs.es")) { + res$partition2 <- create_vs(graph, res$partition2) + } + if (igraph_opt("return.vs.es")) { + res$cut <- create_es(graph, res$cut) + } + res +} + +mincut_value_impl <- function( + graph, + capacity = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_mincut_value, + graph, + capacity + ) + + res +} + +st_mincut_impl <- function( + graph, + source, + target, + capacity = NULL +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_st_mincut, + graph, + source - 1, + target - 1, + capacity + ) + if (igraph_opt("return.vs.es")) { + res$cut <- create_es(graph, res$cut) + } + if (igraph_opt("return.vs.es")) { + res$partition1 <- create_vs(graph, res$partition1) + } + if (igraph_opt("return.vs.es")) { + res$partition2 <- create_vs(graph, res$partition2) + } + res +} + +st_mincut_value_impl <- function( + graph, + source, + target, + capacity = NULL +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_st_mincut_value, + graph, + source - 1, + target - 1, + capacity + ) + + res +} + +# ==== edge-and-vertex-disjoint-paths ==== + +edge_disjoint_paths_impl <- function( + graph, + source, + target +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_edge_disjoint_paths, + graph, + source - 1, + target - 1 + ) + + res +} + +vertex_disjoint_paths_impl <- function( + graph, + source, + target +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_vertex_disjoint_paths, + graph, + source - 1, + target - 1 + ) + + res +} + +# ==== graph-adhesion-and-cohesion ==== + +adhesion_impl <- function( + graph, + checks = TRUE +) { + # Argument checks + ensure_igraph(graph) + checks <- as.logical(checks) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_adhesion, + graph, + checks + ) + + res +} + +cohesion_impl <- function( + graph, + checks = TRUE +) { + # Argument checks + ensure_igraph(graph) + checks <- as.logical(checks) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_cohesion, + graph, + checks + ) + + res +} + +# ==== maximum-flows ==== + +dominator_tree_impl <- function( + graph, + root, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + root <- as_igraph_vs(graph, root) + if (length(root) != 1) { + cli::cli_abort( + "{.arg root} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_dominator_tree, + graph, + root - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res$leftout <- create_vs(graph, res$leftout) + } + res +} + +maxflow_impl <- function( + graph, + source, + target, + capacity = NULL +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maxflow, + graph, + source - 1, + target - 1, + capacity + ) + if (igraph_opt("return.vs.es")) { + res$cut <- create_es(graph, res$cut) + } + if (igraph_opt("return.vs.es")) { + res$partition1 <- create_vs(graph, res$partition1) + } + if (igraph_opt("return.vs.es")) { + res$partition2 <- create_vs(graph, res$partition2) + } + res +} + +maxflow_value_impl <- function( + graph, + source, + target, + capacity = NULL +) { + # Argument checks + ensure_igraph(graph) + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maxflow_value, + graph, + source - 1, + target - 1, + capacity + ) + + res +} + +residual_graph_impl <- function( + graph, + capacity, + flow +) { + # Argument checks + ensure_igraph(graph) + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + flow <- as.numeric(flow) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_residual_graph, + graph, + capacity, + flow + ) + + res +} + +reverse_residual_graph_impl <- function( + graph, + capacity, + flow +) { + # Argument checks + ensure_igraph(graph) + if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) { + capacity <- E(graph)$capacity + } + if (!is.null(capacity) && !all(is.na(capacity))) { + capacity <- as.numeric(capacity) + } else { + capacity <- NULL + } + flow <- as.numeric(flow) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_reverse_residual_graph, + graph, + capacity, + flow + ) + + res +} diff --git a/R/aaa-foreign.R b/R/aaa-foreign.R new file mode 100644 index 00000000000..d9c7592c31f --- /dev/null +++ b/R/aaa-foreign.R @@ -0,0 +1,436 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== binary-formats ==== + +read_graph_graphdb_impl <- function( + instream, + directed = FALSE +) { + # Argument checks + check_string(instream) + + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_graphdb, + instream, + directed + ) + + res +} + +# ==== gml-format ==== + +read_graph_gml_impl <- function( + instream +) { + # Argument checks + check_string(instream) + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_gml, + instream + ) + + res +} + +write_graph_gml_impl <- function( + graph, + outstream, + options = c("default", "encode_only_quot"), + id, + creator = NULL +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + options <- switch_igraph_arg(options, "default" = 0L, "encode_only_quot" = 1L) + id <- as.numeric(id) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_gml, + graph, + outstream, + options, + id, + creator + ) + + res +} + +# ==== graphml-format ==== + +read_graph_graphml_impl <- function( + instream, + index = 0 +) { + # Argument checks + check_string(instream) + + index <- as.numeric(index) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_graphml, + instream, + index + ) + + res +} + +write_graph_graphml_impl <- function( + graph, + outstream, + prefixattr = TRUE +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + prefixattr <- as.logical(prefixattr) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_graphml, + graph, + outstream, + prefixattr + ) + + res +} + +# ==== graphviz-format ==== + +write_graph_dot_impl <- function( + graph, + outstream +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_dot, + graph, + outstream + ) + + res +} + +# ==== leda-format ==== + +write_graph_leda_impl <- function( + graph, + outstream, + names = "name", + weights = "weight" +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_leda, + graph, + outstream, + names, + weights + ) + + res +} + +# ==== pajek-format ==== + +read_graph_pajek_impl <- function( + instream +) { + # Argument checks + check_string(instream) + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_pajek, + instream + ) + + res +} + +write_graph_pajek_impl <- function( + graph, + outstream +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_pajek, + graph, + outstream + ) + + res +} + +# ==== simple-edge-list-and-similar-formats ==== + +read_graph_dimacs_flow_impl <- function( + instream, + directed = TRUE +) { + # Argument checks + check_string(instream) + + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_dimacs_flow, + instream, + directed + ) + + res +} + +read_graph_edgelist_impl <- function( + instream, + n = 0, + directed = TRUE +) { + # Argument checks + check_string(instream) + + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_edgelist, + instream, + n, + directed + ) + + res +} + +read_graph_lgl_impl <- function( + instream, + names = TRUE, + weights = TRUE, + directed = TRUE +) { + # Argument checks + check_string(instream) + + names <- as.logical(names) + weights <- switch_igraph_arg(weights, "no" = 0L, "yes" = 1L, "auto" = 2L) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_lgl, + instream, + names, + weights, + directed + ) + + res +} + +read_graph_ncol_impl <- function( + instream, + predefnames = NULL, + names = TRUE, + weights = TRUE, + directed = TRUE +) { + # Argument checks + check_string(instream) + + names <- as.logical(names) + weights <- switch_igraph_arg(weights, "no" = 0L, "yes" = 1L, "auto" = 2L) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_ncol, + instream, + predefnames, + names, + weights, + directed + ) + + res +} + +write_graph_dimacs_flow_impl <- function( + graph, + outstream, + source = 0, + target = 0, + capacity +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + source <- as_igraph_vs(graph, source) + if (length(source) != 1) { + cli::cli_abort( + "{.arg source} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + target <- as_igraph_vs(graph, target) + if (length(target) != 1) { + cli::cli_abort( + "{.arg target} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + capacity <- as.numeric(capacity) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_dimacs_flow, + graph, + outstream, + source - 1, + target - 1, + capacity + ) + + res +} + +write_graph_edgelist_impl <- function( + graph, + outstream +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_edgelist, + graph, + outstream + ) + + res +} + +write_graph_lgl_impl <- function( + graph, + outstream, + names = "name", + weights = "weight", + isolates = TRUE +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + isolates <- as.logical(isolates) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_lgl, + graph, + outstream, + names, + weights, + isolates + ) + + res +} + +write_graph_ncol_impl <- function( + graph, + outstream, + names = "name", + weights = "weight" +) { + # Argument checks + ensure_igraph(graph) + check_string(outstream) + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_write_graph_ncol, + graph, + outstream, + names, + weights + ) + + res +} + +# ==== ucinets-dl-file-format ==== + +read_graph_dl_impl <- function( + instream, + directed = TRUE +) { + # Argument checks + check_string(instream) + + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_read_graph_dl, + instream, + directed + ) + + res +} diff --git a/R/aaa-games.R b/R/aaa-games.R new file mode 100644 index 00000000000..3b1889b102b --- /dev/null +++ b/R/aaa-games.R @@ -0,0 +1,1145 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== degree-constrained-games ==== + +chung_lu_game_impl <- function( + out_weights, + in_weights = NULL, + ..., + loops = TRUE, + variant = c("original", "maxent", "nr") +) { + # Argument checks + check_dots_empty() + out_weights <- as.numeric(out_weights) + if (!is.null(in_weights)) { + in_weights <- as.numeric(in_weights) + } + loops <- as.logical(loops) + variant <- switch_igraph_arg(variant, "original" = 0L, "maxent" = 1L, "nr" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_chung_lu_game, + out_weights, + in_weights, + loops, + variant + ) + + if (igraph_opt("add.params")) { + res$name <- 'Chung-Lu model' + res$variant <- variant + } + + res +} + +degree_sequence_game_impl <- function( + out_deg, + in_deg = NULL, + method = c("configuration", "fast_heur_simple", "configuration_simple", "edge_switching_simple", "vl") +) { + # Argument checks + out_deg <- as.numeric(out_deg) + if (!is.null(in_deg)) { + in_deg <- as.numeric(in_deg) + } + method <- switch_igraph_arg( + method, + "configuration" = 0L, + "vl" = 1L, + "fast_heur_simple" = 2L, + "configuration_simple" = 3L, + "edge_switching_simple" = 4L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_degree_sequence_game, + out_deg, + in_deg, + method + ) + + res +} + +k_regular_game_impl <- function( + no_of_nodes, + k, + directed = FALSE, + multiple = FALSE +) { + # Argument checks + no_of_nodes <- as.numeric(no_of_nodes) + k <- as.numeric(k) + directed <- as.logical(directed) + multiple <- as.logical(multiple) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_k_regular_game, + no_of_nodes, + k, + directed, + multiple + ) + + if (igraph_opt("add.params")) { + res$name <- 'k-regular graph' + res$k <- k + } + + res +} + +rewire_impl <- function( + rewire, + n, + mode = c("simple", "simple_loops") +) { + # Argument checks + ensure_igraph(rewire) + n <- as.numeric(n) + mode <- switch_igraph_arg(mode, "simple" = 0L, "simple_loops" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_rewire, + rewire, + n, + mode + ) + + res +} + +static_fitness_game_impl <- function( + no_of_edges, + fitness_out, + fitness_in = NULL, + loops = FALSE, + multiple = FALSE +) { + # Argument checks + no_of_edges <- as.numeric(no_of_edges) + fitness_out <- as.numeric(fitness_out) + if (!is.null(fitness_in)) { + fitness_in <- as.numeric(fitness_in) + } + loops <- as.logical(loops) + multiple <- as.logical(multiple) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_static_fitness_game, + no_of_edges, + fitness_out, + fitness_in, + loops, + multiple + ) + + if (igraph_opt("add.params")) { + res$name <- 'Static fitness model' + res$loops <- loops + res$multiple <- multiple + } + + res +} + +static_power_law_game_impl <- function( + no_of_nodes, + no_of_edges, + exponent_out, + exponent_in = -1, + loops = FALSE, + multiple = FALSE, + finite_size_correction = TRUE +) { + # Argument checks + no_of_nodes <- as.numeric(no_of_nodes) + no_of_edges <- as.numeric(no_of_edges) + exponent_out <- as.numeric(exponent_out) + exponent_in <- as.numeric(exponent_in) + loops <- as.logical(loops) + multiple <- as.logical(multiple) + finite_size_correction <- as.logical(finite_size_correction) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_static_power_law_game, + no_of_nodes, + no_of_edges, + exponent_out, + exponent_in, + loops, + multiple, + finite_size_correction + ) + + if (igraph_opt("add.params")) { + res$name <- 'Static power law model' + res$exponent_out <- exponent_out + res$exponent_in <- exponent_in + res$loops <- loops + res$multiple <- multiple + res$finite_size_correction <- finite_size_correction + } + + res +} + +# ==== edge-rewiring-games ==== + +rewire_directed_edges_impl <- function( + graph, + prob, + loops = FALSE, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + prob <- as.numeric(prob) + loops <- as.logical(loops) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_rewire_directed_edges, + graph, + prob, + loops, + mode + ) + + res +} + +rewire_edges_impl <- function( + graph, + prob, + loops = FALSE, + multiple = FALSE +) { + # Argument checks + ensure_igraph(graph) + prob <- as.numeric(prob) + loops <- as.logical(loops) + multiple <- as.logical(multiple) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_rewire_edges, + graph, + prob, + loops, + multiple + ) + + res +} + +watts_strogatz_game_impl <- function( + dim, + size, + nei, + p, + loops = FALSE, + multiple = FALSE +) { + # Argument checks + dim <- as.numeric(dim) + size <- as.numeric(size) + nei <- as.numeric(nei) + p <- as.numeric(p) + loops <- as.logical(loops) + multiple <- as.logical(multiple) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_watts_strogatz_game, + dim, + size, + nei, + p, + loops, + multiple + ) + + res +} + +# ==== erdos-renyi-games ==== + +asymmetric_preference_game_impl <- function( + nodes, + out_types, + in_types, + type_dist_matrix, + pref_matrix, + loops = FALSE +) { + # Argument checks + nodes <- as.numeric(nodes) + out_types <- as.numeric(out_types) + in_types <- as.numeric(in_types) + type_dist_matrix[] <- as.numeric(type_dist_matrix) + pref_matrix[] <- as.numeric(pref_matrix) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_asymmetric_preference_game, + nodes, + out_types, + in_types, + type_dist_matrix, + pref_matrix, + loops + ) + + res +} + +correlated_game_impl <- function( + old_graph, + corr, + p = edge_density(old_graph), + permutation = NULL +) { + # Argument checks + ensure_igraph(old_graph) + corr <- as.numeric(corr) + p <- as.numeric(p) + if (!is.null(permutation)) { + permutation <- as.numeric(permutation) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_correlated_game, + old_graph, + corr, + p, + permutation + ) + + if (igraph_opt("add.params")) { + res$name <- 'Correlated random graph' + res$corr <- corr + res$p <- p + } + + res +} + +correlated_pair_game_impl <- function( + n, + corr, + p, + directed = FALSE, + permutation = NULL +) { + # Argument checks + n <- as.numeric(n) + corr <- as.numeric(corr) + p <- as.numeric(p) + directed <- as.logical(directed) + if (!is.null(permutation)) { + permutation <- as.numeric(permutation) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_correlated_pair_game, + n, + corr, + p, + directed, + permutation + ) + + res +} + +erdos_renyi_game_gnm_impl <- function( + n, + m, + directed = FALSE, + loops = FALSE +) { + # Argument checks + n <- as.numeric(n) + m <- as.numeric(m) + directed <- as.logical(directed) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_erdos_renyi_game_gnm, + n, + m, + directed, + loops + ) + + res +} + +erdos_renyi_game_gnp_impl <- function( + n, + p, + directed = FALSE, + loops = FALSE +) { + # Argument checks + n <- as.numeric(n) + p <- as.numeric(p) + directed <- as.logical(directed) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_erdos_renyi_game_gnp, + n, + p, + directed, + loops + ) + + res +} + +hsbm_game_impl <- function( + n, + m, + rho, + C, + p +) { + # Argument checks + n <- as.numeric(n) + m <- as.numeric(m) + rho <- as.numeric(rho) + C[] <- as.numeric(C) + p <- as.numeric(p) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hsbm_game, + n, + m, + rho, + C, + p + ) + + if (igraph_opt("add.params")) { + res$name <- 'Hierarchical stochastic block model' + res$m <- m + res$rho <- rho + res$C <- C + res$p <- p + } + + res +} + +hsbm_list_game_impl <- function( + n, + mlist, + rholist, + Clist, + p +) { + # Argument checks + n <- as.numeric(n) + mlist <- as.numeric(mlist) + if (!is.list(Clist)) { + cli::cli_abort("{.arg Clist} must be a list of matrices") + } + Clist <- lapply(Clist, function(m) { + if (!is.matrix(m)) { + cli::cli_abort("{.arg Clist} must be a list of matrices") + } + m[] <- as.numeric(m) + m + }) + p <- as.numeric(p) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hsbm_list_game, + n, + mlist, + rholist, + Clist, + p + ) + + if (igraph_opt("add.params")) { + res$name <- 'Hierarchical stochastic block model' + res$p <- p + } + + res +} + +preference_game_impl <- function( + nodes, + types, + type_dist, + fixed_sizes = FALSE, + pref_matrix, + directed = FALSE, + loops = FALSE +) { + # Argument checks + nodes <- as.numeric(nodes) + types <- as.numeric(types) + type_dist <- as.numeric(type_dist) + fixed_sizes <- as.logical(fixed_sizes) + pref_matrix[] <- as.numeric(pref_matrix) + directed <- as.logical(directed) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_preference_game, + nodes, + types, + type_dist, + fixed_sizes, + pref_matrix, + directed, + loops + ) + + res +} + +sbm_game_impl <- function( + n, + pref_matrix, + block_sizes, + directed = FALSE, + loops = FALSE +) { + # Argument checks + n <- as.numeric(n) + pref_matrix[] <- as.numeric(pref_matrix) + block_sizes <- as.numeric(block_sizes) + directed <- as.logical(directed) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sbm_game, + n, + pref_matrix, + block_sizes, + directed, + loops + ) + + if (igraph_opt("add.params")) { + res$name <- 'Stochastic block model' + res$loops <- loops + } + + res +} + +# ==== growing-random-games ==== + +callaway_traits_game_impl <- function( + nodes, + types, + edges_per_step = 1, + type_dist, + pref_matrix, + directed = FALSE +) { + # Argument checks + nodes <- as.numeric(nodes) + types <- as.numeric(types) + edges_per_step <- as.numeric(edges_per_step) + type_dist <- as.numeric(type_dist) + pref_matrix[] <- as.numeric(pref_matrix) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_callaway_traits_game, + nodes, + types, + edges_per_step, + type_dist, + pref_matrix, + directed + ) + + res +} + +cited_type_game_impl <- function( + nodes, + types, + pref, + edges_per_step = 1, + directed = TRUE +) { + # Argument checks + nodes <- as.numeric(nodes) + types <- as.numeric(types) - 1 + pref <- as.numeric(pref) + edges_per_step <- as.numeric(edges_per_step) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_cited_type_game, + nodes, + types, + pref, + edges_per_step, + directed + ) + + res +} + +citing_cited_type_game_impl <- function( + nodes, + types, + pref, + edges_per_step = 1, + directed = TRUE +) { + # Argument checks + nodes <- as.numeric(nodes) + types <- as.numeric(types) - 1 + pref[] <- as.numeric(pref) + edges_per_step <- as.numeric(edges_per_step) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_citing_cited_type_game, + nodes, + types, + pref, + edges_per_step, + directed + ) + + res +} + +establishment_game_impl <- function( + nodes, + types, + k = 1, + type_dist, + pref_matrix, + directed = TRUE +) { + # Argument checks + nodes <- as.numeric(nodes) + types <- as.numeric(types) + k <- as.numeric(k) + type_dist <- as.numeric(type_dist) + pref_matrix[] <- as.numeric(pref_matrix) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_establishment_game, + nodes, + types, + k, + type_dist, + pref_matrix, + directed + ) + + res +} + +forest_fire_game_impl <- function( + nodes, + fw_prob, + bw_factor = 1, + ambs = 1, + directed = TRUE +) { + # Argument checks + nodes <- as.numeric(nodes) + fw_prob <- as.numeric(fw_prob) + bw_factor <- as.numeric(bw_factor) + ambs <- as.numeric(ambs) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_forest_fire_game, + nodes, + fw_prob, + bw_factor, + ambs, + directed + ) + + if (igraph_opt("add.params")) { + res$name <- 'Forest fire model' + res$fw_prob <- fw_prob + res$bw_factor <- bw_factor + res$ambs <- ambs + } + + res +} + +growing_random_game_impl <- function( + n, + m = 1, + ..., + directed = TRUE, + citation = FALSE +) { + # Argument checks + check_dots_empty() + n <- as.numeric(n) + m <- as.numeric(m) + directed <- as.logical(directed) + citation <- as.logical(citation) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_growing_random_game, + n, + m, + directed, + citation + ) + + if (igraph_opt("add.params")) { + res$name <- 'Growing random graph' + res$m <- m + res$citation <- citation + } + + res +} + +# ==== other-random-games ==== + +dot_product_game_impl <- function( + vecs, + directed = FALSE +) { + # Argument checks + vecs[] <- as.numeric(vecs) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_dot_product_game, + vecs, + directed + ) + + res +} + +grg_game_impl <- function( + nodes, + radius, + torus = FALSE +) { + # Argument checks + nodes <- as.numeric(nodes) + radius <- as.numeric(radius) + torus <- as.logical(torus) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_grg_game, + nodes, + radius, + torus + ) + + res +} + +simple_interconnected_islands_game_impl <- function( + islands_n, + islands_size, + islands_pin, + n_inter +) { + # Argument checks + islands_n <- as.numeric(islands_n) + islands_size <- as.numeric(islands_size) + islands_pin <- as.numeric(islands_pin) + n_inter <- as.numeric(n_inter) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_simple_interconnected_islands_game, + islands_n, + islands_size, + islands_pin, + n_inter + ) + + if (igraph_opt("add.params")) { + res$name <- 'Interconnected islands model' + res$islands_n <- islands_n + res$islands_size <- islands_size + res$islands_pin <- islands_pin + res$n_inter <- n_inter + } + + res +} + +tree_game_impl <- function( + n, + directed = FALSE, + method = c("lerw", "prufer") +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + method <- switch_igraph_arg(method, "prufer" = 0L, "lerw" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_tree_game, + n, + directed, + method + ) + + res +} + +# ==== preferential-attachment-games ==== + +barabasi_aging_game_impl <- function( + nodes, + m = 1, + outseq = NULL, + outpref = FALSE, + pa_exp = 1.0, + aging_exp = 0.0, + aging_bin = 1, + zero_deg_appeal = 1.0, + zero_age_appeal = 0.0, + deg_coef = 1.0, + age_coef = 1.0, + directed = TRUE +) { + # Argument checks + nodes <- as.numeric(nodes) + m <- as.numeric(m) + if (!is.null(outseq)) { + outseq <- as.numeric(outseq) + } + outpref <- as.logical(outpref) + pa_exp <- as.numeric(pa_exp) + aging_exp <- as.numeric(aging_exp) + aging_bin <- as.numeric(aging_bin) + zero_deg_appeal <- as.numeric(zero_deg_appeal) + zero_age_appeal <- as.numeric(zero_age_appeal) + deg_coef <- as.numeric(deg_coef) + age_coef <- as.numeric(age_coef) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_barabasi_aging_game, + nodes, + m, + outseq, + outpref, + pa_exp, + aging_exp, + aging_bin, + zero_deg_appeal, + zero_age_appeal, + deg_coef, + age_coef, + directed + ) + + res +} + +barabasi_game_impl <- function( + n, + power = 1.0, + m = 1, + outseq = NULL, + outpref = FALSE, + A = 1.0, + directed = TRUE, + algo = c("bag", "psumtree", "psumtree_multiple"), + start_from = NULL +) { + # Argument checks + n <- as.numeric(n) + power <- as.numeric(power) + m <- as.numeric(m) + if (!is.null(outseq)) { + outseq <- as.numeric(outseq) + } + outpref <- as.logical(outpref) + A <- as.numeric(A) + directed <- as.logical(directed) + algo <- switch_igraph_arg(algo, "bag" = 0L, "psumtree" = 1L, "psumtree_multiple" = 2L) + if (!is.null(start_from)) { + ensure_igraph(start_from) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_barabasi_game, + n, + power, + m, + outseq, + outpref, + A, + directed, + algo, + start_from + ) + + res +} + +lastcit_game_impl <- function( + nodes, + edges_per_node = 1, + agebins = 1, + preference, + directed = TRUE +) { + # Argument checks + nodes <- as.numeric(nodes) + edges_per_node <- as.numeric(edges_per_node) + agebins <- as.numeric(agebins) + preference <- as.numeric(preference) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_lastcit_game, + nodes, + edges_per_node, + agebins, + preference, + directed + ) + + res +} + +recent_degree_aging_game_impl <- function( + nodes, + m = 1, + outseq = NULL, + outpref = FALSE, + pa_exp = 1.0, + aging_exp = 0.0, + aging_bin = 1, + window = 1, + zero_appeal = 1.0, + directed = TRUE +) { + # Argument checks + nodes <- as.numeric(nodes) + m <- as.numeric(m) + if (!is.null(outseq)) { + outseq <- as.numeric(outseq) + } + outpref <- as.logical(outpref) + pa_exp <- as.numeric(pa_exp) + aging_exp <- as.numeric(aging_exp) + aging_bin <- as.numeric(aging_bin) + window <- as.numeric(window) + zero_appeal <- as.numeric(zero_appeal) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_recent_degree_aging_game, + nodes, + m, + outseq, + outpref, + pa_exp, + aging_exp, + aging_bin, + window, + zero_appeal, + directed + ) + + res +} + +recent_degree_game_impl <- function( + n, + power = 1.0, + window = 1, + m = 1, + outseq = NULL, + outpref = FALSE, + zero_appeal = 1.0, + directed = TRUE +) { + # Argument checks + n <- as.numeric(n) + power <- as.numeric(power) + window <- as.numeric(window) + m <- as.numeric(m) + if (!is.null(outseq)) { + outseq <- as.numeric(outseq) + } + outpref <- as.logical(outpref) + zero_appeal <- as.numeric(zero_appeal) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_recent_degree_game, + n, + power, + window, + m, + outseq, + outpref, + zero_appeal, + directed + ) + + res +} + +# ==== random-vectors ==== + +sample_dirichlet_impl <- function( + n, + alpha +) { + # Argument checks + n <- as.numeric(n) + alpha <- as.numeric(alpha) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sample_dirichlet, + n, + alpha + ) + + res +} + +sample_sphere_surface_impl <- function( + dim, + n = 1, + radius = 1, + positive = TRUE +) { + # Argument checks + dim <- as.numeric(dim) + n <- as.numeric(n) + radius <- as.numeric(radius) + positive <- as.logical(positive) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sample_sphere_surface, + dim, + n, + radius, + positive + ) + + res +} + +sample_sphere_volume_impl <- function( + dim, + n = 1, + radius = 1, + positive = TRUE +) { + # Argument checks + dim <- as.numeric(dim) + n <- as.numeric(n) + radius <- as.numeric(radius) + positive <- as.logical(positive) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sample_sphere_volume, + dim, + n, + radius, + positive + ) + + res +} diff --git a/R/aaa-generators.R b/R/aaa-generators.R new file mode 100644 index 00000000000..09bf075a9ad --- /dev/null +++ b/R/aaa-generators.R @@ -0,0 +1,881 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== adjacency-generators ==== + +adjacency_impl <- function( + adjmatrix, + mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), + loops = c("once", "none", "twice") +) { + # Argument checks + adjmatrix[] <- as.numeric(adjmatrix) + mode <- switch_igraph_arg( + mode, + "directed" = 0L, + "undirected" = 1L, + "upper" = 2L, + "lower" = 3L, + "min" = 4L, + "plus" = 5L, + "max" = 6L + ) + loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_adjacency, + adjmatrix, + mode, + loops + ) + + res +} + +adjlist_impl <- function( + adjlist, + mode = c("out", "in", "all", "total"), + duplicate = TRUE +) { + # Argument checks + adjlist <- lapply(adjlist, function(x) as.numeric(x) - 1) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + duplicate <- as.logical(duplicate) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_adjlist, + adjlist, + mode, + duplicate + ) + + res +} + +sparse_adjacency_impl <- function( + adjmatrix, + mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), + loops = c("once", "none", "twice") +) { + # Argument checks + requireNamespace("Matrix", quietly = TRUE) + adjmatrix <- as(as(as(adjmatrix, "dMatrix"), "generalMatrix"), "CsparseMatrix") + mode <- switch_igraph_arg( + mode, + "directed" = 0L, + "undirected" = 1L, + "upper" = 2L, + "lower" = 3L, + "min" = 4L, + "plus" = 5L, + "max" = 6L + ) + loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sparse_adjacency, + adjmatrix, + mode, + loops + ) + + res +} + +sparse_weighted_adjacency_impl <- function( + adjmatrix, + mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), + loops = c("once", "none", "twice") +) { + # Argument checks + requireNamespace("Matrix", quietly = TRUE) + adjmatrix <- as(as(as(adjmatrix, "dMatrix"), "generalMatrix"), "CsparseMatrix") + mode <- switch_igraph_arg( + mode, + "directed" = 0L, + "undirected" = 1L, + "upper" = 2L, + "lower" = 3L, + "min" = 4L, + "plus" = 5L, + "max" = 6L + ) + loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sparse_weighted_adjacency, + adjmatrix, + mode, + loops + ) + + res +} + +weighted_adjacency_impl <- function( + adjmatrix, + mode = c("directed", "undirected", "upper", "lower", "min", "plus", "max"), + loops = c("once", "none", "twice") +) { + # Argument checks + adjmatrix[] <- as.numeric(adjmatrix) + mode <- switch_igraph_arg( + mode, + "directed" = 0L, + "undirected" = 1L, + "upper" = 2L, + "lower" = 3L, + "min" = 4L, + "plus" = 5L, + "max" = 6L + ) + loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_weighted_adjacency, + adjmatrix, + mode, + loops + ) + + res +} + +weighted_sparsemat_impl <- function( + A, + directed, + attr, + loops = FALSE +) { + # Argument checks + requireNamespace("Matrix", quietly = TRUE) + A <- as(as(as(A, "dMatrix"), "generalMatrix"), "CsparseMatrix") + directed <- as.logical(directed) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_weighted_sparsemat, + A, + directed, + attr, + loops + ) + + res +} + +# ==== basic-generators ==== + +create_impl <- function( + edges, + n = 0, + directed = TRUE +) { + # Argument checks + edges <- as.numeric(edges) + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_create, + edges, + n, + directed + ) + + res +} + +# ==== complete-graph-generators ==== + +full_citation_impl <- function( + n, + directed = TRUE +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_full_citation, + n, + directed + ) + + res +} + +full_impl <- function( + n, + directed = FALSE, + loops = FALSE +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_full, + n, + directed, + loops + ) + + res +} + +full_multipartite_impl <- function( + n, + directed = FALSE, + mode = c("all", "out", "in", "total") +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_full_multipartite, + n, + directed, + mode + ) + + if (igraph_opt("add.params")) { + res$name <- 'Full multipartite graph' + res$n <- n + res$mode <- mode + } + + res +} + +turan_impl <- function( + n, + r +) { + # Argument checks + n <- as.numeric(n) + r <- as.numeric(r) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_turan, + n, + r + ) + + if (igraph_opt("add.params")) { + res$name <- 'Turan graph' + res$n <- n + res$r <- r + } + + res +} + +# ==== degree-graph-generators ==== + +realize_bipartite_degree_sequence_impl <- function( + degrees1, + degrees2, + allowed_edge_types = c("simple", "loops", "multi", "all"), + method = c("smallest", "largest", "index") +) { + # Argument checks + degrees1 <- as.numeric(degrees1) + degrees2 <- as.numeric(degrees2) + allowed_edge_types <- switch_igraph_arg( + allowed_edge_types, + "simple" = 0L, + "loop" = 1L, + "loops" = 1L, + "multi" = 6L, + "multiple" = 6L, + "all" = 7L + ) + method <- switch_igraph_arg(method, "smallest" = 0L, "largest" = 1L, "index" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_realize_bipartite_degree_sequence, + degrees1, + degrees2, + allowed_edge_types, + method + ) + + if (igraph_opt("add.params")) { + res$name <- 'Bipartite graph from degree sequence' + res$degrees1 <- degrees1 + res$degrees2 <- degrees2 + res$allowed_edge_types <- allowed_edge_types + res$method <- method + } + + res +} + +realize_degree_sequence_impl <- function( + out_deg, + in_deg = NULL, + allowed_edge_types = c("simple", "loops", "multi", "all"), + method = c("smallest", "largest", "index") +) { + # Argument checks + out_deg <- as.numeric(out_deg) + if (!is.null(in_deg)) { + in_deg <- as.numeric(in_deg) + } + allowed_edge_types <- switch_igraph_arg( + allowed_edge_types, + "simple" = 0L, + "loop" = 1L, + "loops" = 1L, + "multi" = 6L, + "multiple" = 6L, + "all" = 7L + ) + method <- switch_igraph_arg(method, "smallest" = 0L, "largest" = 1L, "index" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_realize_degree_sequence, + out_deg, + in_deg, + allowed_edge_types, + method + ) + + if (igraph_opt("add.params")) { + res$name <- 'Graph from degree sequence' + res$out_deg <- out_deg + res$in_deg <- in_deg + res$allowed_edge_types <- allowed_edge_types + res$method <- method + } + + res +} + +# ==== other-generators ==== + +de_bruijn_impl <- function( + m, + n +) { + # Argument checks + m <- as.numeric(m) + n <- as.numeric(n) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_de_bruijn, + m, + n + ) + + res +} + +generalized_petersen_impl <- function( + n, + k +) { + # Argument checks + n <- as.numeric(n) + k <- as.numeric(k) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_generalized_petersen, + n, + k + ) + + res +} + +kautz_impl <- function( + m, + n +) { + # Argument checks + m <- as.numeric(m) + n <- as.numeric(n) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_kautz, + m, + n + ) + + res +} + +mycielski_graph_impl <- function( + k +) { + # Argument checks + k <- as.numeric(k) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_mycielski_graph, + k + ) + + res +} + +# ==== pre-defined-generators ==== + +atlas_impl <- function( + number = 0 +) { + # Argument checks + number <- as.numeric(number) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_atlas, + number + ) + + res +} + +famous_impl <- function( + name +) { + # Argument checks + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_famous, + name + ) + + res +} + +# ==== regular-structure-generators ==== + +circulant_impl <- function( + n, + shifts, + directed = FALSE +) { + # Argument checks + n <- as.numeric(n) + shifts <- as.numeric(shifts) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_circulant, + n, + shifts, + directed + ) + + if (igraph_opt("add.params")) { + res$name <- 'Circulant graph' + res$shifts <- shifts + } + + res +} + +cycle_graph_impl <- function( + n, + directed = FALSE, + mutual = FALSE +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + mutual <- as.logical(mutual) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_cycle_graph, + n, + directed, + mutual + ) + + res +} + +extended_chordal_ring_impl <- function( + nodes, + W, + directed = FALSE +) { + # Argument checks + nodes <- as.numeric(nodes) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_extended_chordal_ring, + nodes, + W, + directed + ) + + res +} + +hypercube_impl <- function( + n, + directed = FALSE +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hypercube, + n, + directed + ) + + res +} + +lcf_vector_impl <- function( + n, + shifts, + repeats = 1 +) { + # Argument checks + n <- as.numeric(n) + shifts <- as.numeric(shifts) + repeats <- as.numeric(repeats) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_lcf_vector, + n, + shifts, + repeats + ) + + if (igraph_opt("add.params")) { + res$name <- 'LCF graph' + } + + res +} + +path_graph_impl <- function( + n, + directed = FALSE, + mutual = FALSE +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + mutual <- as.logical(mutual) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_path_graph, + n, + directed, + mutual + ) + + res +} + +ring_impl <- function( + n, + directed = FALSE, + mutual = FALSE, + circular = TRUE +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + mutual <- as.logical(mutual) + circular <- as.logical(circular) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_ring, + n, + directed, + mutual, + circular + ) + + res +} + +square_lattice_impl <- function( + dimvector, + nei = 1, + directed = FALSE, + mutual = FALSE, + periodic = NULL +) { + # Argument checks + dimvector <- as.numeric(dimvector) + nei <- as.numeric(nei) + directed <- as.logical(directed) + mutual <- as.logical(mutual) + if (!is.null(periodic)) { + periodic <- as.logical(periodic) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_square_lattice, + dimvector, + nei, + directed, + mutual, + periodic + ) + + res +} + +star_impl <- function( + n, + mode = c("out", "in", "undirected", "mutual"), + center = 0 +) { + # Argument checks + n <- as.numeric(n) + mode <- switch_igraph_arg( + mode, + "out" = 0L, + "in" = 1L, + "undirected" = 2L, + "mutual" = 3L + ) + center <- as.numeric(center) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_star, + n, + mode, + center + ) + + res +} + +triangular_lattice_impl <- function( + dimvector, + directed = FALSE, + mutual = FALSE +) { + # Argument checks + dimvector <- as.numeric(dimvector) + directed <- as.logical(directed) + mutual <- as.logical(mutual) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_triangular_lattice, + dimvector, + directed, + mutual + ) + + res +} + +wheel_impl <- function( + n, + mode = c("out", "in", "undirected", "mutual"), + center = 0 +) { + # Argument checks + n <- as.numeric(n) + mode <- switch_igraph_arg( + mode, + "out" = 0L, + "in" = 1L, + "undirected" = 2L, + "mutual" = 3L + ) + center <- as.numeric(center) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_wheel, + n, + mode, + center + ) + + res +} + +# ==== tree-generators ==== + +from_prufer_impl <- function( + prufer +) { + # Argument checks + prufer <- as.numeric(prufer) - 1 + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_from_prufer, + prufer + ) + + if (igraph_opt("add.params")) { + res$name <- 'Tree from Prufer sequence' + res$prufer <- prufer + } + + res +} + +kary_tree_impl <- function( + n, + children = 2, + type = c("out", "in", "undirected") +) { + # Argument checks + n <- as.numeric(n) + children <- as.numeric(children) + type <- switch_igraph_arg(type, "out" = 0L, "in" = 1L, "undirected" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_kary_tree, + n, + children, + type + ) + + res +} + +regular_tree_impl <- function( + h, + k = 3, + type = c("undirected", "out", "in") +) { + # Argument checks + h <- as.numeric(h) + k <- as.numeric(k) + type <- switch_igraph_arg(type, "out" = 0L, "in" = 1L, "undirected" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_regular_tree, + h, + k, + type + ) + + res +} + +symmetric_tree_impl <- function( + branches, + type = c("out", "in", "undirected") +) { + # Argument checks + branches <- as.numeric(branches) + type <- switch_igraph_arg(type, "out" = 0L, "in" = 1L, "undirected" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_symmetric_tree, + branches, + type + ) + + res +} + +tree_from_parent_vector_impl <- function( + parents, + type = c("out", "in", "undirected") +) { + # Argument checks + parents <- as.numeric(parents) - 1 + type <- switch_igraph_arg(type, "out" = 0L, "in" = 1L, "undirected" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_tree_from_parent_vector, + parents, + type + ) + + res +} diff --git a/R/aaa-graphlets.R b/R/aaa-graphlets.R new file mode 100644 index 00000000000..e9604885b0c --- /dev/null +++ b/R/aaa-graphlets.R @@ -0,0 +1,106 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== performing-graphlet-decomposition ==== + +graphlets_candidate_basis_impl <- function( + graph, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_graphlets_candidate_basis, + graph, + weights + ) + if (igraph_opt("return.vs.es")) { + res$cliques <- lapply(res$cliques, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +graphlets_impl <- function( + graph, + weights = NULL, + niter = 1000 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + niter <- as.numeric(niter) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_graphlets, + graph, + weights, + niter + ) + if (igraph_opt("return.vs.es")) { + res$cliques <- lapply(res$cliques, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +graphlets_project_impl <- function( + graph, + weights = NULL, + cliques, + Muc, + startMu = FALSE, + niter = 1000 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(cliques) && !is.list(cliques)) { + cli::cli_abort( + "{.arg cliques} must be a list or NULL", + call = rlang::caller_env() + ) + } + Muc <- as.numeric(Muc) + startMu <- as.logical(startMu) + niter <- as.numeric(niter) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_graphlets_project, + graph, + weights, + if (!is.null(cliques)) lapply(cliques, function(.x) .x - 1), + Muc, + startMu, + niter + ) + + res +} diff --git a/R/aaa-hrg.R b/R/aaa-hrg.R new file mode 100644 index 00000000000..9d6ebbbab93 --- /dev/null +++ b/R/aaa-hrg.R @@ -0,0 +1,245 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== conversion-to-and-from-igraph-graphs ==== + +from_hrg_dendrogram_impl <- function( + hrg +) { + # Argument checks + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_from_hrg_dendrogram, + hrg + ) + + res +} + +hrg_create_impl <- function( + graph, + prob +) { + # Argument checks + ensure_igraph(graph) + prob <- as.numeric(prob) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_create, + graph, + prob + ) + + class(res) <- "igraphHRG" + res +} + +# ==== fitting-hrgs ==== + +hrg_consensus_impl <- function( + graph, + hrg = NULL, + start = FALSE, + num_samples = 10000 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + start <- as.logical(start) + num_samples <- as.numeric(num_samples) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_consensus, + graph, + hrg, + start, + num_samples + ) + + res +} + +hrg_fit_impl <- function( + graph, + hrg = NULL, + start = FALSE, + steps = 0 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + start <- as.logical(start) + steps <- as.numeric(steps) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_fit, + graph, + hrg, + start, + steps + ) + + res +} + +# ==== hrg-sampling ==== + +hrg_game_impl <- function( + hrg +) { + # Argument checks + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_game, + hrg + ) + + if (igraph_opt("add.params")) { + res$name <- 'Hierarchical random graph model' + } + + res +} + +hrg_sample_impl <- function( + hrg +) { + # Argument checks + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_sample, + hrg + ) + + res +} + +hrg_sample_many_impl <- function( + hrg, + num_samples +) { + # Argument checks + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + num_samples <- as.numeric(num_samples) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_sample_many, + hrg, + num_samples + ) + + res +} + +# ==== predicting-missing-edges ==== + +hrg_predict_impl <- function( + graph, + hrg = NULL, + start = FALSE, + num_samples = 10000, + num_bins = 25 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + start <- as.logical(start) + num_samples <- as.numeric(num_samples) + num_bins <- as.numeric(num_bins) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_predict, + graph, + hrg, + start, + num_samples, + num_bins + ) + if (igraph_opt("return.vs.es")) { + res$edges <- create_vs(graph, res$edges) + } + res +} + +# ==== representing-hrgs ==== + +hrg_resize_impl <- function( + hrg, + newsize +) { + # Argument checks + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + newsize <- as.numeric(newsize) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_resize, + hrg, + newsize + ) + + res +} + +hrg_size_impl <- function( + hrg +) { + # Argument checks + if (is.null(hrg)) { + hrg <- list(left = c(), right = c(), prob = c(), edges = c(), vertices = c()) + } + hrg <- lapply(hrg[c("left","right","prob","edges","vertices")], as.numeric) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hrg_size, + hrg + ) + + res +} diff --git a/R/aaa-isomorphism.R b/R/aaa-isomorphism.R new file mode 100644 index 00000000000..343419a9d95 --- /dev/null +++ b/R/aaa-isomorphism.R @@ -0,0 +1,957 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== bliss-algorithm ==== + +isomorphic_bliss_impl <- function( + graph1, + graph2, + colors1 = NULL, + colors2 = NULL, + sh = c("fm", "f", "fs", "fl", "flm", "fsm") +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(colors1)) { + if ("color" %in% vertex_attr_names(graph1)) { + colors1 <- V(graph1)$color + } else { + colors1 <- NULL + } + } + if (!is.null(colors1)) { + colors1 <- as.numeric(colors1) - 1 + } + if (is_missing(colors2)) { + if ("color" %in% vertex_attr_names(graph2)) { + colors2 <- V(graph2)$color + } else { + colors2 <- NULL + } + } + if (!is.null(colors2)) { + colors2 <- as.numeric(colors2) - 1 + } + sh <- switch_igraph_arg( + sh, + "f" = 0L, + "fl" = 1L, + "fs" = 2L, + "fm" = 3L, + "flm" = 4L, + "fsm" = 5L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_isomorphic_bliss, + graph1, + graph2, + colors1, + colors2, + sh + ) + + res +} + +# ==== functions-for-graphs-with-3-or-4-vertices ==== + +graph_count_impl <- function( + n, + directed = FALSE +) { + # Argument checks + n <- as.numeric(n) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_graph_count, + n, + directed + ) + + res +} + +isoclass_create_impl <- function( + size, + number, + directed = TRUE +) { + # Argument checks + size <- as.numeric(size) + number <- as.numeric(number) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_isoclass_create, + size, + number, + directed + ) + + res +} + +isoclass_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_isoclass, + graph + ) + + res +} + +isoclass_subgraph_impl <- function( + graph, + vids +) { + # Argument checks + ensure_igraph(graph) + vids <- as.numeric(vids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_isoclass_subgraph, + graph, + vids + ) + + res +} + +# ==== isomorphism-simple-interface ==== + +automorphism_group_impl <- function( + graph, + colors = NULL, + sh = c("fm", "f", "fs", "fl", "flm", "fsm"), + details = FALSE +) { + # Argument checks + ensure_igraph(graph) + if (is_missing(colors)) { + if ("color" %in% vertex_attr_names(graph)) { + colors <- V(graph)$color + } else { + colors <- NULL + } + } + if (!is.null(colors)) { + colors <- as.numeric(colors) - 1 + } + sh <- switch_igraph_arg( + sh, + "f" = 0L, + "fl" = 1L, + "fs" = 2L, + "fm" = 3L, + "flm" = 4L, + "fsm" = 5L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_automorphism_group, + graph, + colors, + sh + ) + if (igraph_opt("return.vs.es")) { + res$generators <- lapply(res$generators, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (!details) { + res <- res$generators + } + res +} + +canonical_permutation_impl <- function( + graph, + colors = NULL, + sh = c("fm", "f", "fs", "fl", "flm", "fsm") +) { + # Argument checks + ensure_igraph(graph) + if (is_missing(colors)) { + if ("color" %in% vertex_attr_names(graph)) { + colors <- V(graph)$color + } else { + colors <- NULL + } + } + if (!is.null(colors)) { + colors <- as.numeric(colors) - 1 + } + sh <- switch_igraph_arg( + sh, + "f" = 0L, + "fl" = 1L, + "fs" = 2L, + "fm" = 3L, + "flm" = 4L, + "fsm" = 5L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_canonical_permutation, + graph, + colors, + sh + ) + + res +} + +count_automorphisms_impl <- function( + graph, + colors = NULL, + sh = c("fm", "f", "fs", "fl", "flm", "fsm") +) { + # Argument checks + ensure_igraph(graph) + if (is_missing(colors)) { + if ("color" %in% vertex_attr_names(graph)) { + colors <- V(graph)$color + } else { + colors <- NULL + } + } + if (!is.null(colors)) { + colors <- as.numeric(colors) - 1 + } + sh <- switch_igraph_arg( + sh, + "f" = 0L, + "fl" = 1L, + "fs" = 2L, + "fm" = 3L, + "flm" = 4L, + "fsm" = 5L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_count_automorphisms, + graph, + colors, + sh + ) + + res +} + +isomorphic_impl <- function( + graph1, + graph2 +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_isomorphic, + graph1, + graph2 + ) + + res +} + +subisomorphic_impl <- function( + graph1, + graph2 +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_subisomorphic, + graph1, + graph2 + ) + + res +} + +# ==== isomorphism-utility-functions ==== + +permute_vertices_impl <- function( + graph, + permutation +) { + # Argument checks + ensure_igraph(graph) + permutation <- as.numeric(permutation) - 1 + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_permute_vertices, + graph, + permutation + ) + + res +} + +simplify_and_colorize_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_simplify_and_colorize, + graph + ) + + res +} + +# ==== lad-algorithm ==== + +subisomorphic_lad_impl <- function( + pattern, + target, + domains = NULL, + induced, + time_limit +) { + # Argument checks + ensure_igraph(pattern) + ensure_igraph(target) + if (!is.null(domains) && !is.list(domains)) { + cli::cli_abort( + "{.arg domains} must be a list or NULL", + call = rlang::caller_env() + ) + } + induced <- as.logical(induced) + time_limit <- as.numeric(time_limit) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_subisomorphic_lad, + pattern, + target, + if (!is.null(domains)) lapply(domains, function(.x) .x - 1), + induced, + time_limit + ) + + res +} + +# ==== vf2-algorithm ==== + +count_isomorphisms_vf2_impl <- function( + graph1, + graph2, + vertex_color1 = NULL, + vertex_color2 = NULL, + edge_color1 = NULL, + edge_color2 = NULL +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(vertex_color1)) { + if ("color" %in% vertex_attr_names(graph1)) { + vertex_color1 <- V(graph1)$color + } else { + vertex_color1 <- NULL + } + } + if (!is.null(vertex_color1)) { + vertex_color1 <- as.numeric(vertex_color1) - 1 + } + if (is_missing(vertex_color2)) { + if ("color" %in% vertex_attr_names(graph2)) { + vertex_color2 <- V(graph2)$color + } else { + vertex_color2 <- NULL + } + } + if (!is.null(vertex_color2)) { + vertex_color2 <- as.numeric(vertex_color2) - 1 + } + if (is_missing(edge_color1)) { + if ("color" %in% edge_attr_names(graph1)) { + edge_color1 <- E(graph1)$color + } else { + edge_color1 <- NULL + } + } + if (!is.null(edge_color1)) { + edge_color1 <- as.numeric(edge_color1) - 1 + } + if (is_missing(edge_color2)) { + if ("color" %in% edge_attr_names(graph2)) { + edge_color2 <- E(graph2)$color + } else { + edge_color2 <- NULL + } + } + if (!is.null(edge_color2)) { + edge_color2 <- as.numeric(edge_color2) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_count_isomorphisms_vf2, + graph1, + graph2, + vertex_color1, + vertex_color2, + edge_color1, + edge_color2 + ) + + res +} + +count_subisomorphisms_vf2_impl <- function( + graph1, + graph2, + vertex_color1 = NULL, + vertex_color2 = NULL, + edge_color1 = NULL, + edge_color2 = NULL +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(vertex_color1)) { + if ("color" %in% vertex_attr_names(graph1)) { + vertex_color1 <- V(graph1)$color + } else { + vertex_color1 <- NULL + } + } + if (!is.null(vertex_color1)) { + vertex_color1 <- as.numeric(vertex_color1) - 1 + } + if (is_missing(vertex_color2)) { + if ("color" %in% vertex_attr_names(graph2)) { + vertex_color2 <- V(graph2)$color + } else { + vertex_color2 <- NULL + } + } + if (!is.null(vertex_color2)) { + vertex_color2 <- as.numeric(vertex_color2) - 1 + } + if (is_missing(edge_color1)) { + if ("color" %in% edge_attr_names(graph1)) { + edge_color1 <- E(graph1)$color + } else { + edge_color1 <- NULL + } + } + if (!is.null(edge_color1)) { + edge_color1 <- as.numeric(edge_color1) - 1 + } + if (is_missing(edge_color2)) { + if ("color" %in% edge_attr_names(graph2)) { + edge_color2 <- E(graph2)$color + } else { + edge_color2 <- NULL + } + } + if (!is.null(edge_color2)) { + edge_color2 <- as.numeric(edge_color2) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_count_subisomorphisms_vf2, + graph1, + graph2, + vertex_color1, + vertex_color2, + edge_color1, + edge_color2 + ) + + res +} + +get_isomorphisms_vf2_callback_closure_impl <- function( + graph1, + graph2, + vertex_color1 = NULL, + vertex_color2 = NULL, + edge_color1 = NULL, + edge_color2 = NULL, + callback +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(vertex_color1)) { + if ("color" %in% vertex_attr_names(graph1)) { + vertex_color1 <- V(graph1)$color + } else { + vertex_color1 <- NULL + } + } + if (!is.null(vertex_color1)) { + vertex_color1 <- as.numeric(vertex_color1) - 1 + } + if (is_missing(vertex_color2)) { + if ("color" %in% vertex_attr_names(graph2)) { + vertex_color2 <- V(graph2)$color + } else { + vertex_color2 <- NULL + } + } + if (!is.null(vertex_color2)) { + vertex_color2 <- as.numeric(vertex_color2) - 1 + } + if (is_missing(edge_color1)) { + if ("color" %in% edge_attr_names(graph1)) { + edge_color1 <- E(graph1)$color + } else { + edge_color1 <- NULL + } + } + if (!is.null(edge_color1)) { + edge_color1 <- as.numeric(edge_color1) - 1 + } + if (is_missing(edge_color2)) { + if ("color" %in% edge_attr_names(graph2)) { + edge_color2 <- E(graph2)$color + } else { + edge_color2 <- NULL + } + } + if (!is.null(edge_color2)) { + edge_color2 <- as.numeric(edge_color2) - 1 + } + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + { + out <- callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_isomorphisms_vf2_callback_closure, + graph1, + graph2, + vertex_color1, + vertex_color2, + edge_color1, + edge_color2, + callback_wrapped + ) + + res +} + +get_isomorphisms_vf2_impl <- function( + graph1, + graph2, + vertex_color1 = NULL, + vertex_color2 = NULL, + edge_color1 = NULL, + edge_color2 = NULL +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(vertex_color1)) { + if ("color" %in% vertex_attr_names(graph1)) { + vertex_color1 <- V(graph1)$color + } else { + vertex_color1 <- NULL + } + } + if (!is.null(vertex_color1)) { + vertex_color1 <- as.numeric(vertex_color1) - 1 + } + if (is_missing(vertex_color2)) { + if ("color" %in% vertex_attr_names(graph2)) { + vertex_color2 <- V(graph2)$color + } else { + vertex_color2 <- NULL + } + } + if (!is.null(vertex_color2)) { + vertex_color2 <- as.numeric(vertex_color2) - 1 + } + if (is_missing(edge_color1)) { + if ("color" %in% edge_attr_names(graph1)) { + edge_color1 <- E(graph1)$color + } else { + edge_color1 <- NULL + } + } + if (!is.null(edge_color1)) { + edge_color1 <- as.numeric(edge_color1) - 1 + } + if (is_missing(edge_color2)) { + if ("color" %in% edge_attr_names(graph2)) { + edge_color2 <- E(graph2)$color + } else { + edge_color2 <- NULL + } + } + if (!is.null(edge_color2)) { + edge_color2 <- as.numeric(edge_color2) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_isomorphisms_vf2, + graph1, + graph2, + vertex_color1, + vertex_color2, + edge_color1, + edge_color2 + ) + + res +} + +get_subisomorphisms_vf2_callback_closure_impl <- function( + graph1, + graph2, + vertex_color1 = NULL, + vertex_color2 = NULL, + edge_color1 = NULL, + edge_color2 = NULL, + callback +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(vertex_color1)) { + if ("color" %in% vertex_attr_names(graph1)) { + vertex_color1 <- V(graph1)$color + } else { + vertex_color1 <- NULL + } + } + if (!is.null(vertex_color1)) { + vertex_color1 <- as.numeric(vertex_color1) - 1 + } + if (is_missing(vertex_color2)) { + if ("color" %in% vertex_attr_names(graph2)) { + vertex_color2 <- V(graph2)$color + } else { + vertex_color2 <- NULL + } + } + if (!is.null(vertex_color2)) { + vertex_color2 <- as.numeric(vertex_color2) - 1 + } + if (is_missing(edge_color1)) { + if ("color" %in% edge_attr_names(graph1)) { + edge_color1 <- E(graph1)$color + } else { + edge_color1 <- NULL + } + } + if (!is.null(edge_color1)) { + edge_color1 <- as.numeric(edge_color1) - 1 + } + if (is_missing(edge_color2)) { + if ("color" %in% edge_attr_names(graph2)) { + edge_color2 <- E(graph2)$color + } else { + edge_color2 <- NULL + } + } + if (!is.null(edge_color2)) { + edge_color2 <- as.numeric(edge_color2) - 1 + } + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + { + out <- callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_subisomorphisms_vf2_callback_closure, + graph1, + graph2, + vertex_color1, + vertex_color2, + edge_color1, + edge_color2, + callback_wrapped + ) + + res +} + +get_subisomorphisms_vf2_impl <- function( + graph1, + graph2, + vertex_color1 = NULL, + vertex_color2 = NULL, + edge_color1 = NULL, + edge_color2 = NULL +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(vertex_color1)) { + if ("color" %in% vertex_attr_names(graph1)) { + vertex_color1 <- V(graph1)$color + } else { + vertex_color1 <- NULL + } + } + if (!is.null(vertex_color1)) { + vertex_color1 <- as.numeric(vertex_color1) - 1 + } + if (is_missing(vertex_color2)) { + if ("color" %in% vertex_attr_names(graph2)) { + vertex_color2 <- V(graph2)$color + } else { + vertex_color2 <- NULL + } + } + if (!is.null(vertex_color2)) { + vertex_color2 <- as.numeric(vertex_color2) - 1 + } + if (is_missing(edge_color1)) { + if ("color" %in% edge_attr_names(graph1)) { + edge_color1 <- E(graph1)$color + } else { + edge_color1 <- NULL + } + } + if (!is.null(edge_color1)) { + edge_color1 <- as.numeric(edge_color1) - 1 + } + if (is_missing(edge_color2)) { + if ("color" %in% edge_attr_names(graph2)) { + edge_color2 <- E(graph2)$color + } else { + edge_color2 <- NULL + } + } + if (!is.null(edge_color2)) { + edge_color2 <- as.numeric(edge_color2) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_subisomorphisms_vf2, + graph1, + graph2, + vertex_color1, + vertex_color2, + edge_color1, + edge_color2 + ) + + res +} + +isomorphic_vf2_impl <- function( + graph1, + graph2, + vertex_color1 = NULL, + vertex_color2 = NULL, + edge_color1 = NULL, + edge_color2 = NULL +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(vertex_color1)) { + if ("color" %in% vertex_attr_names(graph1)) { + vertex_color1 <- V(graph1)$color + } else { + vertex_color1 <- NULL + } + } + if (!is.null(vertex_color1)) { + vertex_color1 <- as.numeric(vertex_color1) - 1 + } + if (is_missing(vertex_color2)) { + if ("color" %in% vertex_attr_names(graph2)) { + vertex_color2 <- V(graph2)$color + } else { + vertex_color2 <- NULL + } + } + if (!is.null(vertex_color2)) { + vertex_color2 <- as.numeric(vertex_color2) - 1 + } + if (is_missing(edge_color1)) { + if ("color" %in% edge_attr_names(graph1)) { + edge_color1 <- E(graph1)$color + } else { + edge_color1 <- NULL + } + } + if (!is.null(edge_color1)) { + edge_color1 <- as.numeric(edge_color1) - 1 + } + if (is_missing(edge_color2)) { + if ("color" %in% edge_attr_names(graph2)) { + edge_color2 <- E(graph2)$color + } else { + edge_color2 <- NULL + } + } + if (!is.null(edge_color2)) { + edge_color2 <- as.numeric(edge_color2) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_isomorphic_vf2, + graph1, + graph2, + vertex_color1, + vertex_color2, + edge_color1, + edge_color2 + ) + + res +} + +subisomorphic_vf2_impl <- function( + graph1, + graph2, + vertex_color1 = NULL, + vertex_color2 = NULL, + edge_color1 = NULL, + edge_color2 = NULL +) { + # Argument checks + ensure_igraph(graph1) + ensure_igraph(graph2) + if (is_missing(vertex_color1)) { + if ("color" %in% vertex_attr_names(graph1)) { + vertex_color1 <- V(graph1)$color + } else { + vertex_color1 <- NULL + } + } + if (!is.null(vertex_color1)) { + vertex_color1 <- as.numeric(vertex_color1) - 1 + } + if (is_missing(vertex_color2)) { + if ("color" %in% vertex_attr_names(graph2)) { + vertex_color2 <- V(graph2)$color + } else { + vertex_color2 <- NULL + } + } + if (!is.null(vertex_color2)) { + vertex_color2 <- as.numeric(vertex_color2) - 1 + } + if (is_missing(edge_color1)) { + if ("color" %in% edge_attr_names(graph1)) { + edge_color1 <- E(graph1)$color + } else { + edge_color1 <- NULL + } + } + if (!is.null(edge_color1)) { + edge_color1 <- as.numeric(edge_color1) - 1 + } + if (is_missing(edge_color2)) { + if ("color" %in% edge_attr_names(graph2)) { + edge_color2 <- E(graph2)$color + } else { + edge_color2 <- NULL + } + } + if (!is.null(edge_color2)) { + edge_color2 <- as.numeric(edge_color2) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_subisomorphic_vf2, + graph1, + graph2, + vertex_color1, + vertex_color2, + edge_color1, + edge_color2 + ) + + res +} diff --git a/R/aaa-layout.R b/R/aaa-layout.R new file mode 100644 index 00000000000..00d5055f1e7 --- /dev/null +++ b/R/aaa-layout.R @@ -0,0 +1,1000 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== drl-layout-generator ==== + +layout_drl_3d_impl <- function( + graph, + res, + use_seed = FALSE, + options = drl_defaults$default, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + res[] <- as.numeric(res) + use_seed <- as.logical(use_seed) + options <- modify_list(drl_defaults$default, options) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_drl_3d, + graph, + res, + use_seed, + options, + weights + ) + + res +} + +layout_drl_impl <- function( + graph, + res, + use_seed = FALSE, + options = drl_defaults$default, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + res[] <- as.numeric(res) + use_seed <- as.logical(use_seed) + options <- modify_list(drl_defaults$default, options) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_drl, + graph, + res, + use_seed, + options, + weights + ) + + res +} + +# ==== layouts-for-trees-and-acyclic-graphs ==== + +layout_reingold_tilford_circular_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + roots = NULL, + rootlevel = NULL +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + if (!is.null(roots)) { + roots <- as_igraph_vs(graph, roots) + roots <- roots - 1 + } + if (!is.null(rootlevel)) { + rootlevel <- as.numeric(rootlevel) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_reingold_tilford_circular, + graph, + mode, + roots, + rootlevel + ) + + res +} + +layout_reingold_tilford_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + roots = NULL, + rootlevel = NULL +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + if (!is.null(roots)) { + roots <- as_igraph_vs(graph, roots) + roots <- roots - 1 + } + if (!is.null(rootlevel)) { + rootlevel <- as.numeric(rootlevel) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_reingold_tilford, + graph, + mode, + roots, + rootlevel + ) + + res +} + +layout_sugiyama_impl <- function( + graph, + layers = NULL, + hgap = 1, + vgap = 1, + maxiter = 100, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(layers)) { + layers <- as.numeric(layers) - 1 + } + hgap <- as.numeric(hgap) + vgap <- as.numeric(vgap) + maxiter <- as.numeric(maxiter) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_sugiyama, + graph, + layers, + hgap, + vgap, + maxiter, + weights + ) + + res +} + +layout_umap_compute_weights_impl <- function( + graph, + distances, + weights +) { + # Argument checks + ensure_igraph(graph) + distances <- as.numeric(distances) + weights <- as.numeric(weights) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_umap_compute_weights, + graph, + distances, + weights + ) + + res +} + +layout_umap_impl <- function( + graph, + res, + use_seed = FALSE, + distances = NULL, + min_dist = 0.0, + epochs = 200, + distances_are_weights = FALSE +) { + # Argument checks + ensure_igraph(graph) + res[] <- as.numeric(res) + use_seed <- as.logical(use_seed) + if (!is.null(distances)) { + distances <- as.numeric(distances) + } + min_dist <- as.numeric(min_dist) + epochs <- as.numeric(epochs) + distances_are_weights <- as.logical(distances_are_weights) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_umap, + graph, + res, + use_seed, + distances, + min_dist, + epochs, + distances_are_weights + ) + + res +} + +roots_for_tree_layout_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + heuristic +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_roots_for_tree_layout, + graph, + mode, + heuristic + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +# ==== pp-layouts ==== + +layout_align_impl <- function( + graph, + layout +) { + # Argument checks + ensure_igraph(graph) + layout[] <- as.numeric(layout) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_align, + graph, + layout + ) + + res +} + +layout_merge_dla_impl <- function( + graphs, + coords +) { + # Argument checks + if (!is.list(graphs)) { + cli::cli_abort("{.arg graphs} must be a list of igraph objects") + } + graphs <- lapply(graphs, function(g) { + if (!inherits(g, "igraph")) { + cli::cli_abort("{.arg graphs} must be a list of igraph objects") + } + g + }) + if (!is.list(coords)) { + cli::cli_abort("{.arg coords} must be a list of matrices") + } + coords <- lapply(coords, function(m) { + if (!is.matrix(m)) { + cli::cli_abort("{.arg coords} must be a list of matrices") + } + m[] <- as.numeric(m) + m + }) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_merge_dla, + graphs, + coords + ) + + res +} + +# ==== three-d-layout-generators ==== + +layout_fruchterman_reingold_3d_impl <- function( + graph, + coords = NULL, + use_seed = FALSE, + niter = 500, + start_temp = sqrt(vcount(graph)), + weights = NULL, + minx = NULL, + maxx = NULL, + miny = NULL, + maxy = NULL, + minz = NULL, + maxz = NULL, + coolexp = NULL, + maxdelta = NULL, + area = NULL, + repulserad = NULL +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(coords)) { + coords[] <- as.numeric(coords) + } + use_seed <- as.logical(use_seed) + niter <- as.numeric(niter) + start_temp <- as.numeric(start_temp) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(minx)) { + minx <- as.numeric(minx) + } + if (!is.null(maxx)) { + maxx <- as.numeric(maxx) + } + if (!is.null(miny)) { + miny <- as.numeric(miny) + } + if (!is.null(maxy)) { + maxy <- as.numeric(maxy) + } + if (!is.null(minz)) { + minz <- as.numeric(minz) + } + if (!is.null(maxz)) { + maxz <- as.numeric(maxz) + } + if (!missing(coolexp)) { warning("Argument `coolexp' is deprecated and has no effect") } + if (!missing(maxdelta)) { warning("Argument `maxdelta' is deprecated and has no effect") } + if (!missing(area)) { warning("Argument `area' is deprecated and has no effect") } + if (!missing(repulserad)) { warning("Argument `repulserad' is deprecated and has no effect") } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_fruchterman_reingold_3d, + graph, + coords, + use_seed, + niter, + start_temp, + weights, + minx, + maxx, + miny, + maxy, + minz, + maxz + ) + + res +} + +layout_grid_3d_impl <- function( + graph, + width = 0, + height = 0 +) { + # Argument checks + ensure_igraph(graph) + width <- as.numeric(width) + height <- as.numeric(height) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_grid_3d, + graph, + width, + height + ) + + res +} + +layout_kamada_kawai_3d_impl <- function( + graph, + coords, + use_seed = FALSE, + maxiter = 500, + epsilon = 0.0, + kkconst = vcount(graph), + weights = NULL, + minx = NULL, + maxx = NULL, + miny = NULL, + maxy = NULL, + minz = NULL, + maxz = NULL +) { + # Argument checks + ensure_igraph(graph) + coords[] <- as.numeric(coords) + use_seed <- as.logical(use_seed) + maxiter <- as.numeric(maxiter) + epsilon <- as.numeric(epsilon) + kkconst <- as.numeric(kkconst) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(minx)) { + minx <- as.numeric(minx) + } + if (!is.null(maxx)) { + maxx <- as.numeric(maxx) + } + if (!is.null(miny)) { + miny <- as.numeric(miny) + } + if (!is.null(maxy)) { + maxy <- as.numeric(maxy) + } + if (!is.null(minz)) { + minz <- as.numeric(minz) + } + if (!is.null(maxz)) { + maxz <- as.numeric(maxz) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_kamada_kawai_3d, + graph, + coords, + use_seed, + maxiter, + epsilon, + kkconst, + weights, + minx, + maxx, + miny, + maxy, + minz, + maxz + ) + + res +} + +layout_random_3d_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_random_3d, + graph + ) + + res +} + +layout_sphere_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_sphere, + graph + ) + + res +} + +layout_umap_3d_impl <- function( + graph, + res, + use_seed = FALSE, + distances = NULL, + min_dist = 0.0, + epochs = 200, + distances_are_weights = FALSE +) { + # Argument checks + ensure_igraph(graph) + res[] <- as.numeric(res) + use_seed <- as.logical(use_seed) + if (!is.null(distances)) { + distances <- as.numeric(distances) + } + min_dist <- as.numeric(min_dist) + epochs <- as.numeric(epochs) + distances_are_weights <- as.logical(distances_are_weights) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_umap_3d, + graph, + res, + use_seed, + distances, + min_dist, + epochs, + distances_are_weights + ) + + res +} + +# ==== two-d-layout-generators ==== + +layout_bipartite_impl <- function( + graph, + types, + hgap = 1, + vgap = 1, + maxiter = 100 +) { + # Argument checks + ensure_igraph(graph) + types <- handle_vertex_type_arg(types, graph) + hgap <- as.numeric(hgap) + vgap <- as.numeric(vgap) + maxiter <- as.numeric(maxiter) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_bipartite, + graph, + types, + hgap, + vgap, + maxiter + ) + + res +} + +layout_circle_impl <- function( + graph, + order = V(graph) +) { + # Argument checks + ensure_igraph(graph) + order <- as_igraph_vs(graph, order) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_circle, + graph, + order - 1 + ) + + res +} + +layout_davidson_harel_impl <- function( + graph, + res = matrix(), + use_seed = FALSE, + maxiter = 10, + fineiter = max(10, log2(vcount(graph))), + cool_fact = 0.75, + weight_node_dist = 1.0, + weight_border = 0.0, + weight_edge_lengths = edge_density(graph) / 10, + weight_edge_crossings = 1.0 - sqrt(edge_density(graph)), + weight_node_edge_dist = 0.2 * (1 - edge_density(graph)) +) { + # Argument checks + ensure_igraph(graph) + res[] <- as.numeric(res) + use_seed <- as.logical(use_seed) + maxiter <- as.numeric(maxiter) + fineiter <- as.numeric(fineiter) + cool_fact <- as.numeric(cool_fact) + weight_node_dist <- as.numeric(weight_node_dist) + weight_border <- as.numeric(weight_border) + weight_edge_lengths <- as.numeric(weight_edge_lengths) + weight_edge_crossings <- as.numeric(weight_edge_crossings) + weight_node_edge_dist <- as.numeric(weight_node_edge_dist) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_davidson_harel, + graph, + res, + use_seed, + maxiter, + fineiter, + cool_fact, + weight_node_dist, + weight_border, + weight_edge_lengths, + weight_edge_crossings, + weight_node_edge_dist + ) + + res +} + +layout_fruchterman_reingold_impl <- function( + graph, + coords = NULL, + use_seed = FALSE, + niter = 500, + start_temp = sqrt(vcount(graph)), + grid = c("auto", "grid", "nogrid"), + weights = NULL, + minx = NULL, + maxx = NULL, + miny = NULL, + maxy = NULL, + coolexp = NULL, + maxdelta = NULL, + area = NULL, + repulserad = NULL +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(coords)) { + coords[] <- as.numeric(coords) + } + use_seed <- as.logical(use_seed) + niter <- as.numeric(niter) + start_temp <- as.numeric(start_temp) + grid <- switch_igraph_arg(grid, "grid" = 0L, "nogrid" = 1L, "auto" = 2L) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(minx)) { + minx <- as.numeric(minx) + } + if (!is.null(maxx)) { + maxx <- as.numeric(maxx) + } + if (!is.null(miny)) { + miny <- as.numeric(miny) + } + if (!is.null(maxy)) { + maxy <- as.numeric(maxy) + } + if (!missing(coolexp)) { warning("Argument `coolexp' is deprecated and has no effect") } + if (!missing(maxdelta)) { warning("Argument `maxdelta' is deprecated and has no effect") } + if (!missing(area)) { warning("Argument `area' is deprecated and has no effect") } + if (!missing(repulserad)) { warning("Argument `repulserad' is deprecated and has no effect") } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_fruchterman_reingold, + graph, + coords, + use_seed, + niter, + start_temp, + grid, + weights, + minx, + maxx, + miny, + maxy + ) + + res +} + +layout_gem_impl <- function( + graph, + res = matrix(), + use_seed = FALSE, + maxiter = 40, + temp_max = vcount(graph), + temp_min = 1, + temp_init = sqrt(vcount(graph)) +) { + # Argument checks + ensure_igraph(graph) + res[] <- as.numeric(res) + use_seed <- as.logical(use_seed) + maxiter <- as.numeric(maxiter) + temp_max <- as.numeric(temp_max) + temp_min <- as.numeric(temp_min) + temp_init <- as.numeric(temp_init) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_gem, + graph, + res, + use_seed, + maxiter, + temp_max, + temp_min, + temp_init + ) + + res +} + +layout_graphopt_impl <- function( + graph, + res, + niter = 500, + node_charge = 0.001, + node_mass = 30, + spring_length = 0, + spring_constant = 1, + max_sa_movement = 5, + use_seed = FALSE +) { + # Argument checks + ensure_igraph(graph) + res[] <- as.numeric(res) + niter <- as.numeric(niter) + node_charge <- as.numeric(node_charge) + node_mass <- as.numeric(node_mass) + spring_length <- as.numeric(spring_length) + spring_constant <- as.numeric(spring_constant) + max_sa_movement <- as.numeric(max_sa_movement) + use_seed <- as.logical(use_seed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_graphopt, + graph, + res, + niter, + node_charge, + node_mass, + spring_length, + spring_constant, + max_sa_movement, + use_seed + ) + + res +} + +layout_grid_impl <- function( + graph, + width = 0 +) { + # Argument checks + ensure_igraph(graph) + width <- as.numeric(width) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_grid, + graph, + width + ) + + res +} + +layout_kamada_kawai_impl <- function( + graph, + coords, + use_seed = FALSE, + maxiter = 500, + epsilon = 0.0, + kkconst = vcount(graph), + weights = NULL, + minx = NULL, + maxx = NULL, + miny = NULL, + maxy = NULL +) { + # Argument checks + ensure_igraph(graph) + coords[] <- as.numeric(coords) + use_seed <- as.logical(use_seed) + maxiter <- as.numeric(maxiter) + epsilon <- as.numeric(epsilon) + kkconst <- as.numeric(kkconst) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(minx)) { + minx <- as.numeric(minx) + } + if (!is.null(maxx)) { + maxx <- as.numeric(maxx) + } + if (!is.null(miny)) { + miny <- as.numeric(miny) + } + if (!is.null(maxy)) { + maxy <- as.numeric(maxy) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_kamada_kawai, + graph, + coords, + use_seed, + maxiter, + epsilon, + kkconst, + weights, + minx, + maxx, + miny, + maxy + ) + + res +} + +layout_lgl_impl <- function( + graph, + maxiter = 150, + maxdelta = vcount(graph), + area = vcount(graph)^2, + coolexp = 1.5, + repulserad = vcount(graph)^3, + cellsize = vcount(graph), + root = -1 +) { + # Argument checks + ensure_igraph(graph) + maxiter <- as.numeric(maxiter) + maxdelta <- as.numeric(maxdelta) + area <- as.numeric(area) + coolexp <- as.numeric(coolexp) + repulserad <- as.numeric(repulserad) + cellsize <- as.numeric(cellsize) + root <- as.numeric(root) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_lgl, + graph, + maxiter, + maxdelta, + area, + coolexp, + repulserad, + cellsize, + root + ) + + res +} + +layout_mds_impl <- function( + graph, + dist = NULL, + dim = 2 +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(dist)) { + dist[] <- as.numeric(dist) + } + dim <- as.numeric(dim) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_mds, + graph, + dist, + dim + ) + + res +} + +layout_random_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_random, + graph + ) + + res +} + +layout_star_impl <- function( + graph, + center = V(graph)[1], + order = NULL +) { + # Argument checks + ensure_igraph(graph) + center <- as_igraph_vs(graph, center) + if (length(center) != 1) { + cli::cli_abort( + "{.arg center} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (!is.null(order)) { + order <- as.numeric(order) - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_layout_star, + graph, + center - 1, + order + ) + + res +} diff --git a/R/aaa-motifs.R b/R/aaa-motifs.R new file mode 100644 index 00000000000..9f6ce32afa7 --- /dev/null +++ b/R/aaa-motifs.R @@ -0,0 +1,221 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== finding-triangles ==== + +count_adjacent_triangles_impl <- function( + graph, + vids = V(graph) +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_count_adjacent_triangles, + graph, + vids - 1 + ) + + res +} + +count_triangles_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_count_triangles, + graph + ) + + res +} + +list_triangles_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_list_triangles, + graph + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +# ==== graph-motifs ==== + +motifs_randesu_callback_closure_impl <- function( + graph, + size, + cut_prob = NULL, + callback +) { + # Argument checks + ensure_igraph(graph) + size <- as.numeric(size) + if (!is.null(cut_prob)) { + cut_prob <- as.numeric(cut_prob) + } + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + { + out <- callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_motifs_randesu_callback_closure, + graph, + size, + cut_prob, + callback_wrapped + ) + + res +} + +motifs_randesu_estimate_impl <- function( + graph, + size = 3, + cut_prob = NULL, + sample_size, + sample = NULL +) { + # Argument checks + ensure_igraph(graph) + size <- as.numeric(size) + if (!is.null(cut_prob)) { + cut_prob <- as.numeric(cut_prob) + } + sample_size <- as.numeric(sample_size) + if (!is.null(sample)) { + sample <- as.numeric(sample) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_motifs_randesu_estimate, + graph, + size, + cut_prob, + sample_size, + sample + ) + + res +} + +motifs_randesu_impl <- function( + graph, + size = 3, + cut_prob = NULL +) { + # Argument checks + ensure_igraph(graph) + size <- as.numeric(size) + if (!is.null(cut_prob)) { + cut_prob <- as.numeric(cut_prob) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_motifs_randesu, + graph, + size, + cut_prob + ) + + res +} + +motifs_randesu_no_impl <- function( + graph, + size = 3, + cut_prob = NULL +) { + # Argument checks + ensure_igraph(graph) + size <- as.numeric(size) + if (!is.null(cut_prob)) { + cut_prob <- as.numeric(cut_prob) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_motifs_randesu_no, + graph, + size, + cut_prob + ) + + res +} + +# ==== graph-census ==== + +dyad_census_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_dyad_census, + graph + ) + + res +} + +triad_census_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_triad_census, + graph + ) + + res +} diff --git a/R/aaa-nongraph.R b/R/aaa-nongraph.R new file mode 100644 index 00000000000..cbdcda1585e --- /dev/null +++ b/R/aaa-nongraph.R @@ -0,0 +1,258 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== compare-floats-with-tolerance ==== + +almost_equals_impl <- function( + a, + b, + eps +) { + # Argument checks + a <- as.numeric(a) + b <- as.numeric(b) + eps <- as.numeric(eps) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_almost_equals, + a, + b, + eps + ) + + res +} + +cmp_epsilon_impl <- function( + a, + b, + eps +) { + # Argument checks + a <- as.numeric(a) + b <- as.numeric(b) + eps <- as.numeric(eps) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_cmp_epsilon, + a, + b, + eps + ) + + res +} + +# ==== fitting-powerlaw-distributions-to-empirical-data ==== + +power_law_fit_impl <- function( + data, + xmin = -1, + force_continuous = FALSE +) { + # Argument checks + data <- as.numeric(data) + xmin <- as.numeric(xmin) + force_continuous <- as.logical(force_continuous) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_power_law_fit, + data, + xmin, + force_continuous + ) + + res +} + +# ==== igraph-version-number ==== + +version_impl <- function( +) { + # Argument checks + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_version + ) + + res +} + +# ==== random-sampling-from-very-long-sequences ==== + +random_sample_impl <- function( + l, + h, + length +) { + # Argument checks + l <- as.numeric(l) + h <- as.numeric(h) + length <- as.numeric(length) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_random_sample, + l, + h, + length + ) + + res +} + +# ==== running-mean-of-a-time-series ==== + +running_mean_impl <- function( + data, + binwidth +) { + # Argument checks + data <- as.numeric(data) + binwidth <- as.numeric(binwidth) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_running_mean, + data, + binwidth + ) + + res +} + +# ==== internal ==== + +has_attribute_table_impl <- function( +) { + # Argument checks + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_has_attribute_table + ) + + res +} + +# ==== linear-algebra ==== + +eigen_matrix_impl <- function( + A, + sA, + fun, + n, + algorithm, + which, + options = arpack_defaults() +) { + # Argument checks + A[] <- as.numeric(A) + requireNamespace("Matrix", quietly = TRUE) + sA <- as(as(as(sA, "dMatrix"), "generalMatrix"), "CsparseMatrix") + n <- as.integer(n) + algorithm <- switch_igraph_arg( + algorithm, + "auto" = 0L, + "lapack" = 1L, + "arpack" = 2L, + "comp_auto" = 3L, + "comp_lapack" = 4L, + "comp_arpack" = 5L + ) + which.tmp <- eigen_defaults() + which.tmp[names(which)] <- which + which <- which.tmp + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_eigen_matrix, + A, + sA, + fun, + n, + algorithm, + which, + options + ) + + res +} + +eigen_matrix_symmetric_impl <- function( + A, + sA, + fun, + n, + algorithm, + which, + options = arpack_defaults() +) { + # Argument checks + A[] <- as.numeric(A) + requireNamespace("Matrix", quietly = TRUE) + sA <- as(as(as(sA, "dMatrix"), "generalMatrix"), "CsparseMatrix") + n <- as.integer(n) + algorithm <- switch_igraph_arg( + algorithm, + "auto" = 0L, + "lapack" = 1L, + "arpack" = 2L, + "comp_auto" = 3L, + "comp_lapack" = 4L, + "comp_arpack" = 5L + ) + which.tmp <- eigen_defaults() + which.tmp[names(which)] <- which + which <- which.tmp + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_eigen_matrix_symmetric, + A, + sA, + fun, + n, + algorithm, + which, + options + ) + + res +} + +solve_lsap_impl <- function( + c, + n +) { + # Argument checks + c[] <- as.numeric(c) + n <- as.numeric(n) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_solve_lsap, + c, + n + ) + + res +} diff --git a/R/aaa-operators.R b/R/aaa-operators.R new file mode 100644 index 00000000000..a49b49cacbc --- /dev/null +++ b/R/aaa-operators.R @@ -0,0 +1,529 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== miscellaneous-operators ==== + +connect_neighborhood_impl <- function( + graph, + order = 2, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + order <- as.numeric(order) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_connect_neighborhood, + graph, + order, + mode + ) + + res +} + +contract_vertices_impl <- function( + graph, + mapping, + vertex_attr_comb = igraph_opt("vertex.attr.comb") +) { + # Argument checks + ensure_igraph(graph) + mapping <- as.numeric(mapping) - 1 + vertex_attr_comb <- igraph.i.attribute.combination(vertex_attr_comb) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_contract_vertices, + graph, + mapping, + vertex_attr_comb + ) + + res +} + +graph_power_impl <- function( + graph, + order, + directed = FALSE +) { + # Argument checks + ensure_igraph(graph) + order <- as.numeric(order) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_graph_power, + graph, + order, + directed + ) + + res +} + +induced_subgraph_impl <- function( + graph, + vids, + impl = c("auto", "copy_and_delete", "create_from_scratch") +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + impl <- switch_igraph_arg( + impl, + "auto" = 0L, + "copy_and_delete" = 1L, + "create_from_scratch" = 2L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_induced_subgraph, + graph, + vids - 1, + impl + ) + + res +} + +induced_subgraph_map_impl <- function( + graph, + vids, + impl = c("auto", "copy_and_delete", "create_from_scratch") +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + impl <- switch_igraph_arg( + impl, + "auto" = 0L, + "copy_and_delete" = 1L, + "create_from_scratch" = 2L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_induced_subgraph_map, + graph, + vids - 1, + impl + ) + + res +} + +linegraph_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_linegraph, + graph + ) + + res +} + +mycielskian_impl <- function( + graph, + k = 1 +) { + # Argument checks + ensure_igraph(graph) + k <- as.numeric(k) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_mycielskian, + graph, + k + ) + + res +} + +product_impl <- function( + g1, + g2, + type = c("cartesian", "lexicographic", "strong", "tensor", "modular") +) { + # Argument checks + ensure_igraph(g1) + ensure_igraph(g2) + type <- switch_igraph_arg( + type, + "cartesian" = 0L, + "lexicographic" = 1L, + "strong" = 2L, + "tensor" = 3L, + "modular" = 4L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_product, + g1, + g2, + type + ) + + res +} + +reverse_edges_impl <- function( + graph, + eids = E(graph) +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_reverse_edges, + graph, + eids - 1 + ) + + res +} + +rooted_product_impl <- function( + g1, + g2, + root +) { + # Argument checks + ensure_igraph(g1) + ensure_igraph(g2) + root <- as_igraph_vs(g2, root) + if (length(root) != 1) { + cli::cli_abort( + "{.arg root} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_rooted_product, + g1, + g2, + root - 1 + ) + + res +} + +simplify_impl <- function( + graph, + remove_multiple = TRUE, + remove_loops = TRUE, + edge_attr_comb = igraph_opt("edge.attr.comb") +) { + # Argument checks + ensure_igraph(graph) + remove_multiple <- as.logical(remove_multiple) + remove_loops <- as.logical(remove_loops) + edge_attr_comb <- igraph.i.attribute.combination(edge_attr_comb) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_simplify, + graph, + remove_multiple, + remove_loops, + edge_attr_comb + ) + + res +} + +subgraph_from_edges_impl <- function( + graph, + eids, + delete_vertices = TRUE +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + delete_vertices <- as.logical(delete_vertices) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_subgraph_from_edges, + graph, + eids - 1, + delete_vertices + ) + + res +} + +transitive_closure_dag_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_transitive_closure_dag, + graph + ) + + res +} + +transitive_closure_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_transitive_closure, + graph + ) + + res +} + +# ==== other-setlike-operators ==== + +complementer_impl <- function( + graph, + loops = FALSE +) { + # Argument checks + ensure_igraph(graph) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_complementer, + graph, + loops + ) + + res +} + +compose_impl <- function( + g1, + g2 +) { + # Argument checks + ensure_igraph(g1) + ensure_igraph(g2) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_compose, + g1, + g2 + ) + + res +} + +difference_impl <- function( + orig, + sub +) { + # Argument checks + ensure_igraph(orig) + ensure_igraph(sub) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_difference, + orig, + sub + ) + + res +} + +# ==== union-and-intersection ==== + +disjoint_union_impl <- function( + left, + right +) { + # Argument checks + ensure_igraph(left) + ensure_igraph(right) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_disjoint_union, + left, + right + ) + + res +} + +disjoint_union_many_impl <- function( + graphs +) { + # Argument checks + if (!is.list(graphs)) { + cli::cli_abort("{.arg graphs} must be a list of igraph objects") + } + graphs <- lapply(graphs, function(g) { + if (!inherits(g, "igraph")) { + cli::cli_abort("{.arg graphs} must be a list of igraph objects") + } + g + }) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_disjoint_union_many, + graphs + ) + + res +} + +intersection_impl <- function( + left, + right +) { + # Argument checks + ensure_igraph(left) + ensure_igraph(right) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_intersection, + left, + right + ) + + res +} + +intersection_many_impl <- function( + graphs +) { + # Argument checks + if (!is.list(graphs)) { + cli::cli_abort("{.arg graphs} must be a list of igraph objects") + } + graphs <- lapply(graphs, function(g) { + if (!inherits(g, "igraph")) { + cli::cli_abort("{.arg graphs} must be a list of igraph objects") + } + g + }) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_intersection_many, + graphs + ) + + res +} + +join_impl <- function( + left, + right +) { + # Argument checks + ensure_igraph(left) + ensure_igraph(right) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_join, + left, + right + ) + + res +} + +union_impl <- function( + left, + right +) { + # Argument checks + ensure_igraph(left) + ensure_igraph(right) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_union, + left, + right + ) + + res +} + +union_many_impl <- function( + graphs +) { + # Argument checks + if (!is.list(graphs)) { + cli::cli_abort("{.arg graphs} must be a list of igraph objects") + } + graphs <- lapply(graphs, function(g) { + if (!inherits(g, "igraph")) { + cli::cli_abort("{.arg graphs} must be a list of igraph objects") + } + g + }) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_union_many, + graphs + ) + + res +} diff --git a/R/aaa-processes.R b/R/aaa-processes.R new file mode 100644 index 00000000000..0b2170fb319 --- /dev/null +++ b/R/aaa-processes.R @@ -0,0 +1,199 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== epidemic-models ==== + +sir_impl <- function( + graph, + beta, + gamma, + no_sim = 100 +) { + # Argument checks + ensure_igraph(graph) + beta <- as.numeric(beta) + gamma <- as.numeric(gamma) + no_sim <- as.numeric(no_sim) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_sir, + graph, + beta, + gamma, + no_sim + ) + + class(res) <- "sir" + res +} + +# ==== evolutionary-dynamics ==== + +deterministic_optimal_imitation_impl <- function( + graph, + vid, + optimality = c("maximum", "minimum"), + quantities, + strategies, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + vid <- as_igraph_vs(graph, vid) + if (length(vid) != 1) { + cli::cli_abort( + "{.arg vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + optimality <- switch_igraph_arg(optimality, "minimum" = 0L, "maximum" = 1L) + strategies <- as.numeric(strategies) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_deterministic_optimal_imitation, + graph, + vid - 1, + optimality, + quantities, + strategies, + mode + ) + + res +} + +moran_process_impl <- function( + graph, + weights = NULL, + quantities, + strategies, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + strategies <- as.numeric(strategies) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_moran_process, + graph, + weights, + quantities, + strategies, + mode + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$quantities) <- vertex_attr(graph, "name", V(graph)) + } + res +} + +roulette_wheel_imitation_impl <- function( + graph, + vid, + is_local, + quantities, + strategies, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + vid <- as_igraph_vs(graph, vid) + if (length(vid) != 1) { + cli::cli_abort( + "{.arg vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + is_local <- as.logical(is_local) + strategies <- as.numeric(strategies) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_roulette_wheel_imitation, + graph, + vid - 1, + is_local, + quantities, + strategies, + mode + ) + + res +} + +stochastic_imitation_impl <- function( + graph, + vid, + algo, + quantities, + strategies, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + vid <- as_igraph_vs(graph, vid) + if (length(vid) != 1) { + cli::cli_abort( + "{.arg vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + strategies <- as.numeric(strategies) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_stochastic_imitation, + graph, + vid - 1, + algo, + quantities, + strategies, + mode + ) + + res +} diff --git a/R/aaa-progress.R b/R/aaa-progress.R new file mode 100644 index 00000000000..a22050f9281 --- /dev/null +++ b/R/aaa-progress.R @@ -0,0 +1,22 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== invoking-the-progress-handler ==== + +progress_impl <- function( + message, + percent +) { + # Argument checks + percent <- as.numeric(percent) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_progress, + message, + percent + ) + + res +} diff --git a/R/aaa-separators.R b/R/aaa-separators.R new file mode 100644 index 00000000000..ef97067ea63 --- /dev/null +++ b/R/aaa-separators.R @@ -0,0 +1,92 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +all_minimal_st_separators_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_all_minimal_st_separators, + graph + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +even_tarjan_reduction_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_even_tarjan_reduction, + graph + ) + + res +} + +is_minimal_separator_impl <- function( + graph, + candidate +) { + # Argument checks + ensure_igraph(graph) + candidate <- as_igraph_vs(graph, candidate) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_minimal_separator, + graph, + candidate - 1 + ) + + res +} + +is_separator_impl <- function( + graph, + candidate +) { + # Argument checks + ensure_igraph(graph) + candidate <- as_igraph_vs(graph, candidate) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_separator, + graph, + candidate - 1 + ) + + res +} + +minimum_size_separators_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_minimum_size_separators, + graph + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} diff --git a/R/aaa-spatial.R b/R/aaa-spatial.R new file mode 100644 index 00000000000..264a1557dbe --- /dev/null +++ b/R/aaa-spatial.R @@ -0,0 +1,20 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== nongraph-spatial ==== + +convex_hull_2d_impl <- function( + data +) { + # Argument checks + data[] <- as.numeric(data) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_convex_hull_2d, + data + ) + + res +} diff --git a/R/aaa-status.R b/R/aaa-status.R new file mode 100644 index 00000000000..f133a060aa5 --- /dev/null +++ b/R/aaa-status.R @@ -0,0 +1,20 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== invoking-the-status-handler ==== + +status_impl <- function( + message +) { + # Argument checks + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_status, + message + ) + + res +} diff --git a/R/aaa-structural.R b/R/aaa-structural.R new file mode 100644 index 00000000000..12d401ac890 --- /dev/null +++ b/R/aaa-structural.R @@ -0,0 +1,5237 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== basic-properties ==== + +are_adjacent_impl <- function( + graph, + v1, + v2 +) { + # Argument checks + ensure_igraph(graph) + v1 <- as_igraph_vs(graph, v1) + if (length(v1) != 1) { + cli::cli_abort( + "{.arg v1} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + v2 <- as_igraph_vs(graph, v2) + if (length(v2) != 1) { + cli::cli_abort( + "{.arg v2} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_are_adjacent, + graph, + v1 - 1, + v2 - 1 + ) + + res +} + +are_connected_impl <- function( + graph, + v1, + v2 +) { + # Argument checks + ensure_igraph(graph) + v1 <- as_igraph_vs(graph, v1) + if (length(v1) != 1) { + cli::cli_abort( + "{.arg v1} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + v2 <- as_igraph_vs(graph, v2) + if (length(v2) != 1) { + cli::cli_abort( + "{.arg v2} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_are_connected, + graph, + v1 - 1, + v2 - 1 + ) + + res +} + +# ==== centrality-measures ==== + +authority_score_impl <- function( + graph, + scale = TRUE, + weights = NULL, + options = arpack_defaults() +) { + # Argument checks + ensure_igraph(graph) + scale <- as.logical(scale) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_authority_score, + graph, + scale, + weights, + options + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$vector) <- vertex_attr(graph, "name", V(graph)) + } + res +} + +betweenness_impl <- function( + graph, + vids = V(graph), + directed = TRUE, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + directed <- as.logical(directed) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_betweenness, + graph, + vids - 1, + directed, + weights + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +closeness_impl <- function( + graph, + vids = V(graph), + mode = c("out", "in", "all", "total"), + weights = NULL, + normalized = FALSE +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_closeness, + graph, + vids - 1, + mode, + weights, + normalized + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$res) <- vertex_attr(graph, "name", vids) + } + res +} + +constraint_impl <- function( + graph, + vids = V(graph), + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_constraint, + graph, + vids - 1, + weights + ) + + res +} + +convergence_degree_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_convergence_degree, + graph + ) + + res +} + +edge_betweenness_impl <- function( + graph, + directed = TRUE, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_edge_betweenness, + graph, + directed, + weights + ) + + res +} + +eigenvector_centrality_impl <- function( + graph, + directed = FALSE, + scale = TRUE, + weights = NULL, + options = arpack_defaults() +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + scale <- as.logical(scale) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_eigenvector_centrality, + graph, + directed, + scale, + weights, + options + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$vector) <- vertex_attr(graph, "name", V(graph)) + } + res +} + +harmonic_centrality_impl <- function( + graph, + vids = V(graph), + mode = c("out", "in", "all", "total"), + weights = NULL, + normalized = FALSE +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_harmonic_centrality, + graph, + vids - 1, + mode, + weights, + normalized + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +hub_and_authority_scores_impl <- function( + graph, + scale = TRUE, + weights = NULL, + options = arpack_defaults() +) { + # Argument checks + ensure_igraph(graph) + scale <- as.logical(scale) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hub_and_authority_scores, + graph, + scale, + weights, + options + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$hub) <- vertex_attr(graph, "name", V(graph)) + } + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$authority) <- vertex_attr(graph, "name", V(graph)) + } + res +} + +hub_score_impl <- function( + graph, + scale = TRUE, + weights = NULL, + options = arpack_defaults() +) { + # Argument checks + ensure_igraph(graph) + scale <- as.logical(scale) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_hub_score, + graph, + scale, + weights, + options + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$vector) <- vertex_attr(graph, "name", V(graph)) + } + 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_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 +} + +pagerank_impl <- function( + graph, + algo = c("prpack", "arpack"), + vids = V(graph), + directed = TRUE, + damping = 0.85, + weights = NULL, + options = NULL +) { + # Argument checks + ensure_igraph(graph) + algo <- switch_igraph_arg(algo, "arpack" = 1L, "prpack" = 2L) + vids <- as_igraph_vs(graph, vids) + directed <- as.logical(directed) + damping <- as.numeric(damping) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (is.null(options)) { + if (algo == 0L) { + options <- list(niter = 1000, eps = 0.001) + } else if (algo == 1L) { + options <- arpack_defaults() + } else { + options <- NULL + } + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_pagerank, + graph, + algo, + vids - 1, + directed, + damping, + weights, + options + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$vector) <- vertex_attr(graph, "name", vids) + } + res +} + +personalized_pagerank_impl <- function( + graph, + algo = c("prpack", "arpack"), + vids = V(graph), + directed = TRUE, + damping = 0.85, + personalized = NULL, + weights = NULL, + options = NULL +) { + # Argument checks + ensure_igraph(graph) + algo <- switch_igraph_arg(algo, "arpack" = 1L, "prpack" = 2L) + vids <- as_igraph_vs(graph, vids) + directed <- as.logical(directed) + damping <- as.numeric(damping) + if (!is.null(personalized)) { + personalized <- as.numeric(personalized) + } + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (is.null(options)) { + if (algo == 0L) { + options <- list(niter = 1000, eps = 0.001) + } else if (algo == 1L) { + options <- arpack_defaults() + } else { + options <- NULL + } + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_personalized_pagerank, + graph, + algo, + vids - 1, + directed, + damping, + personalized, + weights, + options + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$vector) <- vertex_attr(graph, "name", vids) + } + res +} + +personalized_pagerank_vs_impl <- function( + graph, + algo = c("prpack", "arpack"), + vids = V(graph), + directed = TRUE, + damping = 0.85, + reset_vids, + weights = NULL, + options = NULL, + details = FALSE +) { + # Argument checks + ensure_igraph(graph) + algo <- switch_igraph_arg(algo, "arpack" = 1L, "prpack" = 2L) + vids <- as_igraph_vs(graph, vids) + directed <- as.logical(directed) + damping <- as.numeric(damping) + reset_vids <- as_igraph_vs(graph, reset_vids) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (is.null(options)) { + if (algo == 0L) { + options <- list(niter = 1000, eps = 0.001) + } else if (algo == 1L) { + options <- arpack_defaults() + } else { + options <- NULL + } + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_personalized_pagerank_vs, + graph, + algo, + vids - 1, + directed, + damping, + reset_vids - 1, + weights, + options + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$vector) <- vertex_attr(graph, "name", vids) + } + if (!details) { + res <- res$vector + } + res +} + +strength_impl <- function( + graph, + vids = V(graph), + mode = c("all", "out", "in", "total"), + loops = TRUE, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + loops <- as.logical(loops) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_strength, + graph, + vids - 1, + mode, + loops, + weights + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +# ==== centralization ==== + +centralization_betweenness_impl <- function( + graph, + directed = TRUE, + normalized = TRUE +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_centralization_betweenness, + graph, + directed, + normalized + ) + + res +} + +centralization_betweenness_tmax_impl <- function( + graph = NULL, + nodes = 0, + directed = TRUE +) { + # Argument checks + if (!is.null(graph)) { + ensure_igraph(graph) + } + nodes <- as.numeric(nodes) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_centralization_betweenness_tmax, + graph, + nodes, + directed + ) + + res +} + +centralization_closeness_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + normalized = TRUE +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_centralization_closeness, + graph, + mode, + normalized + ) + + res +} + +centralization_closeness_tmax_impl <- function( + graph = NULL, + nodes = 0, + mode = c("out", "in", "all", "total") +) { + # Argument checks + if (!is.null(graph)) { + ensure_igraph(graph) + } + nodes <- as.numeric(nodes) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_centralization_closeness_tmax, + graph, + nodes, + mode + ) + + res +} + +centralization_degree_impl <- function( + graph, + mode = c("all", "out", "in", "total"), + loops = TRUE, + normalized = TRUE +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + loops <- as.logical(loops) + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_centralization_degree, + graph, + mode, + loops, + normalized + ) + + res +} + +centralization_degree_tmax_impl <- function( + graph = NULL, + nodes = 0, + mode = c("all", "out", "in", "total"), + loops +) { + # Argument checks + if (!is.null(graph)) { + ensure_igraph(graph) + } + nodes <- as.numeric(nodes) + mode <- switch_igraph_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_centralization_degree_tmax, + graph, + nodes, + mode, + loops + ) + + res +} + +centralization_eigenvector_centrality_impl <- function( + graph, + directed = FALSE, + scale = TRUE, + options = arpack_defaults(), + normalized = TRUE +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + scale <- as.logical(scale) + options <- modify_list(arpack_defaults(), options) + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_centralization_eigenvector_centrality, + graph, + directed, + scale, + options, + normalized + ) + + res +} + +centralization_eigenvector_centrality_tmax_impl <- function( + graph = NULL, + nodes = 0, + directed = FALSE, + scale = TRUE +) { + # Argument checks + if (!is.null(graph)) { + ensure_igraph(graph) + } + nodes <- as.numeric(nodes) + directed <- as.logical(directed) + scale <- as.logical(scale) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_centralization_eigenvector_centrality_tmax, + graph, + nodes, + directed, + scale + ) + + res +} + +centralization_impl <- function( + scores, + theoretical_max = 0, + normalized = TRUE +) { + # Argument checks + scores <- as.numeric(scores) + theoretical_max <- as.numeric(theoretical_max) + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_centralization, + scores, + theoretical_max, + normalized + ) + + res +} + +# ==== degree-sequences ==== + +is_bigraphical_impl <- function( + degrees1, + degrees2, + allowed_edge_types = c("simple", "loops", "multi", "all") +) { + # Argument checks + degrees1 <- as.numeric(degrees1) + degrees2 <- as.numeric(degrees2) + allowed_edge_types <- switch_igraph_arg( + allowed_edge_types, + "simple" = 0L, + "loop" = 1L, + "loops" = 1L, + "multi" = 6L, + "multiple" = 6L, + "all" = 7L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_bigraphical, + degrees1, + degrees2, + allowed_edge_types + ) + + res +} + +is_graphical_impl <- function( + out_deg, + in_deg = NULL, + allowed_edge_types = c("simple", "loops", "multi", "all") +) { + # Argument checks + out_deg <- as.numeric(out_deg) + if (!is.null(in_deg)) { + in_deg <- as.numeric(in_deg) + } + allowed_edge_types <- switch_igraph_arg( + allowed_edge_types, + "simple" = 0L, + "loop" = 1L, + "loops" = 1L, + "multi" = 6L, + "multiple" = 6L, + "all" = 7L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_graphical, + out_deg, + in_deg, + allowed_edge_types + ) + + res +} + +# ==== directedness-conversion ==== + +to_directed_impl <- function( + graph, + mode = c("mutual", "arbitrary", "random", "acyclic") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "arbitrary" = 0L, + "mutual" = 1L, + "random" = 2L, + "acyclic" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_to_directed, + graph, + mode + ) + + res +} + +to_undirected_impl <- function( + graph, + mode = c("collapse", "each", "mutual"), + edge_attr_comb = igraph_opt("edge.attr.comb") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg(mode, "collapse" = 1L, "each" = 0L, "mutual" = 2L) + edge_attr_comb <- igraph.i.attribute.combination(edge_attr_comb) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_to_undirected, + graph, + mode, + edge_attr_comb + ) + + res +} + +# ==== efficiency-measures ==== + +average_local_efficiency_impl <- function( + graph, + weights = NULL, + directed = TRUE, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + directed <- as.logical(directed) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_average_local_efficiency, + graph, + weights, + directed, + mode + ) + + res +} + +global_efficiency_impl <- function( + graph, + weights = NULL, + directed = TRUE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_global_efficiency, + graph, + weights, + directed + ) + + res +} + +local_efficiency_impl <- function( + graph, + vids = V(graph), + weights = NULL, + directed = TRUE, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + directed <- as.logical(directed) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_efficiency, + graph, + vids - 1, + weights, + directed, + mode + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +# ==== graph-components ==== + +articulation_points_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_articulation_points, + graph + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +biconnected_components_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_biconnected_components, + graph + ) + if (igraph_opt("return.vs.es")) { + res$tree_edges <- lapply(res$tree_edges, unsafe_create_es, graph = graph, es = E(graph)) + } + if (igraph_opt("return.vs.es")) { + res$component_edges <- lapply(res$component_edges, unsafe_create_es, graph = graph, es = E(graph)) + } + if (igraph_opt("return.vs.es")) { + res$components <- lapply(res$components, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$articulation_points <- create_vs(graph, res$articulation_points) + } + res +} + +bridges_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bridges, + graph + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +connected_components_impl <- function( + graph, + mode = c("weak", "strong"), + details = FALSE +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg(mode, "weak" = 1L, "strong" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_connected_components, + graph, + mode + ) + if (!details) { + res <- res$membership + } + res +} + +count_reachable_impl <- function( + graph, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_count_reachable, + graph, + mode + ) + + res +} + +decompose_impl <- function( + graph, + mode = c("weak", "strong"), + maxcompno = -1, + minelements = 1 +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg(mode, "weak" = 1L, "strong" = 2L) + maxcompno <- as.numeric(maxcompno) + minelements <- as.numeric(minelements) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_decompose, + graph, + mode, + maxcompno, + minelements + ) + + res +} + +is_biconnected_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_biconnected, + graph + ) + + res +} + +is_connected_impl <- function( + graph, + mode = c("weak", "strong") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg(mode, "weak" = 1L, "strong" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_connected, + graph, + mode + ) + + res +} + +subcomponent_impl <- function( + graph, + vid, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + vid <- as_igraph_vs(graph, vid) + if (length(vid) != 1) { + cli::cli_abort( + "{.arg vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_subcomponent, + graph, + vid - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +# ==== k-cores ==== + +coreness_impl <- function( + graph, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_coreness, + graph, + mode + ) + + res +} + +trussness_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_trussness, + graph + ) + + res +} + +# ==== matchings ==== + +is_matching_impl <- function( + graph, + types = NULL, + matching +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(types)) { + types <- handle_vertex_type_arg(types, graph) + } + matching <- as.numeric(matching) - 1 + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_matching, + graph, + types, + matching + ) + + res +} + +is_maximal_matching_impl <- function( + graph, + types = NULL, + matching +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(types)) { + types <- handle_vertex_type_arg(types, graph) + } + matching <- as.numeric(matching) - 1 + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_maximal_matching, + graph, + types, + matching + ) + + res +} + +maximum_bipartite_matching_impl <- function( + graph, + types, + weights = NULL, + eps = .Machine$double.eps +) { + # Argument checks + ensure_igraph(graph) + types <- handle_vertex_type_arg(types, graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + eps <- as.numeric(eps) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximum_bipartite_matching, + graph, + types, + weights, + eps + ) + + res +} + +# ==== matrix-representations ==== + +get_adjacency_impl <- function( + graph, + type = c("both", "upper", "lower"), + weights = NULL, + loops = c("once", "none", "twice") +) { + # Argument checks + ensure_igraph(graph) + type <- switch_igraph_arg(type, "upper" = 0L, "lower" = 1L, "both" = 2L) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_adjacency, + graph, + type, + weights, + loops + ) + + res +} + +get_adjacency_sparse_impl <- function( + graph, + type = c("both", "upper", "lower"), + weights = NULL, + loops = c("once", "none", "twice") +) { + # Argument checks + ensure_igraph(graph) + type <- switch_igraph_arg(type, "upper" = 0L, "lower" = 1L, "both" = 2L) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + loops <- switch_igraph_arg(loops, "none" = 0L, "twice" = 1L, "once" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_adjacency_sparse, + graph, + type, + weights, + loops + ) + + res +} + +get_edgelist_impl <- function( + graph, + bycol = FALSE +) { + # Argument checks + ensure_igraph(graph) + bycol <- as.logical(bycol) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_edgelist, + graph, + bycol + ) + + res +} + +get_stochastic_impl <- function( + graph, + column_wise = FALSE, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + column_wise <- as.logical(column_wise) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_stochastic, + graph, + column_wise, + weights + ) + + res +} + +get_stochastic_sparse_impl <- function( + graph, + column_wise = FALSE, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + column_wise <- as.logical(column_wise) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_stochastic_sparse, + graph, + column_wise, + weights + ) + + res +} + +# ==== maximum-cardinality-search-chordal-graphs ==== + +is_chordal_impl <- function( + graph, + alpha = NULL, + alpham1 = NULL +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(alpha)) { + alpha <- as.numeric(alpha) - 1 + } + if (!is.null(alpham1)) { + alpham1 <- as_igraph_vs(graph, alpham1) + alpham1 <- alpham1 - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_chordal, + graph, + alpha, + alpham1 + ) + + res +} + +maximum_cardinality_search_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_maximum_cardinality_search, + graph + ) + if (igraph_opt("return.vs.es")) { + res$alpham1 <- create_vs(graph, res$alpham1) + } + res +} + +# ==== mixing-patterns ==== + +assortativity_degree_impl <- function( + graph, + directed = TRUE +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_assortativity_degree, + graph, + directed + ) + + res +} + +assortativity_impl <- function( + graph, + values, + values_in = NULL, + directed = TRUE, + normalized = TRUE +) { + # Argument checks + ensure_igraph(graph) + values <- as.numeric(values) + if (!is.null(values_in)) { + values_in <- as.numeric(values_in) + } + directed <- as.logical(directed) + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_assortativity, + graph, + values, + values_in, + directed, + normalized + ) + + res +} + +assortativity_nominal_impl <- function( + graph, + types, + directed = TRUE, + normalized = TRUE +) { + # Argument checks + ensure_igraph(graph) + types <- as.numeric(types) - 1 + directed <- as.logical(directed) + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_assortativity_nominal, + graph, + types, + directed, + normalized + ) + + res +} + +avg_nearest_neighbor_degree_impl <- function( + graph, + vids = V(graph), + mode = c("all", "out", "in", "total"), + neighbor_degree_mode = c("all", "out", "in", "total"), + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + neighbor_degree_mode <- switch_igraph_arg( + neighbor_degree_mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_avg_nearest_neighbor_degree, + graph, + vids - 1, + mode, + neighbor_degree_mode, + weights + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$knn) <- vertex_attr(graph, "name", vids) + } + res +} + +degree_correlation_vector_impl <- function( + graph, + weights = NULL, + from_mode = c("out", "in", "all", "total"), + to_mode = c("in", "out", "all", "total"), + directed_neighbors = TRUE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + from_mode <- switch_igraph_arg( + from_mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + to_mode <- switch_igraph_arg( + to_mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + directed_neighbors <- as.logical(directed_neighbors) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_degree_correlation_vector, + graph, + weights, + from_mode, + to_mode, + directed_neighbors + ) + + res +} + +joint_degree_distribution_impl <- function( + graph, + weights = NULL, + from_mode = c("out", "in", "all", "total"), + to_mode = c("in", "out", "all", "total"), + directed_neighbors = TRUE, + normalized = TRUE, + max_from_degree = -1, + max_to_degree = -1 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + from_mode <- switch_igraph_arg( + from_mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + to_mode <- switch_igraph_arg( + to_mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + directed_neighbors <- as.logical(directed_neighbors) + normalized <- as.logical(normalized) + max_from_degree <- as.numeric(max_from_degree) + max_to_degree <- as.numeric(max_to_degree) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_joint_degree_distribution, + graph, + weights, + from_mode, + to_mode, + directed_neighbors, + normalized, + max_from_degree, + max_to_degree + ) + + res +} + +joint_degree_matrix_impl <- function( + graph, + weights = NULL, + max_out_degree = -1, + max_in_degree = -1 +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + max_out_degree <- as.numeric(max_out_degree) + max_in_degree <- as.numeric(max_in_degree) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_joint_degree_matrix, + graph, + weights, + max_out_degree, + max_in_degree + ) + + res +} + +joint_type_distribution_impl <- function( + graph, + weights = NULL, + from_types, + to_types = NULL, + directed = TRUE, + normalized = TRUE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + from_types <- as.numeric(from_types) - 1 + if (!is.null(to_types)) { + to_types <- as.numeric(to_types) - 1 + } + directed <- as.logical(directed) + normalized <- as.logical(normalized) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_joint_type_distribution, + graph, + weights, + from_types, + to_types, + directed, + normalized + ) + + res +} + +rich_club_sequence_impl <- function( + graph, + weights = NULL, + vertex_order, + normalized = TRUE, + loops = FALSE, + directed = TRUE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + vertex_order <- as.numeric(vertex_order) - 1 + normalized <- as.logical(normalized) + loops <- as.logical(loops) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_rich_club_sequence, + graph, + weights, + vertex_order, + normalized, + loops, + directed + ) + + res +} + +# ==== mutual-edges ==== + +has_mutual_impl <- function( + graph, + loops = TRUE +) { + # Argument checks + ensure_igraph(graph) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_has_mutual, + graph, + loops + ) + + res +} + +is_mutual_impl <- function( + graph, + eids = E(graph), + loops = TRUE +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_mutual, + graph, + eids - 1, + loops + ) + + res +} + +reciprocity_impl <- function( + graph, + ignore_loops = TRUE, + mode = c("default", "ratio") +) { + # Argument checks + ensure_igraph(graph) + ignore_loops <- as.logical(ignore_loops) + mode <- switch_igraph_arg(mode, "default" = 0L, "ratio" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_reciprocity, + graph, + ignore_loops, + mode + ) + + res +} + +# ==== neighborhood-of-a-vertex ==== + +neighborhood_graphs_impl <- function( + graph, + vids, + order, + mode = c("all", "out", "in", "total"), + mindist = 0 +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + order <- as.numeric(order) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + mindist <- as.numeric(mindist) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_neighborhood_graphs, + graph, + vids - 1, + order, + mode, + mindist + ) + + res +} + +neighborhood_impl <- function( + graph, + vids, + order, + mode = c("all", "out", "in", "total"), + mindist = 0 +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + order <- as.numeric(order) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + mindist <- as.numeric(mindist) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_neighborhood, + graph, + vids - 1, + order, + mode, + mindist + ) + if (igraph_opt("return.vs.es")) { + res <- lapply(res, unsafe_create_vs, graph = graph, verts = V(graph)) + } + res +} + +neighborhood_size_impl <- function( + graph, + vids, + order, + mode = c("all", "out", "in", "total"), + mindist = 0 +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + order <- as.numeric(order) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + mindist <- as.numeric(mindist) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_neighborhood_size, + graph, + vids - 1, + order, + mode, + mindist + ) + + res +} + +# ==== non-simple-graphs-multiple-and-loop-edges ==== + +count_loops_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_count_loops, + graph + ) + + res +} + +count_multiple_impl <- function( + graph, + eids = E(graph) +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_count_multiple, + graph, + eids - 1 + ) + + res +} + +has_loop_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_has_loop, + graph + ) + + res +} + +has_multiple_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_has_multiple, + graph + ) + + res +} + +is_loop_impl <- function( + graph, + eids = E(graph) +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_loop, + graph, + eids - 1 + ) + + res +} + +is_multiple_impl <- function( + graph, + eids = E(graph) +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_multiple, + graph, + eids - 1 + ) + + res +} + +is_simple_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_simple, + graph + ) + + res +} + +# ==== percolation ==== + +bond_percolation_impl <- function( + graph, + edge_order = NULL +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(edge_order)) { + edge_order <- as_igraph_es(graph, edge_order) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bond_percolation, + graph, + edge_order - 1 + ) + + res +} + +edgelist_percolation_impl <- function( + edges +) { + # Argument checks + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_edgelist_percolation, + edges - 1 + ) + + res +} + +site_percolation_impl <- function( + graph, + vertex_order = NULL +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(vertex_order)) { + vertex_order <- as_igraph_vs(graph, vertex_order) + vertex_order <- vertex_order - 1 + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_site_percolation, + graph, + vertex_order + ) + + res +} + +# ==== pre-calculated-subsets ==== + +local_scan_neighborhood_ecount_impl <- function( + graph, + weights = NULL, + neighborhoods +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(neighborhoods) && !is.list(neighborhoods)) { + cli::cli_abort( + "{.arg neighborhoods} must be a list or NULL", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_scan_neighborhood_ecount, + graph, + weights, + if (!is.null(neighborhoods)) lapply(neighborhoods, function(.x) .x - 1) + ) + + res +} + +local_scan_subset_ecount_impl <- function( + graph, + weights = NULL, + subsets +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + if (!is.null(subsets) && !is.list(subsets)) { + cli::cli_abort( + "{.arg subsets} must be a list or NULL", + call = rlang::caller_env() + ) + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_scan_subset_ecount, + graph, + weights, + if (!is.null(subsets)) lapply(subsets, function(.x) .x - 1) + ) + + res +} + +# ==== range-limited-centrality-measures ==== + +betweenness_cutoff_impl <- function( + graph, + vids = V(graph), + directed = TRUE, + weights = NULL, + cutoff = -1 +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + directed <- as.logical(directed) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + cutoff <- as.numeric(cutoff) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_betweenness_cutoff, + graph, + vids - 1, + directed, + weights, + cutoff + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +closeness_cutoff_impl <- function( + graph, + vids = V(graph), + mode = c("out", "in", "all", "total"), + weights = NULL, + normalized = FALSE, + cutoff = -1 +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + normalized <- as.logical(normalized) + cutoff <- as.numeric(cutoff) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_closeness_cutoff, + graph, + vids - 1, + mode, + weights, + normalized, + cutoff + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res$res) <- vertex_attr(graph, "name", vids) + } + res +} + +edge_betweenness_cutoff_impl <- function( + graph, + directed = TRUE, + weights = NULL, + cutoff = -1 +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + cutoff <- as.numeric(cutoff) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_edge_betweenness_cutoff, + graph, + directed, + weights, + cutoff + ) + + res +} + +harmonic_centrality_cutoff_impl <- function( + graph, + vids = V(graph), + mode = c("out", "in", "all", "total"), + weights = NULL, + normalized = FALSE, + cutoff = -1 +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + normalized <- as.logical(normalized) + cutoff <- as.numeric(cutoff) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_harmonic_centrality_cutoff, + graph, + vids - 1, + mode, + weights, + normalized, + cutoff + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +# ==== distances-and-metrics ==== + +average_path_length_dijkstra_impl <- function( + graph, + weights = NULL, + directed = TRUE, + unconnected = TRUE, + details = FALSE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + directed <- as.logical(directed) + unconnected <- as.logical(unconnected) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_average_path_length_dijkstra, + graph, + weights, + directed, + unconnected + ) + if (!details) { + res <- res$res + } + res +} + +average_path_length_impl <- function( + graph, + directed = TRUE, + unconn = TRUE, + details = FALSE +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + unconn <- as.logical(unconn) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_average_path_length, + graph, + directed, + unconn + ) + if (!details) { + res <- res$res + } + res +} + +diameter_dijkstra_impl <- function( + graph, + weights = NULL, + directed = TRUE, + unconnected = TRUE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + directed <- as.logical(directed) + unconnected <- as.logical(unconnected) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_diameter_dijkstra, + graph, + weights, + directed, + unconnected + ) + + res +} + +diameter_impl <- function( + graph, + directed = TRUE, + unconnected = TRUE +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + unconnected <- as.logical(unconnected) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_diameter, + graph, + directed, + unconnected + ) + + res +} + +distances_bellman_ford_impl <- function( + graph, + from = V(graph), + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_distances_bellman_ford, + graph, + from - 1, + to - 1, + weights, + mode + ) + + res +} + +distances_cutoff_impl <- function( + graph, + from = V(graph), + to = V(graph), + mode = c("out", "in", "all", "total"), + cutoff = -1 +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + cutoff <- as.numeric(cutoff) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_distances_cutoff, + graph, + from - 1, + to - 1, + mode, + cutoff + ) + + res +} + +distances_dijkstra_cutoff_impl <- function( + graph, + from = V(graph), + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total"), + cutoff = -1 +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + cutoff <- as.numeric(cutoff) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_distances_dijkstra_cutoff, + graph, + from - 1, + to - 1, + weights, + mode, + cutoff + ) + + res +} + +distances_dijkstra_impl <- function( + graph, + from = V(graph), + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_distances_dijkstra, + graph, + from - 1, + to - 1, + weights, + mode + ) + + res +} + +distances_floyd_warshall_impl <- function( + graph, + from = V(graph), + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total"), + method = c("automatic", "original", "tree") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + method <- switch_igraph_arg(method, "automatic" = 0L, "original" = 1L, "tree" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_distances_floyd_warshall, + graph, + from - 1, + to - 1, + weights, + mode, + method + ) + + res +} + +distances_impl <- function( + graph, + from = V(graph), + to = V(graph), + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_distances, + graph, + from - 1, + to - 1, + mode + ) + + res +} + +distances_johnson_impl <- function( + graph, + from = V(graph), + to = V(graph), + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_distances_johnson, + graph, + from - 1, + to - 1, + weights + ) + + res +} + +eccentricity_dijkstra_impl <- function( + graph, + vids = V(graph), + ..., + weights = NULL, + mode = c("all", "out", "in", "total") +) { + # Argument checks + check_dots_empty() + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_eccentricity_dijkstra, + graph, + weights, + vids - 1, + mode + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +eccentricity_impl <- function( + graph, + vids = V(graph), + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_eccentricity, + graph, + vids - 1, + mode + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +girth_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_girth, + graph + ) + if (igraph_opt("return.vs.es")) { + res$circle <- create_vs(graph, res$circle) + } + res +} + +graph_center_dijkstra_impl <- function( + graph, + ..., + weights = NULL, + mode = c("all", "out", "in", "total") +) { + # Argument checks + check_dots_empty() + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_graph_center_dijkstra, + graph, + weights, + mode + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +graph_center_impl <- function( + graph, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_graph_center, + graph, + mode + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +path_length_hist_impl <- function( + graph, + directed = TRUE +) { + # Argument checks + ensure_igraph(graph) + directed <- as.logical(directed) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_path_length_hist, + graph, + directed + ) + + res +} + +pseudo_diameter_dijkstra_impl <- function( + graph, + weights = NULL, + start_vid, + directed = TRUE, + unconnected = TRUE +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + start_vid <- as_igraph_vs(graph, start_vid) + if (length(start_vid) != 1) { + cli::cli_abort( + "{.arg start_vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + directed <- as.logical(directed) + unconnected <- as.logical(unconnected) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_pseudo_diameter_dijkstra, + graph, + weights, + start_vid - 1, + directed, + unconnected + ) + + res +} + +pseudo_diameter_impl <- function( + graph, + start_vid, + directed = TRUE, + unconnected = TRUE +) { + # Argument checks + ensure_igraph(graph) + start_vid <- as_igraph_vs(graph, start_vid) + if (length(start_vid) != 1) { + cli::cli_abort( + "{.arg start_vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + directed <- as.logical(directed) + unconnected <- as.logical(unconnected) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_pseudo_diameter, + graph, + start_vid - 1, + directed, + unconnected + ) + + res +} + +radius_dijkstra_impl <- function( + graph, + ..., + weights = NULL, + mode = c("all", "out", "in", "total") +) { + # Argument checks + check_dots_empty() + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_radius_dijkstra, + graph, + weights, + mode + ) + + res +} + +radius_impl <- function( + graph, + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_radius, + graph, + mode + ) + + res +} + +voronoi_impl <- function( + graph, + generators, + ..., + weights = NULL, + mode = c("out", "in", "all", "total"), + tiebreaker = c("random", "first", "last") +) { + # Argument checks + check_dots_empty() + ensure_igraph(graph) + generators <- as_igraph_vs(graph, generators) + generators <- generators - 1 + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + tiebreaker <- switch_igraph_arg(tiebreaker, "first" = 0L, "last" = 1L, "random" = 2L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_voronoi, + graph, + generators, + weights, + mode, + tiebreaker + ) + + res +} + +# ==== shortest-paths ==== + +get_all_shortest_paths_dijkstra_impl <- function( + graph, + from, + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_all_shortest_paths_dijkstra, + graph, + from - 1, + to - 1, + weights, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vpaths <- lapply(res$vpaths, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$epaths <- lapply(res$epaths, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +get_all_shortest_paths_impl <- function( + graph, + from, + to, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_all_shortest_paths, + graph, + from - 1, + to - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vpaths <- lapply(res$vpaths, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$epaths <- lapply(res$epaths, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +get_all_simple_paths_impl <- function( + graph, + from, + to = V(graph), + cutoff = -1, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + cutoff <- as.numeric(cutoff) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_all_simple_paths, + graph, + from - 1, + to - 1, + cutoff, + mode + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +get_k_shortest_paths_impl <- function( + graph, + from, + to, + ..., + k, + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + check_dots_empty() + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + k <- as.numeric(k) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (length(to) != 1) { + cli::cli_abort( + "{.arg to} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_k_shortest_paths, + graph, + weights, + k, + from - 1, + to - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vpaths <- lapply(res$vpaths, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$epaths <- lapply(res$epaths, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +get_shortest_path_astar_impl <- function( + graph, + from, + to, + weights = NULL, + mode = c("out", "in", "all", "total"), + heuristic = NULL +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (length(to) != 1) { + cli::cli_abort( + "{.arg to} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_shortest_path_astar, + graph, + from - 1, + to - 1, + weights, + mode, + heuristic + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- create_vs(graph, res$vertices) + } + if (igraph_opt("return.vs.es")) { + res$edges <- create_es(graph, res$edges) + } + res +} + +get_shortest_path_bellman_ford_impl <- function( + graph, + from, + to, + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (length(to) != 1) { + cli::cli_abort( + "{.arg to} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_shortest_path_bellman_ford, + graph, + from - 1, + to - 1, + weights, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- create_vs(graph, res$vertices) + } + if (igraph_opt("return.vs.es")) { + res$edges <- create_es(graph, res$edges) + } + res +} + +get_shortest_path_dijkstra_impl <- function( + graph, + from, + to, + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (length(to) != 1) { + cli::cli_abort( + "{.arg to} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_shortest_path_dijkstra, + graph, + from - 1, + to - 1, + weights, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- create_vs(graph, res$vertices) + } + if (igraph_opt("return.vs.es")) { + res$edges <- create_es(graph, res$edges) + } + res +} + +get_shortest_path_impl <- function( + graph, + from, + to, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (length(to) != 1) { + cli::cli_abort( + "{.arg to} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_shortest_path, + graph, + from - 1, + to - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- create_vs(graph, res$vertices) + } + if (igraph_opt("return.vs.es")) { + res$edges <- create_es(graph, res$edges) + } + res +} + +get_shortest_paths_bellman_ford_impl <- function( + graph, + from, + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_shortest_paths_bellman_ford, + graph, + from - 1, + to - 1, + weights, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +get_shortest_paths_dijkstra_impl <- function( + graph, + from, + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_shortest_paths_dijkstra, + graph, + from - 1, + to - 1, + weights, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +get_shortest_paths_impl <- function( + graph, + from, + to = V(graph), + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_shortest_paths, + graph, + from - 1, + to - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +vertex_path_from_edge_path_impl <- function( + graph, + start = NULL, + edge_path, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(start)) { + start <- as_igraph_vs(graph, start) + if (length(start) != 1) { + cli::cli_abort( + "{.arg start} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + } + edge_path <- as_igraph_es(graph, edge_path) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_vertex_path_from_edge_path, + graph, + start - 1, + edge_path - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res <- create_vs(graph, res) + } + res +} + +# ==== similarity-measures ==== + +bibcoupling_impl <- function( + graph, + vids = V(graph) +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bibcoupling, + graph, + vids - 1 + ) + + res +} + +cocitation_impl <- function( + graph, + vids = V(graph) +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_cocitation, + graph, + vids - 1 + ) + + res +} + +similarity_dice_es_impl <- function( + graph, + es = E(graph), + mode = c("all", "out", "in", "total"), + loops = FALSE +) { + # Argument checks + ensure_igraph(graph) + es <- as_igraph_es(graph, es) + mode <- switch_igraph_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_similarity_dice_es, + graph, + es - 1, + mode, + loops + ) + + res +} + +similarity_dice_impl <- function( + graph, + vids = V(graph), + mode = c("all", "out", "in", "total"), + loops = FALSE +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_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_similarity_dice, + graph, + vids - 1, + mode, + loops + ) + + res +} + +similarity_dice_pairs_impl <- function( + graph, + pairs, + mode = c("all", "out", "in", "total"), + loops = FALSE +) { + # Argument checks + ensure_igraph(graph) + pairs <- as_igraph_vs(graph, pairs) + mode <- switch_igraph_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_similarity_dice_pairs, + graph, + pairs - 1, + mode, + loops + ) + + res +} + +similarity_inverse_log_weighted_impl <- function( + graph, + vids = V(graph), + mode = c("all", "out", "in", "total") +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_similarity_inverse_log_weighted, + graph, + vids - 1, + mode + ) + + res +} + +similarity_jaccard_es_impl <- function( + graph, + es = E(graph), + mode = c("all", "out", "in", "total"), + loops = FALSE +) { + # Argument checks + ensure_igraph(graph) + es <- as_igraph_es(graph, es) + mode <- switch_igraph_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_similarity_jaccard_es, + graph, + es - 1, + mode, + loops + ) + + res +} + +similarity_jaccard_impl <- function( + graph, + vids = V(graph), + mode = c("all", "out", "in", "total"), + loops = FALSE +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_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_similarity_jaccard, + graph, + vids - 1, + mode, + loops + ) + + res +} + +similarity_jaccard_pairs_impl <- function( + graph, + pairs, + mode = c("all", "out", "in", "total"), + loops = FALSE +) { + # Argument checks + ensure_igraph(graph) + pairs <- as_igraph_vs(graph, pairs) + mode <- switch_igraph_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_similarity_jaccard_pairs, + graph, + pairs - 1, + mode, + loops + ) + + res +} + +# ==== sparsifiers ==== + +spanner_impl <- function( + graph, + stretch, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + stretch <- as.numeric(stretch) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_spanner, + graph, + stretch, + weights + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +# ==== spectral-properties ==== + +eigen_adjacency_impl <- function( + graph, + algorithm = c("arpack", "auto", "lapack", "comp_auto", "comp_lapack", "comp_arpack"), + which = list(), + options = arpack_defaults() +) { + # Argument checks + ensure_igraph(graph) + algorithm <- switch_igraph_arg( + algorithm, + "auto" = 0L, + "lapack" = 1L, + "arpack" = 2L, + "comp_auto" = 3L, + "comp_lapack" = 4L, + "comp_arpack" = 5L + ) + which.tmp <- eigen_defaults() + which.tmp[names(which)] <- which + which <- which.tmp + options <- modify_list(arpack_defaults(), options) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_eigen_adjacency, + graph, + algorithm, + which, + options + ) + + res +} + +get_laplacian_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + normalization = c("unnormalized", "symmetric", "left", "right"), + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + normalization <- switch_igraph_arg( + normalization, + "unnormalized" = 0L, + "symmetric" = 1L, + "left" = 2L, + "right" = 3L + ) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_laplacian, + graph, + mode, + normalization, + weights + ) + + res +} + +get_laplacian_sparse_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + normalization = c("unnormalized", "symmetric", "left", "right"), + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + normalization <- switch_igraph_arg( + normalization, + "unnormalized" = 0L, + "symmetric" = 1L, + "left" = 2L, + "right" = 3L + ) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_laplacian_sparse, + graph, + mode, + normalization, + weights + ) + + res +} + +# ==== subset-limited-centrality-measures ==== + +betweenness_subset_impl <- function( + graph, + vids = V(graph), + directed = TRUE, + sources = V(graph), + targets = V(graph), + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + directed <- as.logical(directed) + sources <- as_igraph_vs(graph, sources) + targets <- as_igraph_vs(graph, targets) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_betweenness_subset, + graph, + vids - 1, + directed, + sources - 1, + targets - 1, + weights + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +edge_betweenness_subset_impl <- function( + graph, + eids = E(graph), + directed = TRUE, + sources = V(graph), + targets = V(graph), + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + directed <- as.logical(directed) + sources <- as_igraph_vs(graph, sources) + targets <- as_igraph_vs(graph, targets) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_edge_betweenness_subset, + graph, + eids - 1, + directed, + sources - 1, + targets - 1, + weights + ) + + res +} + +# ==== summary-statistics ==== + +density_impl <- function( + graph, + loops = FALSE +) { + # Argument checks + ensure_igraph(graph) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_density, + graph, + loops + ) + + res +} + +diversity_impl <- function( + graph, + weights = NULL, + vids = V(graph) +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + vids <- as_igraph_vs(graph, vids) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_diversity, + graph, + weights, + vids - 1 + ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { + names(res) <- vertex_attr(graph, "name", vids) + } + res +} + +mean_degree_impl <- function( + graph, + loops = TRUE +) { + # Argument checks + ensure_igraph(graph) + loops <- as.logical(loops) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_mean_degree, + graph, + loops + ) + + res +} + +# ==== them-statistics ==== + +local_scan_0_them_impl <- function( + us, + them, + weights_them = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(us) + ensure_igraph(them) + if (is.null(weights_them) && "weight" %in% edge_attr_names(them)) { + weights_them <- E(them)$weight + } + if (!is.null(weights_them) && !all(is.na(weights_them))) { + weights_them <- as.numeric(weights_them) + } else { + weights_them <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_scan_0_them, + us, + them, + weights_them, + mode + ) + + res +} + +local_scan_1_ecount_them_impl <- function( + us, + them, + weights_them = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(us) + ensure_igraph(them) + if (is.null(weights_them) && "weight" %in% edge_attr_names(them)) { + weights_them <- E(them)$weight + } + if (!is.null(weights_them) && !all(is.na(weights_them))) { + weights_them <- as.numeric(weights_them) + } else { + weights_them <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_scan_1_ecount_them, + us, + them, + weights_them, + mode + ) + + res +} + +local_scan_k_ecount_them_impl <- function( + us, + them, + k, + weights_them = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(us) + ensure_igraph(them) + k <- as.numeric(k) + if (is.null(weights_them) && "weight" %in% edge_attr_names(them)) { + weights_them <- E(them)$weight + } + if (!is.null(weights_them) && !all(is.na(weights_them))) { + weights_them <- as.numeric(weights_them) + } else { + weights_them <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_scan_k_ecount_them, + us, + them, + k, + weights_them, + mode + ) + + res +} + +# ==== transitivity-or-clustering-coefficient ==== + +ecc_impl <- function( + graph, + eids = E(graph), + k = 3, + offset = FALSE, + normalize = TRUE +) { + # Argument checks + ensure_igraph(graph) + eids <- as_igraph_es(graph, eids) + k <- as.numeric(k) + offset <- as.logical(offset) + normalize <- as.logical(normalize) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_ecc, + graph, + eids - 1, + k, + offset, + normalize + ) + + res +} + +transitivity_avglocal_undirected_impl <- function( + graph, + mode = c("nan", "zero") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg(mode, "nan" = 0L, "zero" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_transitivity_avglocal_undirected, + graph, + mode + ) + + res +} + +transitivity_barrat_impl <- function( + graph, + vids = V(graph), + weights = NULL, + mode = c("nan", "zero") +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg(mode, "nan" = 0L, "zero" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_transitivity_barrat, + graph, + vids - 1, + weights, + mode + ) + + res +} + +transitivity_local_undirected_impl <- function( + graph, + vids = V(graph), + mode = c("nan", "zero") +) { + # Argument checks + ensure_igraph(graph) + vids <- as_igraph_vs(graph, vids) + mode <- switch_igraph_arg(mode, "nan" = 0L, "zero" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_transitivity_local_undirected, + graph, + vids - 1, + mode + ) + + res +} + +transitivity_undirected_impl <- function( + graph, + mode = c("nan", "zero") +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg(mode, "nan" = 0L, "zero" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_transitivity_undirected, + graph, + mode + ) + + res +} + +# ==== trees ==== + +is_forest_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + details = FALSE +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_forest, + graph, + mode + ) + if (igraph_opt("return.vs.es")) { + res$roots <- create_vs(graph, res$roots) + } + if (!details) { + res <- res$res + } + res +} + +is_tree_impl <- function( + graph, + mode = c("out", "in", "all", "total"), + details = FALSE +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_is_tree, + graph, + mode + ) + if (igraph_opt("return.vs.es") && vcount(graph) != 0) { + res$root <- create_vs(graph, res$root) + } + if (!details) { + res <- res$res + } + res +} + +minimum_spanning_tree_impl <- function( + graph, + weights = NULL +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_minimum_spanning_tree, + graph, + weights + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +minimum_spanning_tree_prim_impl <- function( + graph, + weights +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_minimum_spanning_tree_prim, + graph, + weights + ) + + res +} + +minimum_spanning_tree_unweighted_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_minimum_spanning_tree_unweighted, + graph + ) + + res +} + +random_spanning_tree_impl <- function( + graph, + vid = 0 +) { + # Argument checks + ensure_igraph(graph) + if (!is.null(vid)) { + vid <- as_igraph_vs(graph, vid) + if (length(vid) != 1) { + cli::cli_abort( + "{.arg vid} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + } + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_random_spanning_tree, + graph, + vid - 1 + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +to_prufer_impl <- function( + graph +) { + # Argument checks + ensure_igraph(graph) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_to_prufer, + graph + ) + + res +} + +# ==== unfolding-a-graph-into-a-tree ==== + +unfold_tree_impl <- function( + graph, + mode = c("all", "out", "in", "total"), + roots +) { + # Argument checks + ensure_igraph(graph) + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + roots <- as.numeric(roots) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_unfold_tree, + graph, + mode, + roots + ) + + res +} + +# ==== us-statistics ==== + +local_scan_0_impl <- function( + graph, + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_scan_0, + graph, + weights, + mode + ) + + res +} + +local_scan_1_ecount_impl <- function( + graph, + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_scan_1_ecount, + graph, + weights, + mode + ) + + res +} + +local_scan_k_ecount_impl <- function( + graph, + k, + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + k <- as.numeric(k) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_local_scan_k_ecount, + graph, + k, + weights, + mode + ) + + res +} + +# ==== widest-path-related-functions ==== + +get_widest_path_impl <- function( + graph, + from, + to, + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (length(to) != 1) { + cli::cli_abort( + "{.arg to} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_widest_path, + graph, + from - 1, + to - 1, + weights, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- create_vs(graph, res$vertices) + } + if (igraph_opt("return.vs.es")) { + res$edges <- create_es(graph, res$edges) + } + res +} + +get_widest_paths_impl <- function( + graph, + from, + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + if (length(from) != 1) { + cli::cli_abort( + "{.arg from} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_get_widest_paths, + graph, + from - 1, + to - 1, + weights, + mode + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- lapply(res$vertices, unsafe_create_vs, graph = graph, verts = V(graph)) + } + if (igraph_opt("return.vs.es")) { + res$edges <- lapply(res$edges, unsafe_create_es, graph = graph, es = E(graph)) + } + res +} + +widest_path_widths_dijkstra_impl <- function( + graph, + from = V(graph), + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_widest_path_widths_dijkstra, + graph, + from - 1, + to - 1, + weights, + mode + ) + + res +} + +widest_path_widths_floyd_warshall_impl <- function( + graph, + from = V(graph), + to = V(graph), + weights = NULL, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + from <- as_igraph_vs(graph, from) + to <- as_igraph_vs(graph, to) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_widest_path_widths_floyd_warshall, + graph, + from - 1, + to - 1, + weights, + mode + ) + + res +} diff --git a/R/aaa-visitors.R b/R/aaa-visitors.R new file mode 100644 index 00000000000..2f7850773b8 --- /dev/null +++ b/R/aaa-visitors.R @@ -0,0 +1,316 @@ +# Generated by tools/split-aaa-auto.R from aaa-auto.R — do not edit by hand +# styler: off + +# ==== breadth-first-search ==== + +bfs_closure_impl <- function( + graph, + root, + roots = NULL, + mode = c("out", "in", "all", "total"), + unreachable, + restricted = NULL, + callback +) { + # Argument checks + ensure_igraph(graph) + root <- as_igraph_vs(graph, root) + if (length(root) != 1) { + cli::cli_abort( + "{.arg root} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + if (!is.null(roots)) { + roots <- as_igraph_vs(graph, roots) + roots <- roots - 1 + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + unreachable <- as.logical(unreachable) + if (!is.null(restricted)) { + restricted <- as_igraph_vs(graph, restricted) + restricted <- restricted - 1 + } + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + { + out <- callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bfs_closure, + graph, + root - 1, + roots, + mode, + unreachable, + restricted, + callback_wrapped + ) + if (igraph_opt("return.vs.es")) { + res$order <- create_vs(graph, res$order) + } + res +} + +bfs_simple_impl <- function( + graph, + root, + mode = c("out", "in", "all", "total") +) { + # Argument checks + ensure_igraph(graph) + root <- as_igraph_vs(graph, root) + if (length(root) != 1) { + cli::cli_abort( + "{.arg root} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_bfs_simple, + graph, + root - 1, + mode + ) + if (igraph_opt("return.vs.es")) { + res$order <- create_vs(graph, res$order) + } + res +} + +# ==== depth-first-search ==== + +dfs_closure_impl <- function( + graph, + root, + mode = c("out", "in", "all", "total"), + unreachable, + in_callback, + out_callback +) { + # Argument checks + ensure_igraph(graph) + root <- as_igraph_vs(graph, root) + if (length(root) != 1) { + cli::cli_abort( + "{.arg root} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + unreachable <- as.logical(unreachable) + if (!is.null(in_callback)) { + if (!is.function(in_callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + in_callback_wrapped <- function(...) { + tryCatch( + { + out <- in_callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + in_callback_wrapped <- NULL + } + + if (!is.null(out_callback)) { + if (!is.function(out_callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + out_callback_wrapped <- function(...) { + tryCatch( + { + out <- out_callback(...) + if (is.logical(out) && length(out) == 1 && !is.na(out)) { + out + } else { + rlang::error_cnd(message = "Callback returned a value different from TRUE or FALSE") + } + }, + error = function(e) e, + interrupt = function(e) e + ) + } + } else { + out_callback_wrapped <- NULL + } + + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_dfs_closure, + graph, + root - 1, + mode, + unreachable, + in_callback_wrapped, + out_callback_wrapped + ) + if (igraph_opt("return.vs.es")) { + res$order <- create_vs(graph, res$order) + } + if (igraph_opt("return.vs.es")) { + res$order_out <- create_vs(graph, res$order_out) + } + res +} + +# ==== random-walks ==== + +random_edge_walk_impl <- function( + graph, + weights = NULL, + start, + mode = c("out", "in", "all", "total"), + steps, + stuck = c("return", "error") +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + start <- as_igraph_vs(graph, start) + if (length(start) != 1) { + cli::cli_abort( + "{.arg start} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + steps <- as.numeric(steps) + stuck <- switch_igraph_arg(stuck, "error" = 0L, "return" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_random_edge_walk, + graph, + weights, + start - 1, + mode, + steps, + stuck + ) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + +random_walk_impl <- function( + graph, + start, + steps, + weights = NULL, + mode = c("out", "in", "all", "total"), + stuck = c("return", "error") +) { + # Argument checks + ensure_igraph(graph) + if (is.null(weights) && "weight" %in% edge_attr_names(graph)) { + weights <- E(graph)$weight + } + if (!is.null(weights) && !all(is.na(weights))) { + weights <- as.numeric(weights) + } else { + weights <- NULL + } + start <- as_igraph_vs(graph, start) + if (length(start) != 1) { + cli::cli_abort( + "{.arg start} must specify exactly one vertex", + call = rlang::caller_env() + ) + } + mode <- switch_igraph_arg( + mode, + "out" = 1L, + "in" = 2L, + "all" = 3L, + "total" = 3L + ) + steps <- as.numeric(steps) + stuck <- switch_igraph_arg(stuck, "error" = 0L, "return" = 1L) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_random_walk, + graph, + weights, + start - 1, + mode, + steps, + stuck + ) + if (igraph_opt("return.vs.es")) { + res$vertices <- create_vs(graph, res$vertices) + } + if (igraph_opt("return.vs.es")) { + res$edges <- create_es(graph, res$edges) + } + res +} diff --git a/tools/aaa-categories.yaml b/tools/aaa-categories.yaml new file mode 100644 index 00000000000..129e40329d7 --- /dev/null +++ b/tools/aaa-categories.yaml @@ -0,0 +1,669 @@ +# Functions ordered by category +basicigraph: + adding-and-deleting-vertices-and-edges: + - igraph_add_edge + - igraph_add_edges + - igraph_add_vertices + - igraph_delete_edges + - igraph_delete_vertices + - igraph_delete_vertices_idx + basic-query-operations: + - igraph_degree + - igraph_ecount + - igraph_edge + - igraph_edges + - igraph_get_all_eids_between + - igraph_get_eid + - igraph_get_eids + - igraph_incident + - igraph_is_directed + - igraph_neighbors + - igraph_vcount + graph-constructors-and-destructors: + - igraph_copy + - igraph_empty + - igraph_empty_attrs + misc-helper-functions: + - igraph_expand_path_to_pairs + - igraph_invalidate_cache + - igraph_is_same_graph + +bipartite: + bipartite-adjacency-matrices: + - igraph_biadjacency + - igraph_get_biadjacency + create-two-mode-networks: + - igraph_bipartite_game + - igraph_bipartite_game_gnm + - igraph_bipartite_game_gnp + - igraph_create_bipartite + - igraph_full_bipartite + other-operations-on-bipartite-graphs: + - igraph_is_bipartite + project-two-mode-graphs: + - igraph_bipartite_projection + - igraph_bipartite_projection_size + +cliques: + cliques: + - igraph_clique_number + - igraph_clique_size_hist + - igraph_cliques + - igraph_cliques_callback + - igraph_is_clique + - igraph_is_complete + - igraph_largest_cliques + - igraph_maximal_cliques + - igraph_maximal_cliques_callback + - igraph_maximal_cliques_count + - igraph_maximal_cliques_file + - igraph_maximal_cliques_hist + - igraph_maximal_cliques_subset + independent-vertex-sets: + - igraph_independence_number + - igraph_independent_vertex_sets + - igraph_is_independent_vertex_set + - igraph_largest_independent_vertex_sets + - igraph_maximal_independent_vertex_sets + weighted-cliques: + - igraph_largest_weighted_cliques + - igraph_weighted_clique_number + - igraph_weighted_cliques + +coloring: + - igraph_is_bipartite_coloring + - igraph_is_edge_coloring + - igraph_is_perfect + - igraph_is_vertex_coloring + - igraph_vertex_coloring_greedy + +community: + common-functions-related-to-community-detection: + - igraph_community_optimal_modularity + - igraph_community_to_membership + - igraph_compare_communities + - igraph_modularity + - igraph_modularity_matrix + - igraph_reindex_membership + - igraph_split_join_distance + community-detection-based-on-statistical-mechanics: + - igraph_community_spinglass + - igraph_community_spinglass_single + community-structure-based-on-eigenvectors-of-matrices: + - igraph_community_leading_eigenvector + - igraph_le_community_to_membership + community-structure-based-on-the-optimization-of-modularity: + - igraph_community_fastgreedy + - igraph_community_leiden + - igraph_community_multilevel + edge-betweenness-based-community-detection: + - igraph_community_eb_get_merges + - igraph_community_edge_betweenness + fluid-communities: + - igraph_community_fluid_communities + infomap-algorithm: + - igraph_community_infomap + label-propagation: + - igraph_community_label_propagation + voronoi-communities: + - igraph_community_voronoi + walktrap-community-structure-based-on-random-walks: + - igraph_community_walktrap + +cycles: + acyclic-graphs-feedback-sets: + - igraph_feedback_arc_set + - igraph_feedback_vertex_set + - igraph_is_acyclic + - igraph_is_dag + - igraph_topological_sorting + cycle-bases: + - igraph_fundamental_cycles + - igraph_minimum_cycle_basis + eulerian-cycles: + - igraph_eulerian_cycle + - igraph_eulerian_path + - igraph_is_eulerian + finding-cycles: + - igraph_find_cycle + - igraph_simple_cycles + - igraph_simple_cycles_callback + +embedding: + spectral-embedding: + - igraph_adjacency_spectral_embedding + - igraph_dim_select + - igraph_laplacian_spectral_embedding + +error: + error-codes: + - igraph_strerror + +flows: + cohesive-blocks: + - igraph_cohesive_blocks + connectivity: + - igraph_edge_connectivity + - igraph_st_edge_connectivity + - igraph_st_vertex_connectivity + - igraph_vertex_connectivity + cuts-and-minimum-cuts: + - igraph_all_st_cuts + - igraph_all_st_mincuts + - igraph_gomory_hu_tree + - igraph_mincut + - igraph_mincut_value + - igraph_st_mincut + - igraph_st_mincut_value + edge-and-vertex-disjoint-paths: + - igraph_edge_disjoint_paths + - igraph_vertex_disjoint_paths + graph-adhesion-and-cohesion: + - igraph_adhesion + - igraph_cohesion + maximum-flows: + - igraph_dominator_tree + - igraph_maxflow + - igraph_maxflow_value + - igraph_residual_graph + - igraph_reverse_residual_graph + +foreign: + binary-formats: + - igraph_read_graph_graphdb + gml-format: + - igraph_read_graph_gml + - igraph_write_graph_gml + graphml-format: + - igraph_read_graph_graphml + - igraph_write_graph_graphml + graphviz-format: + - igraph_write_graph_dot + leda-format: + - igraph_write_graph_leda + pajek-format: + - igraph_read_graph_pajek + - igraph_write_graph_pajek + simple-edge-list-and-similar-formats: + - igraph_read_graph_dimacs_flow + - igraph_read_graph_edgelist + - igraph_read_graph_lgl + - igraph_read_graph_ncol + - igraph_write_graph_dimacs_flow + - igraph_write_graph_edgelist + - igraph_write_graph_lgl + - igraph_write_graph_ncol + ucinets-dl-file-format: + - igraph_read_graph_dl + +games: + degree-constrained-games: + - igraph_chung_lu_game + - igraph_degree_sequence_game + - igraph_k_regular_game + - igraph_rewire + - igraph_static_fitness_game + - igraph_static_power_law_game + edge-rewiring-games: + - igraph_rewire_directed_edges + - igraph_rewire_edges + - igraph_watts_strogatz_game + erdos-renyi-games: + - igraph_asymmetric_preference_game + - igraph_correlated_game + - igraph_correlated_pair_game + - igraph_erdos_renyi_game_gnm + - igraph_erdos_renyi_game_gnp + - igraph_hsbm_game + - igraph_hsbm_list_game + - igraph_preference_game + - igraph_sbm_game + growing-random-games: + - igraph_callaway_traits_game + - igraph_cited_type_game + - igraph_citing_cited_type_game + - igraph_establishment_game + - igraph_forest_fire_game + - igraph_growing_random_game + other-random-games: + - igraph_dot_product_game + - igraph_grg_game + - igraph_simple_interconnected_islands_game + - igraph_tree_game + preferential-attachment-games: + - igraph_barabasi_aging_game + - igraph_barabasi_game + - igraph_lastcit_game + - igraph_recent_degree_aging_game + - igraph_recent_degree_game + random-vectors: + - igraph_sample_dirichlet + - igraph_sample_sphere_surface + - igraph_sample_sphere_volume + +generators: + adjacency-generators: + - igraph_adjacency + - igraph_adjlist + - igraph_sparse_adjacency + - igraph_sparse_weighted_adjacency + - igraph_weighted_adjacency + - igraph_weighted_sparsemat + basic-generators: + - igraph_create + complete-graph-generators: + - igraph_full + - igraph_full_citation + - igraph_full_multipartite + - igraph_turan + degree-graph-generators: + - igraph_realize_bipartite_degree_sequence + - igraph_realize_degree_sequence + other-generators: + - igraph_de_bruijn + - igraph_generalized_petersen + - igraph_kautz + - igraph_mycielski_graph + pre-defined-generators: + - igraph_atlas + - igraph_famous + regular-structure-generators: + - igraph_circulant + - igraph_cycle_graph + - igraph_extended_chordal_ring + - igraph_hypercube + - igraph_lcf_vector + - igraph_path_graph + - igraph_ring + - igraph_square_lattice + - igraph_star + - igraph_triangular_lattice + - igraph_wheel + tree-generators: + - igraph_from_prufer + - igraph_kary_tree + - igraph_regular_tree + - igraph_symmetric_tree + - igraph_tree_from_parent_vector + +graphlets: + performing-graphlet-decomposition: + - igraph_graphlets + - igraph_graphlets_candidate_basis + - igraph_graphlets_project + +hrg: + conversion-to-and-from-igraph-graphs: + - igraph_from_hrg_dendrogram + - igraph_hrg_create + fitting-hrgs: + - igraph_hrg_consensus + - igraph_hrg_fit + hrg-sampling: + - igraph_hrg_game + - igraph_hrg_sample + - igraph_hrg_sample_many + predicting-missing-edges: + - igraph_hrg_predict + representing-hrgs: + - igraph_hrg_resize + - igraph_hrg_size + +isomorphism: + bliss-algorithm: + - igraph_isomorphic_bliss + functions-for-graphs-with-3-or-4-vertices: + - igraph_graph_count + - igraph_isoclass + - igraph_isoclass_create + - igraph_isoclass_subgraph + isomorphism-simple-interface: + - igraph_automorphism_group + - igraph_canonical_permutation + - igraph_count_automorphisms + - igraph_isomorphic + - igraph_subisomorphic + isomorphism-utility-functions: + - igraph_permute_vertices + - igraph_simplify_and_colorize + lad-algorithm: + - igraph_subisomorphic_lad + vf2-algorithm: + - igraph_count_isomorphisms_vf2 + - igraph_count_subisomorphisms_vf2 + - igraph_get_isomorphisms_vf2 + - igraph_get_isomorphisms_vf2_callback + - igraph_get_subisomorphisms_vf2 + - igraph_get_subisomorphisms_vf2_callback + - igraph_isomorphic_vf2 + - igraph_subisomorphic_vf2 + +layout: + drl-layout-generator: + - igraph_layout_drl + - igraph_layout_drl_3d + layouts-for-trees-and-acyclic-graphs: + - igraph_layout_reingold_tilford + - igraph_layout_reingold_tilford_circular + - igraph_layout_sugiyama + - igraph_layout_umap + - igraph_layout_umap_compute_weights + - igraph_roots_for_tree_layout + pp-layouts: + - igraph_layout_align + - igraph_layout_merge_dla + three-d-layout-generators: + - igraph_layout_fruchterman_reingold_3d + - igraph_layout_grid_3d + - igraph_layout_kamada_kawai_3d + - igraph_layout_random_3d + - igraph_layout_sphere + - igraph_layout_umap_3d + two-d-layout-generators: + - igraph_layout_bipartite + - igraph_layout_circle + - igraph_layout_davidson_harel + - igraph_layout_fruchterman_reingold + - igraph_layout_gem + - igraph_layout_graphopt + - igraph_layout_grid + - igraph_layout_kamada_kawai + - igraph_layout_lgl + - igraph_layout_mds + - igraph_layout_random + - igraph_layout_star + +motifs: + finding-triangles: + - igraph_count_adjacent_triangles + - igraph_count_triangles + - igraph_list_triangles + graph-motifs: + - igraph_motifs_randesu + - igraph_motifs_randesu_callback + - igraph_motifs_randesu_estimate + - igraph_motifs_randesu_no + graph-census: + - igraph_dyad_census + - igraph_triad_census + +nongraph: + compare-floats-with-tolerance: + - igraph_almost_equals + - igraph_cmp_epsilon + fitting-powerlaw-distributions-to-empirical-data: + - igraph_power_law_fit + igraph-version-number: + - igraph_version + random-sampling-from-very-long-sequences: + - igraph_random_sample + running-mean-of-a-time-series: + - igraph_running_mean + internal: + - igraph_finalizer + - igraph_has_attribute_table + linear-algebra: + - igraph_eigen_matrix + - igraph_eigen_matrix_symmetric + - igraph_solve_lsap + +operators: + miscellaneous-operators: + - igraph_connect_neighborhood + - igraph_contract_vertices + - igraph_graph_power + - igraph_induced_subgraph + - igraph_induced_subgraph_map + - igraph_linegraph + - igraph_mycielskian + - igraph_product + - igraph_reverse_edges + - igraph_rooted_product + - igraph_simplify + - igraph_subgraph_from_edges + - igraph_transitive_closure + - igraph_transitive_closure_dag + other-setlike-operators: + - igraph_complementer + - igraph_compose + - igraph_difference + union-and-intersection: + - igraph_disjoint_union + - igraph_disjoint_union_many + - igraph_intersection + - igraph_intersection_many + - igraph_join + - igraph_union + - igraph_union_many + +processes: + epidemic-models: + - igraph_sir + evolutionary-dynamics: + - igraph_deterministic_optimal_imitation + - igraph_moran_process + - igraph_roulette_wheel_imitation + - igraph_stochastic_imitation + +progress: + invoking-the-progress-handler: + - igraph_progress + +separators: + - igraph_all_minimal_st_separators + - igraph_even_tarjan_reduction + - igraph_is_minimal_separator + - igraph_is_separator + - igraph_minimum_size_separators + +spatial: + nongraph-spatial: + - igraph_convex_hull_2d + +status: + invoking-the-status-handler: + - igraph_status + +structural: + basic-properties: + - igraph_are_adjacent + - igraph_are_connected + centrality-measures: + - igraph_authority_score + - igraph_betweenness + - igraph_closeness + - igraph_constraint + - igraph_convergence_degree + - igraph_edge_betweenness + - igraph_eigenvector_centrality + - igraph_harmonic_centrality + - igraph_hub_and_authority_scores + - igraph_hub_score + - igraph_maxdegree + - igraph_pagerank + - igraph_personalized_pagerank + - igraph_personalized_pagerank_vs + - igraph_strength + centralization: + - igraph_centralization + - igraph_centralization_betweenness + - igraph_centralization_betweenness_tmax + - igraph_centralization_closeness + - igraph_centralization_closeness_tmax + - igraph_centralization_degree + - igraph_centralization_degree_tmax + - igraph_centralization_eigenvector_centrality + - igraph_centralization_eigenvector_centrality_tmax + degree-sequences: + - igraph_is_bigraphical + - igraph_is_graphical + directedness-conversion: + - igraph_to_directed + - igraph_to_undirected + efficiency-measures: + - igraph_average_local_efficiency + - igraph_global_efficiency + - igraph_local_efficiency + graph-components: + - igraph_articulation_points + - igraph_biconnected_components + - igraph_bridges + - igraph_connected_components + - igraph_count_reachable + - igraph_decompose + - igraph_is_biconnected + - igraph_is_connected + - igraph_subcomponent + k-cores: + - igraph_coreness + - igraph_trussness + matchings: + - igraph_is_matching + - igraph_is_maximal_matching + - igraph_maximum_bipartite_matching + matrix-representations: + - igraph_get_adjacency + - igraph_get_adjacency_sparse + - igraph_get_edgelist + - igraph_get_stochastic + - igraph_get_stochastic_sparse + maximum-cardinality-search-chordal-graphs: + - igraph_is_chordal + - igraph_maximum_cardinality_search + mixing-patterns: + - igraph_assortativity + - igraph_assortativity_degree + - igraph_assortativity_nominal + - igraph_avg_nearest_neighbor_degree + - igraph_degree_correlation_vector + - igraph_joint_degree_distribution + - igraph_joint_degree_matrix + - igraph_joint_type_distribution + - igraph_rich_club_sequence + mutual-edges: + - igraph_has_mutual + - igraph_is_mutual + - igraph_reciprocity + neighborhood-of-a-vertex: + - igraph_neighborhood + - igraph_neighborhood_graphs + - igraph_neighborhood_size + non-simple-graphs-multiple-and-loop-edges: + - igraph_count_loops + - igraph_count_multiple + - igraph_has_loop + - igraph_has_multiple + - igraph_is_loop + - igraph_is_multiple + - igraph_is_simple + percolation: + - igraph_bond_percolation + - igraph_edgelist_percolation + - igraph_site_percolation + pre-calculated-subsets: + - igraph_local_scan_neighborhood_ecount + - igraph_local_scan_subset_ecount + range-limited-centrality-measures: + - igraph_betweenness_cutoff + - igraph_closeness_cutoff + - igraph_edge_betweenness_cutoff + - igraph_harmonic_centrality_cutoff + distances-and-metrics: + - igraph_average_path_length + - igraph_average_path_length_dijkstra + - igraph_diameter + - igraph_diameter_dijkstra + - igraph_distances + - igraph_distances_bellman_ford + - igraph_distances_cutoff + - igraph_distances_dijkstra + - igraph_distances_dijkstra_cutoff + - igraph_distances_floyd_warshall + - igraph_distances_johnson + - igraph_eccentricity + - igraph_eccentricity_dijkstra + - igraph_girth + - igraph_graph_center + - igraph_graph_center_dijkstra + - igraph_path_length_hist + - igraph_pseudo_diameter + - igraph_pseudo_diameter_dijkstra + - igraph_radius + - igraph_radius_dijkstra + - igraph_voronoi + shortest-paths: + - igraph_get_all_shortest_paths + - igraph_get_all_shortest_paths_dijkstra + - igraph_get_all_simple_paths + - igraph_get_k_shortest_paths + - igraph_get_shortest_path + - igraph_get_shortest_path_astar + - igraph_get_shortest_path_bellman_ford + - igraph_get_shortest_path_dijkstra + - igraph_get_shortest_paths + - igraph_get_shortest_paths_bellman_ford + - igraph_get_shortest_paths_dijkstra + - igraph_vertex_path_from_edge_path + similarity-measures: + - igraph_bibcoupling + - igraph_cocitation + - igraph_similarity_dice + - igraph_similarity_dice_es + - igraph_similarity_dice_pairs + - igraph_similarity_inverse_log_weighted + - igraph_similarity_jaccard + - igraph_similarity_jaccard_es + - igraph_similarity_jaccard_pairs + sparsifiers: + - igraph_spanner + spectral-properties: + - igraph_eigen_adjacency + - igraph_get_laplacian + - igraph_get_laplacian_sparse + subset-limited-centrality-measures: + - igraph_betweenness_subset + - igraph_edge_betweenness_subset + summary-statistics: + - igraph_density + - igraph_diversity + - igraph_mean_degree + them-statistics: + - igraph_local_scan_0_them + - igraph_local_scan_1_ecount_them + - igraph_local_scan_k_ecount_them + transitivity-or-clustering-coefficient: + - igraph_ecc + - igraph_transitivity_avglocal_undirected + - igraph_transitivity_barrat + - igraph_transitivity_local_undirected + - igraph_transitivity_undirected + trees: + - igraph_is_forest + - igraph_is_tree + - igraph_minimum_spanning_tree + - igraph_minimum_spanning_tree_prim + - igraph_minimum_spanning_tree_unweighted + - igraph_random_spanning_tree + - igraph_to_prufer + unfolding-a-graph-into-a-tree: + - igraph_unfold_tree + us-statistics: + - igraph_local_scan_0 + - igraph_local_scan_1_ecount + - igraph_local_scan_k_ecount + widest-path-related-functions: + - igraph_get_widest_path + - igraph_get_widest_paths + - igraph_widest_path_widths_dijkstra + - igraph_widest_path_widths_floyd_warshall + +visitors: + breadth-first-search: + - igraph_bfs + - igraph_bfs_simple + depth-first-search: + - igraph_dfs + random-walks: + - igraph_random_edge_walk + - igraph_random_walk + diff --git a/tools/rebuild-cats.R b/tools/rebuild-cats.R new file mode 100644 index 00000000000..0295f1c9ba0 --- /dev/null +++ b/tools/rebuild-cats.R @@ -0,0 +1,379 @@ +#!/usr/bin/env Rscript +# Rebuild tools/aaa-categories.yaml so every R_igraph_* symbol has a home. +# +# Source of truth: the set of R_igraph_* symbols `.Call()`'d in R/aaa-auto.R +# (or its per-category split R/aaa-.R replacements), with nine hand- +# written R-binding wrappers in src/rcallback.c mapped back to the underlying +# C function they call. + +suppressPackageStartupMessages({ + library(yaml) +}) + +script_path <- (function() { + args <- commandArgs(trailingOnly = FALSE) + m <- grep("^--file=", args, value = TRUE) + if (length(m)) sub("^--file=", "", m[1]) else "tools/rebuild-cats.R" +})() +REPO <- normalizePath(file.path(dirname(script_path), "..")) +CATS <- file.path(REPO, "tools", "aaa-categories.yaml") + +# Canonical source of `.Call(R_igraph_*)` symbols: either the original +# monolithic R/aaa-auto.R (transitional / pre-split) or the set of per-category +# R/aaa-.R files produced by tools/split-aaa-auto.R. +AUTO_MONO <- file.path(REPO, "R", "aaa-auto.R") +AUTO_SPLIT <- list.files(file.path(REPO, "R"), + pattern = "^aaa-.*\\.R$", full.names = TRUE) +# Exclude aaa-auto.R from the split list so we never double-count during a +# transitional state where both exist. +AUTO_SPLIT <- AUTO_SPLIT[basename(AUTO_SPLIT) != "aaa-auto.R"] + +AUTO <- if (file.exists(AUTO_MONO)) AUTO_MONO else AUTO_SPLIT +if (length(AUTO) == 0) { + stop("No R/aaa-auto.R nor R/aaa-*.R files found — nothing to read.") +} + +# ---- 1. Extract canonical list --------------------------------------------- + +# Every _closure symbol that appears in aaa-auto.R wraps a C function of this +# name (verified from src/rcallback.c: each closure wrapper's body calls the +# mapped name). `igraph_transitive_closure` and `igraph_transitive_closure_dag` +# are unrelated graph-theory functions, not wrappers. +closure_map <- c( + "igraph_bfs_closure" = "igraph_bfs", + "igraph_dfs_closure" = "igraph_dfs", + "igraph_cliques_callback_closure" = "igraph_cliques_callback", + "igraph_maximal_cliques_callback_closure" = "igraph_maximal_cliques_callback", + "igraph_simple_cycles_callback_closure" = "igraph_simple_cycles_callback", + "igraph_get_isomorphisms_vf2_callback_closure" = "igraph_get_isomorphisms_vf2_callback", + "igraph_get_subisomorphisms_vf2_callback_closure" = "igraph_get_subisomorphisms_vf2_callback", + "igraph_motifs_randesu_callback_closure" = "igraph_motifs_randesu_callback", + "igraph_community_leading_eigenvector_callback_closure" = "igraph_community_leading_eigenvector" +) + +auto_lines <- unlist(lapply(AUTO, readLines)) +raw <- unique(regmatches(auto_lines, regexpr("R_igraph_[a-z0-9_]+", auto_lines))) +raw <- raw[nzchar(raw)] +raw <- sub("^R_", "", raw) + +canonical <- unname(ifelse(raw %in% names(closure_map), closure_map[raw], raw)) +canonical <- sort(unique(canonical)) + +message("canonical function count: ", length(canonical)) + + +# ---- 2. Placements: authoritative (category, subcategory, fn) for every +# function we're adding, moving, or splitting. Any fn listed here +# overrides its current placement in cats.yml. Omitted fns keep +# their current placement. ------------------------------------------- + +placements <- rbind( + # --- Previously-new additions (from initial reconciliation) --------------- + + # basicigraph / adding-and-deleting-vertices-and-edges + c("basicigraph", "adding-and-deleting-vertices-and-edges", "igraph_delete_vertices_idx"), + + # bipartite / create-two-mode-networks + c("bipartite", "create-two-mode-networks", "igraph_bipartite_game"), + + # generators / regular-structure-generators (typo fix; replaces removed igraph_lcf) + c("generators", "regular-structure-generators", "igraph_lcf_vector"), + + # generators / adjacency-generators + c("generators", "adjacency-generators", "igraph_weighted_sparsemat"), + + # motifs / graph-motifs + c("motifs", "graph-motifs", "igraph_motifs_randesu_callback"), + + # visitors / random-walks + c("visitors", "random-walks", "igraph_random_edge_walk"), + + # processes / evolutionary-dynamics + c("processes", "evolutionary-dynamics", "igraph_deterministic_optimal_imitation"), + c("processes", "evolutionary-dynamics", "igraph_moran_process"), + c("processes", "evolutionary-dynamics", "igraph_roulette_wheel_imitation"), + c("processes", "evolutionary-dynamics", "igraph_stochastic_imitation"), + + # games / random-vectors + c("games", "random-vectors", "igraph_sample_dirichlet"), + c("games", "random-vectors", "igraph_sample_sphere_surface"), + c("games", "random-vectors", "igraph_sample_sphere_volume"), + + # nongraph / internal + c("nongraph", "internal", "igraph_finalizer"), + + # --- Centrality / trees / basic-properties additions --------------------- + + c("structural", "centrality-measures", "igraph_authority_score"), + c("structural", "centrality-measures", "igraph_hub_score"), + c("structural", "trees", "igraph_minimum_spanning_tree_prim"), + c("structural", "trees", "igraph_minimum_spanning_tree_unweighted"), + c("structural", "basic-properties", "igraph_are_connected"), + + # --- Tier 1: retire `undocumented` into real subcategories --------------- + + c("flows", "maximum-flows", "igraph_residual_graph"), + c("flows", "maximum-flows", "igraph_reverse_residual_graph"), + c("hrg", "hrg-sampling", "igraph_hrg_sample_many"), + c("nongraph", "internal", "igraph_has_attribute_table"), + c("structural", "spectral-properties", "igraph_eigen_adjacency"), + c("nongraph", "linear-algebra", "igraph_eigen_matrix"), + c("nongraph", "linear-algebra", "igraph_eigen_matrix_symmetric"), + c("nongraph", "linear-algebra", "igraph_solve_lsap"), + + # --- Tier 3: move transitive closures into operators --------------------- + + c("operators", "miscellaneous-operators", "igraph_transitive_closure"), + c("operators", "miscellaneous-operators", "igraph_transitive_closure_dag"), + + # --- Tier 4a: split structural/shortest-path-related-functions ----------- + + # distances-and-metrics: scalar/vector metrics over the graph + c("structural", "distances-and-metrics", "igraph_average_path_length"), + c("structural", "distances-and-metrics", "igraph_average_path_length_dijkstra"), + c("structural", "distances-and-metrics", "igraph_diameter"), + c("structural", "distances-and-metrics", "igraph_diameter_dijkstra"), + c("structural", "distances-and-metrics", "igraph_distances"), + c("structural", "distances-and-metrics", "igraph_distances_bellman_ford"), + c("structural", "distances-and-metrics", "igraph_distances_cutoff"), + c("structural", "distances-and-metrics", "igraph_distances_dijkstra"), + c("structural", "distances-and-metrics", "igraph_distances_dijkstra_cutoff"), + c("structural", "distances-and-metrics", "igraph_distances_floyd_warshall"), + c("structural", "distances-and-metrics", "igraph_distances_johnson"), + c("structural", "distances-and-metrics", "igraph_eccentricity"), + c("structural", "distances-and-metrics", "igraph_eccentricity_dijkstra"), + c("structural", "distances-and-metrics", "igraph_girth"), + c("structural", "distances-and-metrics", "igraph_graph_center"), + c("structural", "distances-and-metrics", "igraph_graph_center_dijkstra"), + c("structural", "distances-and-metrics", "igraph_path_length_hist"), + c("structural", "distances-and-metrics", "igraph_pseudo_diameter"), + c("structural", "distances-and-metrics", "igraph_pseudo_diameter_dijkstra"), + c("structural", "distances-and-metrics", "igraph_radius"), + c("structural", "distances-and-metrics", "igraph_radius_dijkstra"), + c("structural", "distances-and-metrics", "igraph_voronoi"), + + # shortest-paths: functions returning actual path sequences + c("structural", "shortest-paths", "igraph_get_all_shortest_paths"), + c("structural", "shortest-paths", "igraph_get_all_shortest_paths_dijkstra"), + c("structural", "shortest-paths", "igraph_get_all_simple_paths"), + c("structural", "shortest-paths", "igraph_get_k_shortest_paths"), + c("structural", "shortest-paths", "igraph_get_shortest_path"), + c("structural", "shortest-paths", "igraph_get_shortest_path_astar"), + c("structural", "shortest-paths", "igraph_get_shortest_path_bellman_ford"), + c("structural", "shortest-paths", "igraph_get_shortest_path_dijkstra"), + c("structural", "shortest-paths", "igraph_get_shortest_paths"), + c("structural", "shortest-paths", "igraph_get_shortest_paths_bellman_ford"), + c("structural", "shortest-paths", "igraph_get_shortest_paths_dijkstra"), + c("structural", "shortest-paths", "igraph_vertex_path_from_edge_path"), + + # --- Tier 4b: split structural/other-operations -------------------------- + + c("structural", "matrix-representations", "igraph_get_adjacency"), + c("structural", "matrix-representations", "igraph_get_adjacency_sparse"), + c("structural", "matrix-representations", "igraph_get_edgelist"), + c("structural", "matrix-representations", "igraph_get_stochastic"), + c("structural", "matrix-representations", "igraph_get_stochastic_sparse"), + + c("structural", "mutual-edges", "igraph_has_mutual"), + c("structural", "mutual-edges", "igraph_is_mutual"), + c("structural", "mutual-edges", "igraph_reciprocity"), + + c("structural", "summary-statistics", "igraph_density"), + c("structural", "summary-statistics", "igraph_diversity"), + c("structural", "summary-statistics", "igraph_mean_degree") +) +colnames(placements) <- c("category", "subcategory", "fn") +placements <- as.data.frame(placements, stringsAsFactors = FALSE) + +# ---- 2b. Subcategory renames: applied before placements ----------------- +# Each entry: list(category, old, new). If `new` has length > 1 it's a split: +# the old subcategory is replaced by the listed new ones (functions are +# redistributed via the placements table; this just preserves ordering). + +subcategory_renames <- list( + list(category = "generators", old = "regular-structre-generators", new = "regular-structure-generators"), + list(category = "structural", old = "Sparsifiers", new = "sparsifiers"), + list(category = "motifs", old = "uncategorized", new = "graph-census"), + list(category = "structural", old = "shortest-path-related-functions", + new = c("distances-and-metrics", "shortest-paths")), + list(category = "structural", old = "other-operations", + new = c("matrix-representations", "mutual-edges", "summary-statistics")) +) + +# ---- 2c. Explicit subcategory ordering for categories whose natural order +# has been scrambled by splits. Only needed where the position of +# a split's new subs matters and can't be inferred from the input +# YAML (e.g. after the split has already been applied once). +subcategory_order_overrides <- list( + structural = c( + "basic-properties", + "centrality-measures", + "centralization", + "degree-sequences", + "directedness-conversion", + "efficiency-measures", + "graph-components", + "k-cores", + "matchings", + "matrix-representations", + "maximum-cardinality-search-chordal-graphs", + "mixing-patterns", + "mutual-edges", + "neighborhood-of-a-vertex", + "non-simple-graphs-multiple-and-loop-edges", + "percolation", + "pre-calculated-subsets", + "range-limited-centrality-measures", + "distances-and-metrics", + "shortest-paths", + "similarity-measures", + "sparsifiers", + "spectral-properties", + "subset-limited-centrality-measures", + "summary-statistics", + "them-statistics", + "transitivity-or-clustering-coefficient", + "trees", + "unfolding-a-graph-into-a-tree", + "us-statistics", + "widest-path-related-functions" + ) +) + +# ---- 3. Truly stale entries to remove -------------------------------------- + +stale_to_remove <- c( + "igraph_automorphism_group_bliss", + "igraph_canonical_permutation_bliss", + "igraph_count_automorphisms_bliss", + "igraph_bipartite_iea_game", + "igraph_iea_game", + "igraph_community_leiden_simple", + "igraph_delete_vertices_map", + "igraph_hamming", + "igraph_lcf", + "igraph_weighted_biadjacency", + "igraph_beta_weighted_gabriel_graph", + "igraph_circle_beta_skeleton", + "igraph_delaunay_graph", + "igraph_gabriel_graph", + "igraph_lune_beta_skeleton", + "igraph_nearest_neighbor_graph", + "igraph_relative_neighborhood_graph", + "igraph_spatial_edge_lengths" +) + +# ---- 4. Load current cats.yml and build the working structure -------------- + +d <- yaml::read_yaml(CATS) + +# Flatten to a table: (category, subcategory, fn) +flatten_cats <- function(d) { + rows <- list() + for (cat in names(d)) { + node <- d[[cat]] + if (is.null(node)) next + if (is.character(node)) { + # direct list under category + for (fn in node) rows[[length(rows)+1]] <- c(cat, NA_character_, fn) + } else if (is.list(node)) { + for (sub in names(node)) { + fns <- node[[sub]] + for (fn in fns) rows[[length(rows)+1]] <- c(cat, sub, fn) + } + } + } + df <- do.call(rbind, rows) + colnames(df) <- c("category", "subcategory", "fn") + as.data.frame(df, stringsAsFactors = FALSE) +} + +tbl <- flatten_cats(d) + +# Remove stale entries +tbl <- tbl[!tbl$fn %in% stale_to_remove, ] + +# Apply 1:1 subcategory renames on the flattened table. Splits (length>1) are +# handled entirely by placements, which reassign each function explicitly. +for (r in subcategory_renames) { + if (length(r$new) != 1) next + m <- tbl$category == r$category & !is.na(tbl$subcategory) & tbl$subcategory == r$old + tbl$subcategory[m] <- r$new +} + +# Drop rows whose fn is being moved/added — placements will reintroduce them +tbl <- tbl[!tbl$fn %in% placements$fn, ] + +# Append placements +tbl <- rbind(tbl, placements) + +# ---- 6. Validate ------------------------------------------------------------ + +have <- sort(unique(tbl$fn)) +missing <- setdiff(canonical, have) +extra <- setdiff(have, canonical) + +if (length(missing) || length(extra)) { + cat("MISSING from cats.yml after rebuild:\n") + cat(paste0(" ", missing, collapse = "\n"), "\n") + cat("EXTRA in cats.yml after rebuild:\n") + cat(paste0(" ", extra, collapse = "\n"), "\n") + stop("Validation failed: cats.yml does not match canonical list from aaa-auto.R") +} + +# ---- 7. Emit YAML ----------------------------------------------------------- + +# Preserve original category ordering, and within each category, the original +# subcategory ordering plus new subcategories at the end. Functions within a +# subcategory are sorted for stability. + +orig_cat_order <- names(d) +orig_sub_order <- lapply(orig_cat_order, function(cat) { + node <- d[[cat]] + if (is.list(node) && !is.null(names(node))) names(node) else character() +}) +names(orig_sub_order) <- orig_cat_order + +# Apply renames to orig ordering so renamed / split subs keep their original +# position (splits expand into their new names at the same slot) +for (r in subcategory_renames) { + prev <- orig_sub_order[[r$category]] + if (is.null(prev)) next + idx <- which(prev == r$old) + if (length(idx) == 0) next + orig_sub_order[[r$category]] <- append( + prev[-idx], r$new, after = idx - 1 + ) +} + +cats_present <- unique(tbl$category) +cat_order <- c(intersect(orig_cat_order, cats_present), + setdiff(cats_present, orig_cat_order)) + +lines <- character() +lines <- c(lines, "# Functions ordered by category") +for (cat in cat_order) { + lines <- c(lines, paste0(cat, ":")) + sub_tbl <- tbl[tbl$category == cat, ] + subs_present <- unique(sub_tbl$subcategory) + override <- subcategory_order_overrides[[cat]] + prev <- if (!is.null(override)) override else orig_sub_order[[cat]] + if (is.null(prev)) prev <- character() + sub_order <- c(intersect(prev, subs_present), setdiff(subs_present, prev)) + + # Handle direct-list entries (NA subcategory) -- emit them first, at category level + direct <- sub_tbl$fn[is.na(sub_tbl$subcategory)] + if (length(direct)) { + for (fn in sort(direct)) lines <- c(lines, paste0(" - ", fn)) + } + for (sub in sub_order) { + if (is.na(sub)) next + fns <- sort(sub_tbl$fn[!is.na(sub_tbl$subcategory) & sub_tbl$subcategory == sub]) + lines <- c(lines, paste0(" ", sub, ":")) + for (fn in fns) lines <- c(lines, paste0(" - ", fn)) + } + lines <- c(lines, "") +} + +writeLines(lines, CATS) +message("wrote ", CATS, " with ", nrow(tbl), " entries across ", length(cat_order), " categories") diff --git a/tools/split-aaa-auto.R b/tools/split-aaa-auto.R new file mode 100644 index 00000000000..c529d1c61c0 --- /dev/null +++ b/tools/split-aaa-auto.R @@ -0,0 +1,277 @@ +#!/usr/bin/env Rscript +# Split a monolithic stimulus-generated aaa-auto.R into per-category +# R/aaa-.R files, using tools/aaa-categories.yaml for the mapping. +# +# Source file: first argument, or .build/aaa-auto.R by default, or +# R/aaa-auto.R as a transitional fallback. +# +# Each output file: +# - starts with a generated-file header + `# styler: off` pragma +# - groups impls by subcategory, each group prefixed with a banner comment +# - preserves each impl's original source formatting byte-for-byte + +suppressPackageStartupMessages({ + library(yaml) +}) + +# ---- locate repo + inputs/outputs ---------------------------------------- + +script_path <- (function() { + args <- commandArgs(trailingOnly = FALSE) + m <- grep("^--file=", args, value = TRUE) + if (length(m)) sub("^--file=", "", m[1]) else "tools/split-aaa-auto.R" +})() +REPO <- normalizePath(file.path(dirname(script_path), "..")) +CATS <- file.path(REPO, "tools", "aaa-categories.yaml") + +# Source file precedence: CLI arg > .build/aaa-auto.R > R/aaa-auto.R +cli_args <- commandArgs(trailingOnly = TRUE) +candidate <- if (length(cli_args) >= 1) { + cli_args[1] +} else { + file.path(REPO, ".build", "aaa-auto.R") +} +if (!file.exists(candidate)) { + fallback <- file.path(REPO, "R", "aaa-auto.R") + if (file.exists(fallback)) { + candidate <- fallback + } else { + stop("split-aaa-auto.R: no source file found at ", candidate, + " or ", fallback) + } +} +SRC <- normalizePath(candidate) +OUT_DIR <- file.path(REPO, "R") + +message("split-aaa-auto.R: reading ", SRC) + +# ---- closure normalization (matches tools/rebuild-cats.R) ---------------- + +closure_map <- c( + "igraph_bfs_closure" = "igraph_bfs", + "igraph_dfs_closure" = "igraph_dfs", + "igraph_cliques_callback_closure" = "igraph_cliques_callback", + "igraph_maximal_cliques_callback_closure" = "igraph_maximal_cliques_callback", + "igraph_simple_cycles_callback_closure" = "igraph_simple_cycles_callback", + "igraph_get_isomorphisms_vf2_callback_closure" = "igraph_get_isomorphisms_vf2_callback", + "igraph_get_subisomorphisms_vf2_callback_closure" = "igraph_get_subisomorphisms_vf2_callback", + "igraph_motifs_randesu_callback_closure" = "igraph_motifs_randesu_callback", + "igraph_community_leading_eigenvector_callback_closure" = "igraph_community_leading_eigenvector" +) + +# ---- load categories: build (cat, sub) lookup keyed by C function -------- + +cats <- yaml::read_yaml(CATS) +cat_lookup <- new.env(hash = TRUE, parent = emptyenv()) +for (cat in names(cats)) { + node <- cats[[cat]] + if (is.character(node)) { + for (fn in node) cat_lookup[[fn]] <- list(category = cat, subcategory = NA_character_) + } else if (is.list(node)) { + for (sub in names(node)) { + for (fn in node[[sub]]) cat_lookup[[fn]] <- list(category = cat, subcategory = sub) + } + } +} + +# ---- parse SRC, extract each impl's (name, c_function, src_text) -------- + +src_lines <- readLines(SRC, warn = FALSE) +parsed <- parse(text = src_lines, keep.source = TRUE) +pdata <- utils::getParseData(parsed) # AST + line positions + +extract_call_sym <- function(expr) { + # First non-finalizer `.Call(...)` symbol found in the expression tree. + recur <- function(e) { + if (is.call(e)) { + fn <- e[[1]] + if (is.name(fn) && as.character(fn) == ".Call" && length(e) >= 2) { + first <- e[[2]] + if (is.name(first)) { + sym <- as.character(first) + if (sym != "R_igraph_finalizer") return(sym) + } + } + for (i in seq_along(e)) { + r <- recur(e[[i]]) + if (!is.null(r)) return(r) + } + } + NULL + } + recur(expr) +} + +impls <- list() +for (i in seq_along(parsed)) { + expr <- parsed[[i]] + if (!is.call(expr) || length(expr) < 3) next + op <- as.character(expr[[1]]) + if (!op %in% c("<-", "=", "assign")) next + lhs <- expr[[2]] + if (!is.name(lhs)) next + impl_name <- as.character(lhs) + if (!grepl("_impl$", impl_name)) next + rhs <- expr[[3]] + if (!(is.call(rhs) && identical(rhs[[1]], as.name("function")))) next + + sym <- extract_call_sym(rhs) + if (is.null(sym)) { + stop("impl ", impl_name, " has no non-finalizer .Call() target; aborting.") + } + c_literal <- sub("^R_", "", sym) + c_fn <- if (c_literal %in% names(closure_map)) closure_map[[c_literal]] else c_literal + + sref <- attr(expr, "srcref") + if (is.null(sref)) sref <- getSrcref(parsed)[[i]] + line1 <- sref[1L] + line2 <- sref[3L] + src_text <- paste(src_lines[line1:line2], collapse = "\n") + + impls[[length(impls) + 1L]] <- list( + impl_name = impl_name, + c_function = c_fn, + src_text = src_text + ) +} + +message("parsed ", length(impls), " _impl wrappers from source") + +# ---- map each impl to (category, subcategory); validate no gaps --------- + +unassigned <- character() +for (i in seq_along(impls)) { + lookup <- cat_lookup[[impls[[i]]$c_function]] + if (is.null(lookup)) { + unassigned <- c(unassigned, paste0(impls[[i]]$impl_name, " -> ", impls[[i]]$c_function)) + } else { + impls[[i]]$category <- lookup$category + impls[[i]]$subcategory <- lookup$subcategory + } +} +if (length(unassigned)) { + stop("impls without a category in ", CATS, ":\n ", + paste(unassigned, collapse = "\n "), + "\nAdd placements in tools/rebuild-cats.R and rerun it.") +} + +# ---- Subcategory ordering (mirrors tools/rebuild-cats.R override) ------- + +subcategory_order_overrides <- list( + structural = c( + "basic-properties", + "centrality-measures", + "centralization", + "degree-sequences", + "directedness-conversion", + "efficiency-measures", + "graph-components", + "k-cores", + "matchings", + "matrix-representations", + "maximum-cardinality-search-chordal-graphs", + "mixing-patterns", + "mutual-edges", + "neighborhood-of-a-vertex", + "non-simple-graphs-multiple-and-loop-edges", + "percolation", + "pre-calculated-subsets", + "range-limited-centrality-measures", + "distances-and-metrics", + "shortest-paths", + "similarity-measures", + "sparsifiers", + "spectral-properties", + "subset-limited-centrality-measures", + "summary-statistics", + "them-statistics", + "transitivity-or-clustering-coefficient", + "trees", + "unfolding-a-graph-into-a-tree", + "us-statistics", + "widest-path-related-functions" + ) +) + +# Natural subcategory order per category from the YAML itself (insertion order) +yaml_sub_order <- lapply(names(cats), function(cat) { + node <- cats[[cat]] + if (is.list(node) && !is.null(names(node))) names(node) else character() +}) +names(yaml_sub_order) <- names(cats) + +# ---- remove stale R/aaa-*.R before writing ------------------------------ + +stale <- list.files(OUT_DIR, pattern = "^aaa-.*\\.R$", full.names = TRUE) +# Keep aaa-auto.R if present — the caller deletes it manually after the split. +stale <- stale[basename(stale) != "aaa-auto.R"] +if (length(stale)) { + message("removing ", length(stale), " stale R/aaa-*.R file(s)") + invisible(file.remove(stale)) +} + +# ---- emit per-category files -------------------------------------------- + +impl_tbl <- do.call(rbind, lapply(impls, function(x) { + data.frame( + impl_name = x$impl_name, + c_function = x$c_function, + category = x$category, + subcategory = x$subcategory, + src_text = x$src_text, + stringsAsFactors = FALSE + ) +})) + +src_basename <- basename(SRC) +categories <- sort(unique(impl_tbl$category)) + +header <- c( + paste0("# Generated by tools/split-aaa-auto.R from ", src_basename, + " — do not edit by hand"), + "# styler: off", + "" +) + +for (cat in categories) { + sub_tbl <- impl_tbl[impl_tbl$category == cat, ] + + override <- subcategory_order_overrides[[cat]] + natural <- yaml_sub_order[[cat]] + prev <- if (!is.null(override)) override else if (!is.null(natural)) natural else character() + subs_present <- unique(sub_tbl$subcategory) + sub_order <- c(intersect(prev, subs_present), setdiff(subs_present, prev)) + + out_lines <- header + + # Insert a blank line between each impl's source block. + with_blanks <- function(srcs) as.vector(rbind(srcs, "")) + + # Emit NA (flat-list) entries first with no banner + flat_mask <- is.na(sub_tbl$subcategory) + if (any(flat_mask)) { + flat <- sub_tbl[flat_mask, ] + flat <- flat[order(flat$impl_name), ] + out_lines <- c(out_lines, with_blanks(flat$src_text)) + } + + for (sub in sub_order) { + if (is.na(sub)) next + rows <- sub_tbl[!is.na(sub_tbl$subcategory) & sub_tbl$subcategory == sub, ] + rows <- rows[order(rows$impl_name), ] + if (nrow(rows) == 0) next + banner <- paste0("# ==== ", sub, " ====") + out_lines <- c(out_lines, banner, "", with_blanks(rows$src_text)) + } + + # Strip trailing empty lines, leave exactly one terminating newline + while (length(out_lines) && !nzchar(tail(out_lines, 1))) { + out_lines <- out_lines[-length(out_lines)] + } + + out_path <- file.path(OUT_DIR, paste0("aaa-", cat, ".R")) + writeLines(out_lines, out_path) +} + +message("wrote ", length(categories), " R/aaa-.R files (", + nrow(impl_tbl), " impls total)") From d6f8d9ded67771d867d1422342ec88d5f12b0024 Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 23 Apr 2026 12:44:35 +0000 Subject: [PATCH 2/2] chore: Auto-update from GitHub Actions Run: https://github.com/igraph/rigraph/actions/runs/24835564384 --- tools/rebuild-cats.R | 106 +++++++++++++++++++++++++++++----------- tools/split-aaa-auto.R | 108 +++++++++++++++++++++++++++++------------ 2 files changed, 156 insertions(+), 58 deletions(-) diff --git a/tools/rebuild-cats.R b/tools/rebuild-cats.R index 0295f1c9ba0..b5d02dc5bce 100644 --- a/tools/rebuild-cats.R +++ b/tools/rebuild-cats.R @@ -21,9 +21,12 @@ CATS <- file.path(REPO, "tools", "aaa-categories.yaml") # Canonical source of `.Call(R_igraph_*)` symbols: either the original # monolithic R/aaa-auto.R (transitional / pre-split) or the set of per-category # R/aaa-.R files produced by tools/split-aaa-auto.R. -AUTO_MONO <- file.path(REPO, "R", "aaa-auto.R") -AUTO_SPLIT <- list.files(file.path(REPO, "R"), - pattern = "^aaa-.*\\.R$", full.names = TRUE) +AUTO_MONO <- file.path(REPO, "R", "aaa-auto.R") +AUTO_SPLIT <- list.files( + file.path(REPO, "R"), + pattern = "^aaa-.*\\.R$", + full.names = TRUE +) # Exclude aaa-auto.R from the split list so we never double-count during a # transitional state where both exist. AUTO_SPLIT <- AUTO_SPLIT[basename(AUTO_SPLIT) != "aaa-auto.R"] @@ -52,7 +55,10 @@ closure_map <- c( ) auto_lines <- unlist(lapply(AUTO, readLines)) -raw <- unique(regmatches(auto_lines, regexpr("R_igraph_[a-z0-9_]+", auto_lines))) +raw <- unique(regmatches( + auto_lines, + regexpr("R_igraph_[a-z0-9_]+", auto_lines) +)) raw <- raw[nzchar(raw)] raw <- sub("^R_", "", raw) @@ -191,13 +197,23 @@ placements <- as.data.frame(placements, stringsAsFactors = FALSE) # redistributed via the placements table; this just preserves ordering). subcategory_renames <- list( - list(category = "generators", old = "regular-structre-generators", new = "regular-structure-generators"), - list(category = "structural", old = "Sparsifiers", new = "sparsifiers"), - list(category = "motifs", old = "uncategorized", new = "graph-census"), - list(category = "structural", old = "shortest-path-related-functions", - new = c("distances-and-metrics", "shortest-paths")), - list(category = "structural", old = "other-operations", - new = c("matrix-representations", "mutual-edges", "summary-statistics")) + list( + category = "generators", + old = "regular-structre-generators", + new = "regular-structure-generators" + ), + list(category = "structural", old = "Sparsifiers", new = "sparsifiers"), + list(category = "motifs", old = "uncategorized", new = "graph-census"), + list( + category = "structural", + old = "shortest-path-related-functions", + new = c("distances-and-metrics", "shortest-paths") + ), + list( + category = "structural", + old = "other-operations", + new = c("matrix-representations", "mutual-edges", "summary-statistics") + ) ) # ---- 2c. Explicit subcategory ordering for categories whose natural order @@ -272,14 +288,20 @@ flatten_cats <- function(d) { rows <- list() for (cat in names(d)) { node <- d[[cat]] - if (is.null(node)) next + if (is.null(node)) { + next + } if (is.character(node)) { # direct list under category - for (fn in node) rows[[length(rows)+1]] <- c(cat, NA_character_, fn) + for (fn in node) { + rows[[length(rows) + 1]] <- c(cat, NA_character_, fn) + } } else if (is.list(node)) { for (sub in names(node)) { fns <- node[[sub]] - for (fn in fns) rows[[length(rows)+1]] <- c(cat, sub, fn) + for (fn in fns) { + rows[[length(rows) + 1]] <- c(cat, sub, fn) + } } } } @@ -296,8 +318,12 @@ tbl <- tbl[!tbl$fn %in% stale_to_remove, ] # Apply 1:1 subcategory renames on the flattened table. Splits (length>1) are # handled entirely by placements, which reassign each function explicitly. for (r in subcategory_renames) { - if (length(r$new) != 1) next - m <- tbl$category == r$category & !is.na(tbl$subcategory) & tbl$subcategory == r$old + if (length(r$new) != 1) { + next + } + m <- tbl$category == r$category & + !is.na(tbl$subcategory) & + tbl$subcategory == r$old tbl$subcategory[m] <- r$new } @@ -311,14 +337,16 @@ tbl <- rbind(tbl, placements) have <- sort(unique(tbl$fn)) missing <- setdiff(canonical, have) -extra <- setdiff(have, canonical) +extra <- setdiff(have, canonical) if (length(missing) || length(extra)) { cat("MISSING from cats.yml after rebuild:\n") cat(paste0(" ", missing, collapse = "\n"), "\n") cat("EXTRA in cats.yml after rebuild:\n") cat(paste0(" ", extra, collapse = "\n"), "\n") - stop("Validation failed: cats.yml does not match canonical list from aaa-auto.R") + stop( + "Validation failed: cats.yml does not match canonical list from aaa-auto.R" + ) } # ---- 7. Emit YAML ----------------------------------------------------------- @@ -338,11 +366,17 @@ names(orig_sub_order) <- orig_cat_order # position (splits expand into their new names at the same slot) for (r in subcategory_renames) { prev <- orig_sub_order[[r$category]] - if (is.null(prev)) next + if (is.null(prev)) { + next + } idx <- which(prev == r$old) - if (length(idx) == 0) next + if (length(idx) == 0) { + next + } orig_sub_order[[r$category]] <- append( - prev[-idx], r$new, after = idx - 1 + prev[-idx], + r$new, + after = idx - 1 ) } @@ -358,22 +392,40 @@ for (cat in cat_order) { subs_present <- unique(sub_tbl$subcategory) override <- subcategory_order_overrides[[cat]] prev <- if (!is.null(override)) override else orig_sub_order[[cat]] - if (is.null(prev)) prev <- character() + if (is.null(prev)) { + prev <- character() + } sub_order <- c(intersect(prev, subs_present), setdiff(subs_present, prev)) # Handle direct-list entries (NA subcategory) -- emit them first, at category level direct <- sub_tbl$fn[is.na(sub_tbl$subcategory)] if (length(direct)) { - for (fn in sort(direct)) lines <- c(lines, paste0(" - ", fn)) + for (fn in sort(direct)) { + lines <- c(lines, paste0(" - ", fn)) + } } for (sub in sub_order) { - if (is.na(sub)) next - fns <- sort(sub_tbl$fn[!is.na(sub_tbl$subcategory) & sub_tbl$subcategory == sub]) + if (is.na(sub)) { + next + } + fns <- sort(sub_tbl$fn[ + !is.na(sub_tbl$subcategory) & sub_tbl$subcategory == sub + ]) lines <- c(lines, paste0(" ", sub, ":")) - for (fn in fns) lines <- c(lines, paste0(" - ", fn)) + for (fn in fns) { + lines <- c(lines, paste0(" - ", fn)) + } } lines <- c(lines, "") } writeLines(lines, CATS) -message("wrote ", CATS, " with ", nrow(tbl), " entries across ", length(cat_order), " categories") +message( + "wrote ", + CATS, + " with ", + nrow(tbl), + " entries across ", + length(cat_order), + " categories" +) diff --git a/tools/split-aaa-auto.R b/tools/split-aaa-auto.R index c529d1c61c0..c11e9fc8a60 100644 --- a/tools/split-aaa-auto.R +++ b/tools/split-aaa-auto.R @@ -36,8 +36,12 @@ if (!file.exists(candidate)) { if (file.exists(fallback)) { candidate <- fallback } else { - stop("split-aaa-auto.R: no source file found at ", candidate, - " or ", fallback) + stop( + "split-aaa-auto.R: no source file found at ", + candidate, + " or ", + fallback + ) } } SRC <- normalizePath(candidate) @@ -66,10 +70,14 @@ cat_lookup <- new.env(hash = TRUE, parent = emptyenv()) for (cat in names(cats)) { node <- cats[[cat]] if (is.character(node)) { - for (fn in node) cat_lookup[[fn]] <- list(category = cat, subcategory = NA_character_) + for (fn in node) { + cat_lookup[[fn]] <- list(category = cat, subcategory = NA_character_) + } } else if (is.list(node)) { for (sub in names(node)) { - for (fn in node[[sub]]) cat_lookup[[fn]] <- list(category = cat, subcategory = sub) + for (fn in node[[sub]]) { + cat_lookup[[fn]] <- list(category = cat, subcategory = sub) + } } } } @@ -78,7 +86,7 @@ for (cat in names(cats)) { src_lines <- readLines(SRC, warn = FALSE) parsed <- parse(text = src_lines, keep.source = TRUE) -pdata <- utils::getParseData(parsed) # AST + line positions +pdata <- utils::getParseData(parsed) # AST + line positions extract_call_sym <- function(expr) { # First non-finalizer `.Call(...)` symbol found in the expression tree. @@ -105,25 +113,41 @@ extract_call_sym <- function(expr) { impls <- list() for (i in seq_along(parsed)) { expr <- parsed[[i]] - if (!is.call(expr) || length(expr) < 3) next + if (!is.call(expr) || length(expr) < 3) { + next + } op <- as.character(expr[[1]]) - if (!op %in% c("<-", "=", "assign")) next + if (!op %in% c("<-", "=", "assign")) { + next + } lhs <- expr[[2]] - if (!is.name(lhs)) next + if (!is.name(lhs)) { + next + } impl_name <- as.character(lhs) - if (!grepl("_impl$", impl_name)) next + if (!grepl("_impl$", impl_name)) { + next + } rhs <- expr[[3]] - if (!(is.call(rhs) && identical(rhs[[1]], as.name("function")))) next + if (!(is.call(rhs) && identical(rhs[[1]], as.name("function")))) { + next + } sym <- extract_call_sym(rhs) if (is.null(sym)) { stop("impl ", impl_name, " has no non-finalizer .Call() target; aborting.") } c_literal <- sub("^R_", "", sym) - c_fn <- if (c_literal %in% names(closure_map)) closure_map[[c_literal]] else c_literal + c_fn <- if (c_literal %in% names(closure_map)) { + closure_map[[c_literal]] + } else { + c_literal + } sref <- attr(expr, "srcref") - if (is.null(sref)) sref <- getSrcref(parsed)[[i]] + if (is.null(sref)) { + sref <- getSrcref(parsed)[[i]] + } line1 <- sref[1L] line2 <- sref[3L] src_text <- paste(src_lines[line1:line2], collapse = "\n") @@ -150,9 +174,13 @@ for (i in seq_along(impls)) { } } if (length(unassigned)) { - stop("impls without a category in ", CATS, ":\n ", - paste(unassigned, collapse = "\n "), - "\nAdd placements in tools/rebuild-cats.R and rerun it.") + stop( + "impls without a category in ", + CATS, + ":\n ", + paste(unassigned, collapse = "\n "), + "\nAdd placements in tools/rebuild-cats.R and rerun it." + ) } # ---- Subcategory ordering (mirrors tools/rebuild-cats.R override) ------- @@ -212,16 +240,19 @@ if (length(stale)) { # ---- emit per-category files -------------------------------------------- -impl_tbl <- do.call(rbind, lapply(impls, function(x) { - data.frame( - impl_name = x$impl_name, - c_function = x$c_function, - category = x$category, - subcategory = x$subcategory, - src_text = x$src_text, - stringsAsFactors = FALSE - ) -})) +impl_tbl <- do.call( + rbind, + lapply(impls, function(x) { + data.frame( + impl_name = x$impl_name, + c_function = x$c_function, + category = x$category, + subcategory = x$subcategory, + src_text = x$src_text, + stringsAsFactors = FALSE + ) + }) +) src_basename <- basename(SRC) categories <- sort(unique(impl_tbl$category)) @@ -237,8 +268,14 @@ for (cat in categories) { sub_tbl <- impl_tbl[impl_tbl$category == cat, ] override <- subcategory_order_overrides[[cat]] - natural <- yaml_sub_order[[cat]] - prev <- if (!is.null(override)) override else if (!is.null(natural)) natural else character() + natural <- yaml_sub_order[[cat]] + prev <- if (!is.null(override)) { + override + } else if (!is.null(natural)) { + natural + } else { + character() + } subs_present <- unique(sub_tbl$subcategory) sub_order <- c(intersect(prev, subs_present), setdiff(subs_present, prev)) @@ -256,10 +293,14 @@ for (cat in categories) { } for (sub in sub_order) { - if (is.na(sub)) next + if (is.na(sub)) { + next + } rows <- sub_tbl[!is.na(sub_tbl$subcategory) & sub_tbl$subcategory == sub, ] rows <- rows[order(rows$impl_name), ] - if (nrow(rows) == 0) next + if (nrow(rows) == 0) { + next + } banner <- paste0("# ==== ", sub, " ====") out_lines <- c(out_lines, banner, "", with_blanks(rows$src_text)) } @@ -273,5 +314,10 @@ for (cat in categories) { writeLines(out_lines, out_path) } -message("wrote ", length(categories), " R/aaa-.R files (", - nrow(impl_tbl), " impls total)") +message( + "wrote ", + length(categories), + " R/aaa-.R files (", + nrow(impl_tbl), + " impls total)" +)