From be072115ab361c214e3e9c4ea543f41d1a7cbf0d Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 25 Jan 2026 18:38:47 +0000 Subject: [PATCH 01/12] Initial plan From c3c3832c293169c4ec25da1a9fbcae4ed727c09e Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 25 Jan 2026 18:51:55 +0000 Subject: [PATCH 02/12] feat: autogenerate igraph_community_leading_eigenvector without callback Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- R/aaa-auto.R | 41 ++++++++++++++ R/community.R | 44 ++++++++++----- src/cpp11.cpp | 4 +- src/rinterface.c | 95 +++++++++++++++++++++++++++++++++ tools/stimulus/functions-R.yaml | 14 ++++- 5 files changed, 180 insertions(+), 18 deletions(-) diff --git a/R/aaa-auto.R b/R/aaa-auto.R index 23226656712..97a0446b80e 100644 --- a/R/aaa-auto.R +++ b/R/aaa-auto.R @@ -9224,6 +9224,47 @@ reindex_membership_impl <- function( res } +community_leading_eigenvector_impl <- function( + graph, + weights = NULL, + membership = NULL, + steps = -1, + options = arpack_defaults(), + start = 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 + } + if (!is.null(membership)) { + membership <- as.numeric(membership) + } + steps <- as.numeric(steps) + options <- modify_list(arpack_defaults(), options) + start <- as.logical(start) + + on.exit(.Call(R_igraph_finalizer)) + # Function call + res <- .Call( + R_igraph_community_leading_eigenvector, + graph, + weights, + membership, + steps, + options, + start + ) + + class(res) <- "igraph.eigenc" + res +} + community_fluid_communities_impl <- function( graph, no_of_communities diff --git a/R/community.R b/R/community.R index 4bd1536ec7b..1899b4014f7 100644 --- a/R/community.R +++ b/R/community.R @@ -2239,6 +2239,22 @@ cluster_leading_eigen <- function( options <- options() } + # Callback is no longer supported + if (!is.null(callback)) { + lifecycle::deprecate_stop( + "2.1.0", + "cluster_leading_eigen(callback = )", + details = "The callback functionality has been removed." + ) + } + if (!is.null(extra)) { + lifecycle::deprecate_stop( + "2.1.0", + "cluster_leading_eigen(extra = )", + details = "The extra functionality has been removed." + ) + } + # Argument checks ensure_igraph(graph) @@ -2251,26 +2267,26 @@ cluster_leading_eigen <- function( } else { weights <- NULL } - if (!is.null(start)) { + + # Convert start membership to 0-based indexing and determine start flag + start_flag <- !is.null(start) + if (start_flag) { start <- as.numeric(start) - 1 } options <- modify_list(arpack_defaults(), options) - on.exit(.Call(Rx_igraph_finalizer)) - # Function call - res <- .Call( - Rx_igraph_community_leading_eigenvector, - graph, - steps, - weights, - options, - start, - callback, - extra, - env, - environment(igraph.i.levc.arp) + on.exit(.Call(R_igraph_finalizer)) + # Function call using autogenerated implementation + res <- community_leading_eigenvector_impl( + graph = graph, + weights = weights, + membership = start, + steps = steps, + options = options, + start = start_flag ) + if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } diff --git a/src/cpp11.cpp b/src/cpp11.cpp index bb5a857c192..a36f3655219 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -94,6 +94,7 @@ extern SEXP R_igraph_community_fastgreedy(SEXP, SEXP); extern SEXP R_igraph_community_fluid_communities(SEXP, SEXP); extern SEXP R_igraph_community_infomap(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_label_propagation(SEXP, SEXP, SEXP, SEXP, SEXP); +extern SEXP R_igraph_community_leading_eigenvector(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_leiden(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_multilevel(SEXP, SEXP, SEXP); extern SEXP R_igraph_community_optimal_modularity(SEXP, SEXP); @@ -522,7 +523,6 @@ extern SEXP Rx_igraph_cited_type_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP Rx_igraph_citing_cited_type_game(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP Rx_igraph_community_edge_betweenness(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP Rx_igraph_community_fastgreedy(SEXP, SEXP, SEXP, SEXP, SEXP); -extern SEXP Rx_igraph_community_leading_eigenvector(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP Rx_igraph_community_to_membership2(SEXP, SEXP, SEXP); extern SEXP Rx_igraph_compose(SEXP, SEXP, SEXP); extern SEXP Rx_igraph_connect_neighborhood(SEXP, SEXP, SEXP); @@ -694,6 +694,7 @@ static const R_CallMethodDef CallEntries[] = { {"R_igraph_community_fluid_communities", (DL_FUNC) &R_igraph_community_fluid_communities, 2}, {"R_igraph_community_infomap", (DL_FUNC) &R_igraph_community_infomap, 4}, {"R_igraph_community_label_propagation", (DL_FUNC) &R_igraph_community_label_propagation, 5}, + {"R_igraph_community_leading_eigenvector", (DL_FUNC) &R_igraph_community_leading_eigenvector, 6}, {"R_igraph_community_leiden", (DL_FUNC) &R_igraph_community_leiden, 8}, {"R_igraph_community_multilevel", (DL_FUNC) &R_igraph_community_multilevel, 3}, {"R_igraph_community_optimal_modularity", (DL_FUNC) &R_igraph_community_optimal_modularity, 2}, @@ -1122,7 +1123,6 @@ static const R_CallMethodDef CallEntries[] = { {"Rx_igraph_citing_cited_type_game", (DL_FUNC) &Rx_igraph_citing_cited_type_game, 5}, {"Rx_igraph_community_edge_betweenness", (DL_FUNC) &Rx_igraph_community_edge_betweenness, 8}, {"Rx_igraph_community_fastgreedy", (DL_FUNC) &Rx_igraph_community_fastgreedy, 5}, - {"Rx_igraph_community_leading_eigenvector", (DL_FUNC) &Rx_igraph_community_leading_eigenvector, 9}, {"Rx_igraph_community_to_membership2", (DL_FUNC) &Rx_igraph_community_to_membership2, 3}, {"Rx_igraph_compose", (DL_FUNC) &Rx_igraph_compose, 3}, {"Rx_igraph_connect_neighborhood", (DL_FUNC) &Rx_igraph_connect_neighborhood, 3}, diff --git a/src/rinterface.c b/src/rinterface.c index 20d3e8bd8e3..f2d0056b422 100644 --- a/src/rinterface.c +++ b/src/rinterface.c @@ -12323,6 +12323,101 @@ SEXP R_igraph_reindex_membership(SEXP membership) { return(r_result); } +/*-------------------------------------------/ +/ igraph_community_leading_eigenvector / +/-------------------------------------------*/ +SEXP R_igraph_community_leading_eigenvector(SEXP graph, SEXP weights, SEXP membership, SEXP steps, SEXP options, SEXP start) { + /* Declarations */ + igraph_t c_graph; + igraph_vector_t c_weights; + igraph_matrix_int_t c_merges; + igraph_vector_int_t c_membership; + igraph_integer_t c_steps; + igraph_arpack_options_t c_options; + igraph_real_t c_modularity; + igraph_bool_t c_start; + igraph_vector_t c_eigenvalues; + igraph_vector_list_t c_eigenvectors; + igraph_vector_t c_history; + + + SEXP merges; + SEXP modularity; + SEXP eigenvalues; + SEXP eigenvectors; + SEXP history; + + SEXP r_result, r_names; + /* Convert input */ + Rz_SEXP_to_igraph(graph, &c_graph); + if (!Rf_isNull(weights)) { + Rz_SEXP_to_vector(weights, &c_weights); + } + IGRAPH_R_CHECK(igraph_matrix_int_init(&c_merges, 0, 0)); + IGRAPH_FINALLY(igraph_matrix_int_destroy, &c_merges); + if (!Rf_isNull(membership)) { + IGRAPH_R_CHECK(Rz_SEXP_to_vector_int_copy(membership, &c_membership)); + IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); + } else { + IGRAPH_R_CHECK(igraph_vector_int_init(&c_membership, 0)); + IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); + } + IGRAPH_R_CHECK_INT(steps); + c_steps = (igraph_integer_t) REAL(steps)[0]; + Rz_SEXP_to_igraph_arpack_options(options, &c_options); + IGRAPH_R_CHECK_BOOL(start); + c_start = LOGICAL(start)[0]; + IGRAPH_R_CHECK(igraph_vector_init(&c_eigenvalues, 0)); + IGRAPH_FINALLY(igraph_vector_destroy, &c_eigenvalues); + IGRAPH_R_CHECK(igraph_vector_list_init(&c_eigenvectors, 0)); + IGRAPH_FINALLY(igraph_vector_list_destroy, &c_eigenvectors); + IGRAPH_R_CHECK(igraph_vector_init(&c_history, 0)); + IGRAPH_FINALLY(igraph_vector_destroy, &c_history); + /* Call igraph */ + IGRAPH_R_CHECK(igraph_community_leading_eigenvector(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_merges, &c_membership, c_steps, &c_options, &c_modularity, c_start, &c_eigenvalues, &c_eigenvectors, &c_history, 0, 0)); + + /* Convert output */ + PROTECT(r_result=NEW_LIST(7)); + PROTECT(r_names=NEW_CHARACTER(7)); + PROTECT(merges=Ry_igraph_matrix_int_to_SEXP(&c_merges)); + igraph_matrix_int_destroy(&c_merges); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(membership=Ry_igraph_vector_int_to_SEXP(&c_membership)); + igraph_vector_int_destroy(&c_membership); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(options=Ry_igraph_arpack_options_to_SEXP(&c_options)); + PROTECT(modularity=NEW_NUMERIC(1)); + REAL(modularity)[0]=c_modularity; + PROTECT(eigenvalues=Ry_igraph_vector_to_SEXP(&c_eigenvalues)); + igraph_vector_destroy(&c_eigenvalues); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(eigenvectors=Rx_igraph_vectorlist_to_SEXP(&c_eigenvectors)); + igraph_vector_list_destroy(&c_eigenvectors); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(history=Ry_igraph_vector_to_SEXP(&c_history)); + igraph_vector_destroy(&c_history); + IGRAPH_FINALLY_CLEAN(1); + SET_VECTOR_ELT(r_result, 0, merges); + SET_VECTOR_ELT(r_result, 1, membership); + SET_VECTOR_ELT(r_result, 2, options); + SET_VECTOR_ELT(r_result, 3, modularity); + SET_VECTOR_ELT(r_result, 4, eigenvalues); + SET_VECTOR_ELT(r_result, 5, eigenvectors); + SET_VECTOR_ELT(r_result, 6, history); + SET_STRING_ELT(r_names, 0, Rf_mkChar("merges")); + SET_STRING_ELT(r_names, 1, Rf_mkChar("membership")); + SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); + SET_STRING_ELT(r_names, 3, Rf_mkChar("modularity")); + SET_STRING_ELT(r_names, 4, Rf_mkChar("eigenvalues")); + SET_STRING_ELT(r_names, 5, Rf_mkChar("eigenvectors")); + SET_STRING_ELT(r_names, 6, Rf_mkChar("history")); + SET_NAMES(r_result, r_names); + UNPROTECT(8); + + UNPROTECT(1); + return(r_result); +} + /*-------------------------------------------/ / igraph_community_fluid_communities / /-------------------------------------------*/ diff --git a/tools/stimulus/functions-R.yaml b/tools/stimulus/functions-R.yaml index 759888723e6..cc13f36acc0 100644 --- a/tools/stimulus/functions-R.yaml +++ b/tools/stimulus/functions-R.yaml @@ -657,8 +657,18 @@ igraph_le_community_to_membership: igraph_reindex_membership: igraph_community_leading_eigenvector: - # Needs custom handling - has callback parameter (LEVCFUNC) - IGNORE: RR, RC, RInit + PARAMS: |- + GRAPH graph, OPTIONAL EDGEWEIGHTS weights, + OPTIONAL OUT MATRIX_INT merges, OPTIONAL INOUT VECTOR_INT membership, + INTEGER steps=-1, + INOUT ARPACKOPT options=ARPACK_DEFAULTS, + OPTIONAL OUT REAL modularity, BOOLEAN start=False, + OPTIONAL OUT VECTOR eigenvalues, + OPTIONAL OUT VECTOR_LIST eigenvectors, + OPTIONAL OUT VECTOR history, + OPTIONAL NULL callback, + OPTIONAL NULL callback_extra + DEPS: weights ON graph, membership ON graph R: CLASS: igraph.eigenc From 70853bfb413744aed532f885d3aa319b0abc97bc Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 25 Jan 2026 18:55:18 +0000 Subject: [PATCH 03/12] fix: add missing function declaration and type definition typo Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- src/rinterface.c | 2 +- src/rinterface.h | 1 + tests/testthat/test-aaa-auto.R | 70 ++++++++++++++++++++++++++++++++++ tools/stimulus/types-RC.yaml | 2 +- 4 files changed, 73 insertions(+), 2 deletions(-) diff --git a/src/rinterface.c b/src/rinterface.c index f2d0056b422..c276088ad3d 100644 --- a/src/rinterface.c +++ b/src/rinterface.c @@ -12391,7 +12391,7 @@ SEXP R_igraph_community_leading_eigenvector(SEXP graph, SEXP weights, SEXP membe PROTECT(eigenvalues=Ry_igraph_vector_to_SEXP(&c_eigenvalues)); igraph_vector_destroy(&c_eigenvalues); IGRAPH_FINALLY_CLEAN(1); - PROTECT(eigenvectors=Rx_igraph_vectorlist_to_SEXP(&c_eigenvectors)); + PROTECT(eigenvectors=Rx_igraph_vector_list_to_SEXP(&c_eigenvectors)); igraph_vector_list_destroy(&c_eigenvectors); IGRAPH_FINALLY_CLEAN(1); PROTECT(history=Ry_igraph_vector_to_SEXP(&c_history)); diff --git a/src/rinterface.h b/src/rinterface.h index 6985a245e23..6941e4cad4e 100644 --- a/src/rinterface.h +++ b/src/rinterface.h @@ -65,6 +65,7 @@ SEXP Rx_igraph_0ormatrix_int_to_SEXP(const igraph_matrix_int_t *m); SEXP Ry_igraph_0ormatrix_complex_to_SEXP(const igraph_matrix_complex_t *m); SEXP Rx_igraph_strvector_to_SEXP(const igraph_strvector_t *m); SEXP Ry_igraph_to_SEXP(const igraph_t *graph); +SEXP Rx_igraph_vector_list_to_SEXP(const igraph_vector_list_t *list); SEXP Ry_igraph_vector_int_list_to_SEXP(const igraph_vector_int_list_t *list); SEXP Ry_igraph_vector_int_list_to_SEXPp1(const igraph_vector_int_list_t *list); SEXP Rx_igraph_0orvector_int_list_to_SEXP(const igraph_vector_int_list_t *list); diff --git a/tests/testthat/test-aaa-auto.R b/tests/testthat/test-aaa-auto.R index c82ba3257c8..b804ffbf815 100644 --- a/tests/testthat/test-aaa-auto.R +++ b/tests/testthat/test-aaa-auto.R @@ -10867,6 +10867,76 @@ test_that("community_edge_betweenness_impl basic", { expect_snapshot(community_edge_betweenness_impl(graph = g, directed = FALSE)) }) +test_that("community_leading_eigenvector_impl basic", { + withr::local_seed(20250909) + local_igraph_options(print.id = FALSE) + + # Test with a simple graph + g <- make_graph("Zachary") + result <- community_leading_eigenvector_impl(graph = g) + + expect_snapshot({ + cat("Result class:\n") + print(class(result)) + cat("\nMembership length:\n") + print(length(result$membership)) + cat("\nModularity:\n") + print(result$modularity) + cat("\nMerges dimensions:\n") + print(dim(result$merges)) + }) + + # Structured tests + expect_s3_class(result, "igraph.eigenc") + expect_true(is.list(result)) + expect_true("membership" %in% names(result)) + expect_true("modularity" %in% names(result)) + expect_true("merges" %in% names(result)) + expect_equal(length(result$membership), vcount(g)) + expect_true(is.numeric(result$modularity)) +}) + +test_that("community_leading_eigenvector_impl with start", { + withr::local_seed(20250909) + local_igraph_options(print.id = FALSE) + + g <- make_graph("Zachary") + # Create initial membership (0-based for the impl function) + initial_membership <- rep(0:1, length.out = vcount(g)) + + result <- community_leading_eigenvector_impl( + graph = g, + membership = initial_membership, + start = TRUE + ) + + expect_snapshot({ + cat("Result with start membership:\n") + cat("Membership length:\n") + print(length(result$membership)) + cat("\nModularity:\n") + print(result$modularity) + }) + + expect_s3_class(result, "igraph.eigenc") + expect_equal(length(result$membership), vcount(g)) +}) + +test_that("community_leading_eigenvector_impl errors", { + withr::local_seed(20250909) + local_igraph_options(print.id = FALSE) + + g <- make_graph("Zachary") + + # Test with invalid steps + expect_snapshot_igraph_error( + community_leading_eigenvector_impl( + graph = g, + steps = -100 + ) + ) +}) + # Connectivity test_that("edge_connectivity_impl basic", { diff --git a/tools/stimulus/types-RC.yaml b/tools/stimulus/types-RC.yaml index b453f774161..67f597530c8 100644 --- a/tools/stimulus/types-RC.yaml +++ b/tools/stimulus/types-RC.yaml @@ -271,7 +271,7 @@ VECTOR_LIST: IGRAPH_FINALLY(igraph_vector_list_destroy, &%C%); OUTCONV: OUT: |- - PROTECT(%I%=Rx_igraph_vectorlist_to_SEXP(&%C%)); + PROTECT(%I%=Rx_igraph_vector_list_to_SEXP(&%C%)); igraph_vector_list_destroy(&%C%); IGRAPH_FINALLY_CLEAN(1); From c7eda6f1a768e308037e598849153dfd0e1a5b17 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 25 Jan 2026 18:57:32 +0000 Subject: [PATCH 04/12] test: update tests for autogenerated function Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- tests/testthat/test-community.R | 67 +++++++++------------------------ 1 file changed, 17 insertions(+), 50 deletions(-) diff --git a/tests/testthat/test-community.R b/tests/testthat/test-community.R index 1d5880863d6..ed8f5f19ef8 100644 --- a/tests/testthat/test-community.R +++ b/tests/testthat/test-community.R @@ -209,31 +209,8 @@ test_that("label.propagation.community works", { test_that("cluster_leading_eigen works", { withr::local_seed(20230115) - check_eigen_value <- function( - membership, - community, - value, - vector, - multiplier, - extra - ) { - M <- sapply(1:length(vector), function(x) { - v <- rep(0, length(vector)) - v[x] <- 1 - multiplier(v) - }) - ev <- eigen(M) - ret <- 0 - expect_equal(ev$values[1], value) - if (sign(ev$vectors[1, 1]) != sign(vector[1])) { - ev$vectors <- -ev$vectors - } - expect_equal(ev$vectors[, 1], vector) - 0 - } - karate <- make_graph("Zachary") - karate_lc <- cluster_leading_eigen(karate, callback = check_eigen_value) + karate_lc <- cluster_leading_eigen(karate) expect_equal(karate_lc$modularity, modularity(karate, karate_lc$membership)) expect_equal( @@ -257,34 +234,24 @@ test_that("cluster_leading_eigen works", { class = "table" ) ) +}) - ## Check that the modularity matrix is correct - - mod_mat_caller <- function( - membership, - community, - value, - vector, - multiplier, - extra - ) { - M <- sapply(1:length(vector), function(x) { - v <- rep(0, length(vector)) - v[x] <- 1 - multiplier(v) - }) - myc <- membership == community - B <- A[myc, myc] - (deg[myc] %*% t(deg[myc])) / 2 / ec - BG <- B - diag(rowSums(B)) - - expect_equal(M, BG) - 0 - } +test_that("cluster_leading_eigen callback deprecated", { + withr::local_seed(20230115) - A <- as_adjacency_matrix(karate, sparse = FALSE) - ec <- ecount(karate) - deg <- degree(karate) - karate_lc2 <- cluster_leading_eigen(karate, callback = mod_mat_caller) + karate <- make_graph("Zachary") + + # Test that callback parameter is deprecated + expect_error( + cluster_leading_eigen(karate, callback = function(...) 0), + class = "lifecycle_error_deprecated" + ) + + # Test that extra parameter is deprecated + expect_error( + cluster_leading_eigen(karate, extra = "test"), + class = "lifecycle_error_deprecated" + ) }) test_that("cluster_leading_eigen is deterministic", { ## Stress-test. We skip this on R 3.4 and 3.5 because it seems like From 0da389b21bde552428b9ae7946311068bc625f10 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 25 Jan 2026 20:44:22 +0000 Subject: [PATCH 05/12] feat: implement full closure-based callback for igraph_community_leading_eigenvector Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- R/aaa-auto.R | 224 +++--- R/community.R | 30 +- src/cpp11.cpp | 1204 +++++++++++++++---------------- src/rcallback.c | 119 +++ src/rinterface.c | 192 ++--- src/rinterface.h | 29 + tests/testthat/test-community.R | 17 +- tools/stimulus/functions-R.yaml | 10 +- tools/stimulus/types-RC.yaml | 15 + tools/stimulus/types-RR.yaml | 32 +- 10 files changed, 1044 insertions(+), 828 deletions(-) diff --git a/R/aaa-auto.R b/R/aaa-auto.R index 97a0446b80e..73809834b08 100644 --- a/R/aaa-auto.R +++ b/R/aaa-auto.R @@ -9224,47 +9224,6 @@ reindex_membership_impl <- function( res } -community_leading_eigenvector_impl <- function( - graph, - weights = NULL, - membership = NULL, - steps = -1, - options = arpack_defaults(), - start = 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 - } - if (!is.null(membership)) { - membership <- as.numeric(membership) - } - steps <- as.numeric(steps) - options <- modify_list(arpack_defaults(), options) - start <- as.logical(start) - - on.exit(.Call(R_igraph_finalizer)) - # Function call - res <- .Call( - R_igraph_community_leading_eigenvector, - graph, - weights, - membership, - steps, - options, - start - ) - - class(res) <- "igraph.eigenc" - res -} - community_fluid_communities_impl <- function( graph, no_of_communities @@ -14012,14 +13971,18 @@ cliques_callback_closure_impl <- function( ensure_igraph(graph) min_size <- as.numeric(min_size) max_size <- as.numeric(max_size) - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - callback(...), - error = function(e) e - ) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + callback(...), + error = function(e) e + ) + } + } else { + callback_wrapped <- NULL } @@ -14046,14 +14009,18 @@ maximal_cliques_callback_closure_impl <- function( ensure_igraph(graph) min_size <- as.numeric(min_size) max_size <- as.numeric(max_size) - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - callback(...), - error = function(e) e - ) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + callback(...), + error = function(e) e + ) + } + } else { + callback_wrapped <- NULL } @@ -14070,6 +14037,69 @@ maximal_cliques_callback_closure_impl <- function( 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( + callback(...), + error = 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, @@ -14122,14 +14152,18 @@ get_isomorphisms_vf2_callback_closure_impl <- function( if (!is.null(edge_color2)) { edge_color2 <- as.numeric(edge_color2) - 1 } - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - callback(...), - error = function(e) e - ) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + callback(...), + error = function(e) e + ) + } + } else { + callback_wrapped <- NULL } @@ -14201,14 +14235,18 @@ get_subisomorphisms_vf2_callback_closure_impl <- function( if (!is.null(edge_color2)) { edge_color2 <- as.numeric(edge_color2) - 1 } - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - callback(...), - error = function(e) e - ) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + callback(...), + error = function(e) e + ) + } + } else { + callback_wrapped <- NULL } @@ -14246,14 +14284,18 @@ simple_cycles_callback_closure_impl <- function( ) min_cycle_length <- as.numeric(min_cycle_length) max_cycle_length <- as.numeric(max_cycle_length) - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - callback(...), - error = function(e) e - ) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + callback(...), + error = function(e) e + ) + } + } else { + callback_wrapped <- NULL } @@ -14283,14 +14325,18 @@ motifs_randesu_callback_closure_impl <- function( if (!is.null(cut_prob)) { cut_prob <- as.numeric(cut_prob) } - if (!is.function(callback)) { - cli::cli_abort("{.arg callback} must be a function") - } - callback_wrapped <- function(...) { - tryCatch( - callback(...), - error = function(e) e - ) + if (!is.null(callback)) { + if (!is.function(callback)) { + cli::cli_abort("{.arg callback} must be a function") + } + callback_wrapped <- function(...) { + tryCatch( + callback(...), + error = function(e) e + ) + } + } else { + callback_wrapped <- NULL } diff --git a/R/community.R b/R/community.R index 1899b4014f7..80ad656025b 100644 --- a/R/community.R +++ b/R/community.R @@ -2100,7 +2100,7 @@ cluster_fast_greedy <- function( igraph.i.levc.arp <- function(externalP, externalE) { f <- function(v) { v <- as.numeric(v) - .Call(Rx_igraph_i_levc_arp, externalP, externalE, v) + .Call(R_igraph_levc_arpack_multiplier, externalP, externalE, v) } f } @@ -2239,22 +2239,6 @@ cluster_leading_eigen <- function( options <- options() } - # Callback is no longer supported - if (!is.null(callback)) { - lifecycle::deprecate_stop( - "2.1.0", - "cluster_leading_eigen(callback = )", - details = "The callback functionality has been removed." - ) - } - if (!is.null(extra)) { - lifecycle::deprecate_stop( - "2.1.0", - "cluster_leading_eigen(extra = )", - details = "The extra functionality has been removed." - ) - } - # Argument checks ensure_igraph(graph) @@ -2267,7 +2251,7 @@ cluster_leading_eigen <- function( } else { weights <- NULL } - + # Convert start membership to 0-based indexing and determine start flag start_flag <- !is.null(start) if (start_flag) { @@ -2277,14 +2261,18 @@ cluster_leading_eigen <- function( options <- modify_list(arpack_defaults(), options) on.exit(.Call(R_igraph_finalizer)) - # Function call using autogenerated implementation - res <- community_leading_eigenvector_impl( + # Function call using autogenerated implementation with callback support + res <- community_leading_eigenvector_callback_closure_impl( graph = graph, weights = weights, membership = start, steps = steps, options = options, - start = start_flag + start = start_flag, + callback = callback, + extra = extra, + env = env, + env_arp = environment(igraph.i.levc.arp) ) if (igraph_opt("add.vertex.names") && is_named(graph)) { diff --git a/src/cpp11.cpp b/src/cpp11.cpp index a36f3655219..66043990bdf 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -94,7 +94,7 @@ extern SEXP R_igraph_community_fastgreedy(SEXP, SEXP); extern SEXP R_igraph_community_fluid_communities(SEXP, SEXP); extern SEXP R_igraph_community_infomap(SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_label_propagation(SEXP, SEXP, SEXP, SEXP, SEXP); -extern SEXP R_igraph_community_leading_eigenvector(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +extern SEXP R_igraph_community_leading_eigenvector_callback_closure(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_leiden(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_community_multilevel(SEXP, SEXP, SEXP); extern SEXP R_igraph_community_optimal_modularity(SEXP, SEXP); @@ -333,6 +333,7 @@ extern SEXP R_igraph_layout_umap_3d(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP R_igraph_layout_umap_compute_weights(SEXP, SEXP, SEXP); extern SEXP R_igraph_lcf_vector(SEXP, SEXP, SEXP); extern SEXP R_igraph_le_community_to_membership(SEXP, SEXP, SEXP); +extern SEXP R_igraph_levc_arpack_multiplier(SEXP, SEXP, SEXP); extern SEXP R_igraph_linegraph(SEXP); extern SEXP R_igraph_list_triangles(SEXP); extern SEXP R_igraph_local_efficiency(SEXP, SEXP, SEXP, SEXP, SEXP); @@ -555,7 +556,6 @@ extern SEXP Rx_igraph_get_shortest_paths(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEX extern SEXP Rx_igraph_girth(SEXP, SEXP); extern SEXP Rx_igraph_graph_version(SEXP); extern SEXP Rx_igraph_grg_game(SEXP, SEXP, SEXP, SEXP); -extern SEXP Rx_igraph_i_levc_arp(SEXP, SEXP, SEXP); extern SEXP Rx_igraph_identical_graphs(SEXP, SEXP, SEXP); extern SEXP Rx_igraph_incident_edges(SEXP, SEXP, SEXP); extern SEXP Rx_igraph_independent_vertex_sets(SEXP, SEXP, SEXP); @@ -622,606 +622,606 @@ extern SEXP Rx_igraph_write_graph_ncol(SEXP, SEXP, SEXP, SEXP); extern SEXP UUID_gen(SEXP); static const R_CallMethodDef CallEntries[] = { - {"R_igraph_add_edge", (DL_FUNC) &R_igraph_add_edge, 3}, - {"R_igraph_add_edges", (DL_FUNC) &R_igraph_add_edges, 2}, - {"R_igraph_add_vertices", (DL_FUNC) &R_igraph_add_vertices, 2}, - {"R_igraph_adhesion", (DL_FUNC) &R_igraph_adhesion, 2}, - {"R_igraph_adjacency", (DL_FUNC) &R_igraph_adjacency, 3}, - {"R_igraph_adjacency_spectral_embedding", (DL_FUNC) &R_igraph_adjacency_spectral_embedding, 7}, - {"R_igraph_adjlist", (DL_FUNC) &R_igraph_adjlist, 3}, - {"R_igraph_all_minimal_st_separators", (DL_FUNC) &R_igraph_all_minimal_st_separators, 1}, - {"R_igraph_all_st_cuts", (DL_FUNC) &R_igraph_all_st_cuts, 3}, - {"R_igraph_all_st_mincuts", (DL_FUNC) &R_igraph_all_st_mincuts, 4}, - {"R_igraph_almost_equals", (DL_FUNC) &R_igraph_almost_equals, 3}, - {"R_igraph_are_adjacent", (DL_FUNC) &R_igraph_are_adjacent, 3}, - {"R_igraph_are_connected", (DL_FUNC) &R_igraph_are_connected, 3}, - {"R_igraph_articulation_points", (DL_FUNC) &R_igraph_articulation_points, 1}, - {"R_igraph_assortativity", (DL_FUNC) &R_igraph_assortativity, 5}, - {"R_igraph_assortativity_degree", (DL_FUNC) &R_igraph_assortativity_degree, 2}, - {"R_igraph_assortativity_nominal", (DL_FUNC) &R_igraph_assortativity_nominal, 4}, - {"R_igraph_asymmetric_preference_game", (DL_FUNC) &R_igraph_asymmetric_preference_game, 6}, - {"R_igraph_atlas", (DL_FUNC) &R_igraph_atlas, 1}, - {"R_igraph_authority_score", (DL_FUNC) &R_igraph_authority_score, 4}, - {"R_igraph_automorphism_group", (DL_FUNC) &R_igraph_automorphism_group, 3}, - {"R_igraph_average_local_efficiency", (DL_FUNC) &R_igraph_average_local_efficiency, 4}, - {"R_igraph_average_path_length", (DL_FUNC) &R_igraph_average_path_length, 3}, - {"R_igraph_average_path_length_dijkstra", (DL_FUNC) &R_igraph_average_path_length_dijkstra, 4}, - {"R_igraph_avg_nearest_neighbor_degree", (DL_FUNC) &R_igraph_avg_nearest_neighbor_degree, 5}, - {"R_igraph_barabasi_aging_game", (DL_FUNC) &R_igraph_barabasi_aging_game, 12}, - {"R_igraph_barabasi_game", (DL_FUNC) &R_igraph_barabasi_game, 9}, - {"R_igraph_betweenness", (DL_FUNC) &R_igraph_betweenness, 4}, - {"R_igraph_betweenness_cutoff", (DL_FUNC) &R_igraph_betweenness_cutoff, 5}, - {"R_igraph_betweenness_subset", (DL_FUNC) &R_igraph_betweenness_subset, 6}, - {"R_igraph_bfs_simple", (DL_FUNC) &R_igraph_bfs_simple, 3}, - {"R_igraph_biadjacency", (DL_FUNC) &R_igraph_biadjacency, 4}, - {"R_igraph_bibcoupling", (DL_FUNC) &R_igraph_bibcoupling, 2}, - {"R_igraph_biconnected_components", (DL_FUNC) &R_igraph_biconnected_components, 1}, - {"R_igraph_bipartite_game", (DL_FUNC) &R_igraph_bipartite_game, 7}, - {"R_igraph_bipartite_game_gnm", (DL_FUNC) &R_igraph_bipartite_game_gnm, 5}, - {"R_igraph_bipartite_game_gnp", (DL_FUNC) &R_igraph_bipartite_game_gnp, 5}, - {"R_igraph_bipartite_projection", (DL_FUNC) &R_igraph_bipartite_projection, 3}, - {"R_igraph_bipartite_projection_size", (DL_FUNC) &R_igraph_bipartite_projection_size, 2}, - {"R_igraph_bond_percolation", (DL_FUNC) &R_igraph_bond_percolation, 2}, - {"R_igraph_bridges", (DL_FUNC) &R_igraph_bridges, 1}, - {"R_igraph_callaway_traits_game", (DL_FUNC) &R_igraph_callaway_traits_game, 6}, - {"R_igraph_canonical_permutation", (DL_FUNC) &R_igraph_canonical_permutation, 3}, - {"R_igraph_centralization", (DL_FUNC) &R_igraph_centralization, 3}, - {"R_igraph_centralization_betweenness", (DL_FUNC) &R_igraph_centralization_betweenness, 3}, - {"R_igraph_centralization_betweenness_tmax", (DL_FUNC) &R_igraph_centralization_betweenness_tmax, 3}, - {"R_igraph_centralization_closeness", (DL_FUNC) &R_igraph_centralization_closeness, 3}, - {"R_igraph_centralization_closeness_tmax", (DL_FUNC) &R_igraph_centralization_closeness_tmax, 3}, - {"R_igraph_centralization_degree", (DL_FUNC) &R_igraph_centralization_degree, 4}, - {"R_igraph_centralization_degree_tmax", (DL_FUNC) &R_igraph_centralization_degree_tmax, 4}, - {"R_igraph_centralization_eigenvector_centrality", (DL_FUNC) &R_igraph_centralization_eigenvector_centrality, 5}, - {"R_igraph_centralization_eigenvector_centrality_tmax", (DL_FUNC) &R_igraph_centralization_eigenvector_centrality_tmax, 4}, - {"R_igraph_chung_lu_game", (DL_FUNC) &R_igraph_chung_lu_game, 4}, - {"R_igraph_circulant", (DL_FUNC) &R_igraph_circulant, 3}, - {"R_igraph_cited_type_game", (DL_FUNC) &R_igraph_cited_type_game, 5}, - {"R_igraph_citing_cited_type_game", (DL_FUNC) &R_igraph_citing_cited_type_game, 5}, - {"R_igraph_clique_number", (DL_FUNC) &R_igraph_clique_number, 1}, - {"R_igraph_clique_size_hist", (DL_FUNC) &R_igraph_clique_size_hist, 3}, - {"R_igraph_cliques", (DL_FUNC) &R_igraph_cliques, 3}, - {"R_igraph_cliques_callback_closure", (DL_FUNC) &R_igraph_cliques_callback_closure, 4}, - {"R_igraph_closeness", (DL_FUNC) &R_igraph_closeness, 5}, - {"R_igraph_closeness_cutoff", (DL_FUNC) &R_igraph_closeness_cutoff, 6}, - {"R_igraph_cmp_epsilon", (DL_FUNC) &R_igraph_cmp_epsilon, 3}, - {"R_igraph_cocitation", (DL_FUNC) &R_igraph_cocitation, 2}, - {"R_igraph_cohesion", (DL_FUNC) &R_igraph_cohesion, 2}, - {"R_igraph_cohesive_blocks", (DL_FUNC) &R_igraph_cohesive_blocks, 1}, - {"R_igraph_community_eb_get_merges", (DL_FUNC) &R_igraph_community_eb_get_merges, 4}, - {"R_igraph_community_edge_betweenness", (DL_FUNC) &R_igraph_community_edge_betweenness, 3}, - {"R_igraph_community_fastgreedy", (DL_FUNC) &R_igraph_community_fastgreedy, 2}, - {"R_igraph_community_fluid_communities", (DL_FUNC) &R_igraph_community_fluid_communities, 2}, - {"R_igraph_community_infomap", (DL_FUNC) &R_igraph_community_infomap, 4}, - {"R_igraph_community_label_propagation", (DL_FUNC) &R_igraph_community_label_propagation, 5}, - {"R_igraph_community_leading_eigenvector", (DL_FUNC) &R_igraph_community_leading_eigenvector, 6}, - {"R_igraph_community_leiden", (DL_FUNC) &R_igraph_community_leiden, 8}, - {"R_igraph_community_multilevel", (DL_FUNC) &R_igraph_community_multilevel, 3}, - {"R_igraph_community_optimal_modularity", (DL_FUNC) &R_igraph_community_optimal_modularity, 2}, - {"R_igraph_community_spinglass", (DL_FUNC) &R_igraph_community_spinglass, 11}, - {"R_igraph_community_spinglass_single", (DL_FUNC) &R_igraph_community_spinglass_single, 6}, - {"R_igraph_community_to_membership", (DL_FUNC) &R_igraph_community_to_membership, 3}, - {"R_igraph_community_walktrap", (DL_FUNC) &R_igraph_community_walktrap, 3}, - {"R_igraph_compare_communities", (DL_FUNC) &R_igraph_compare_communities, 3}, - {"R_igraph_complementer", (DL_FUNC) &R_igraph_complementer, 2}, - {"R_igraph_compose", (DL_FUNC) &R_igraph_compose, 2}, - {"R_igraph_connect_neighborhood", (DL_FUNC) &R_igraph_connect_neighborhood, 3}, - {"R_igraph_connected_components", (DL_FUNC) &R_igraph_connected_components, 2}, - {"R_igraph_constraint", (DL_FUNC) &R_igraph_constraint, 3}, - {"R_igraph_contract_vertices", (DL_FUNC) &R_igraph_contract_vertices, 3}, - {"R_igraph_convergence_degree", (DL_FUNC) &R_igraph_convergence_degree, 1}, - {"R_igraph_convex_hull_2d", (DL_FUNC) &R_igraph_convex_hull_2d, 1}, - {"R_igraph_copy", (DL_FUNC) &R_igraph_copy, 1}, - {"R_igraph_coreness", (DL_FUNC) &R_igraph_coreness, 2}, - {"R_igraph_correlated_game", (DL_FUNC) &R_igraph_correlated_game, 4}, - {"R_igraph_correlated_pair_game", (DL_FUNC) &R_igraph_correlated_pair_game, 5}, - {"R_igraph_count_adjacent_triangles", (DL_FUNC) &R_igraph_count_adjacent_triangles, 2}, - {"R_igraph_count_automorphisms", (DL_FUNC) &R_igraph_count_automorphisms, 3}, - {"R_igraph_count_isomorphisms_vf2", (DL_FUNC) &R_igraph_count_isomorphisms_vf2, 6}, - {"R_igraph_count_loops", (DL_FUNC) &R_igraph_count_loops, 1}, - {"R_igraph_count_multiple", (DL_FUNC) &R_igraph_count_multiple, 2}, - {"R_igraph_count_reachable", (DL_FUNC) &R_igraph_count_reachable, 2}, - {"R_igraph_count_subisomorphisms_vf2", (DL_FUNC) &R_igraph_count_subisomorphisms_vf2, 6}, - {"R_igraph_count_triangles", (DL_FUNC) &R_igraph_count_triangles, 1}, - {"R_igraph_create", (DL_FUNC) &R_igraph_create, 3}, - {"R_igraph_create_bipartite", (DL_FUNC) &R_igraph_create_bipartite, 3}, - {"R_igraph_cycle_graph", (DL_FUNC) &R_igraph_cycle_graph, 3}, - {"R_igraph_de_bruijn", (DL_FUNC) &R_igraph_de_bruijn, 2}, - {"R_igraph_decompose", (DL_FUNC) &R_igraph_decompose, 4}, - {"R_igraph_degree", (DL_FUNC) &R_igraph_degree, 4}, - {"R_igraph_degree_correlation_vector", (DL_FUNC) &R_igraph_degree_correlation_vector, 5}, - {"R_igraph_degree_sequence_game", (DL_FUNC) &R_igraph_degree_sequence_game, 3}, - {"R_igraph_delete_edges", (DL_FUNC) &R_igraph_delete_edges, 2}, - {"R_igraph_delete_vertices", (DL_FUNC) &R_igraph_delete_vertices, 2}, - {"R_igraph_delete_vertices_idx", (DL_FUNC) &R_igraph_delete_vertices_idx, 2}, - {"R_igraph_density", (DL_FUNC) &R_igraph_density, 2}, - {"R_igraph_deterministic_optimal_imitation", (DL_FUNC) &R_igraph_deterministic_optimal_imitation, 6}, - {"R_igraph_diameter", (DL_FUNC) &R_igraph_diameter, 3}, - {"R_igraph_diameter_dijkstra", (DL_FUNC) &R_igraph_diameter_dijkstra, 4}, - {"R_igraph_difference", (DL_FUNC) &R_igraph_difference, 2}, - {"R_igraph_dim_select", (DL_FUNC) &R_igraph_dim_select, 1}, - {"R_igraph_disjoint_union", (DL_FUNC) &R_igraph_disjoint_union, 2}, - {"R_igraph_disjoint_union_many", (DL_FUNC) &R_igraph_disjoint_union_many, 1}, - {"R_igraph_distances", (DL_FUNC) &R_igraph_distances, 4}, - {"R_igraph_distances_bellman_ford", (DL_FUNC) &R_igraph_distances_bellman_ford, 5}, - {"R_igraph_distances_cutoff", (DL_FUNC) &R_igraph_distances_cutoff, 5}, - {"R_igraph_distances_dijkstra", (DL_FUNC) &R_igraph_distances_dijkstra, 5}, - {"R_igraph_distances_dijkstra_cutoff", (DL_FUNC) &R_igraph_distances_dijkstra_cutoff, 6}, - {"R_igraph_distances_floyd_warshall", (DL_FUNC) &R_igraph_distances_floyd_warshall, 6}, - {"R_igraph_distances_johnson", (DL_FUNC) &R_igraph_distances_johnson, 4}, - {"R_igraph_diversity", (DL_FUNC) &R_igraph_diversity, 3}, - {"R_igraph_dominator_tree", (DL_FUNC) &R_igraph_dominator_tree, 3}, - {"R_igraph_dot_product_game", (DL_FUNC) &R_igraph_dot_product_game, 2}, - {"R_igraph_dyad_census", (DL_FUNC) &R_igraph_dyad_census, 1}, - {"R_igraph_ecc", (DL_FUNC) &R_igraph_ecc, 5}, - {"R_igraph_eccentricity", (DL_FUNC) &R_igraph_eccentricity, 3}, - {"R_igraph_eccentricity_dijkstra", (DL_FUNC) &R_igraph_eccentricity_dijkstra, 4}, - {"R_igraph_ecount", (DL_FUNC) &R_igraph_ecount, 1}, - {"R_igraph_edge", (DL_FUNC) &R_igraph_edge, 2}, - {"R_igraph_edge_betweenness", (DL_FUNC) &R_igraph_edge_betweenness, 3}, - {"R_igraph_edge_betweenness_cutoff", (DL_FUNC) &R_igraph_edge_betweenness_cutoff, 4}, - {"R_igraph_edge_betweenness_subset", (DL_FUNC) &R_igraph_edge_betweenness_subset, 6}, - {"R_igraph_edge_connectivity", (DL_FUNC) &R_igraph_edge_connectivity, 2}, - {"R_igraph_edge_disjoint_paths", (DL_FUNC) &R_igraph_edge_disjoint_paths, 3}, - {"R_igraph_edgelist_percolation", (DL_FUNC) &R_igraph_edgelist_percolation, 1}, - {"R_igraph_edges", (DL_FUNC) &R_igraph_edges, 2}, - {"R_igraph_eigen_adjacency", (DL_FUNC) &R_igraph_eigen_adjacency, 4}, - {"R_igraph_eigenvector_centrality", (DL_FUNC) &R_igraph_eigenvector_centrality, 5}, - {"R_igraph_empty", (DL_FUNC) &R_igraph_empty, 2}, - {"R_igraph_empty_attrs", (DL_FUNC) &R_igraph_empty_attrs, 2}, - {"R_igraph_erdos_renyi_game_gnm", (DL_FUNC) &R_igraph_erdos_renyi_game_gnm, 4}, - {"R_igraph_erdos_renyi_game_gnp", (DL_FUNC) &R_igraph_erdos_renyi_game_gnp, 4}, - {"R_igraph_establishment_game", (DL_FUNC) &R_igraph_establishment_game, 6}, - {"R_igraph_eulerian_cycle", (DL_FUNC) &R_igraph_eulerian_cycle, 1}, - {"R_igraph_eulerian_path", (DL_FUNC) &R_igraph_eulerian_path, 1}, - {"R_igraph_even_tarjan_reduction", (DL_FUNC) &R_igraph_even_tarjan_reduction, 1}, - {"R_igraph_expand_path_to_pairs", (DL_FUNC) &R_igraph_expand_path_to_pairs, 1}, - {"R_igraph_extended_chordal_ring", (DL_FUNC) &R_igraph_extended_chordal_ring, 3}, - {"R_igraph_famous", (DL_FUNC) &R_igraph_famous, 1}, - {"R_igraph_feedback_arc_set", (DL_FUNC) &R_igraph_feedback_arc_set, 3}, - {"R_igraph_feedback_vertex_set", (DL_FUNC) &R_igraph_feedback_vertex_set, 3}, - {"R_igraph_finalizer", (DL_FUNC) &R_igraph_finalizer, 0}, - {"R_igraph_find_cycle", (DL_FUNC) &R_igraph_find_cycle, 2}, - {"R_igraph_forest_fire_game", (DL_FUNC) &R_igraph_forest_fire_game, 5}, - {"R_igraph_from_hrg_dendrogram", (DL_FUNC) &R_igraph_from_hrg_dendrogram, 1}, - {"R_igraph_from_prufer", (DL_FUNC) &R_igraph_from_prufer, 1}, - {"R_igraph_full", (DL_FUNC) &R_igraph_full, 3}, - {"R_igraph_full_bipartite", (DL_FUNC) &R_igraph_full_bipartite, 4}, - {"R_igraph_full_citation", (DL_FUNC) &R_igraph_full_citation, 2}, - {"R_igraph_full_multipartite", (DL_FUNC) &R_igraph_full_multipartite, 3}, - {"R_igraph_fundamental_cycles", (DL_FUNC) &R_igraph_fundamental_cycles, 4}, - {"R_igraph_generalized_petersen", (DL_FUNC) &R_igraph_generalized_petersen, 2}, - {"R_igraph_get_adjacency", (DL_FUNC) &R_igraph_get_adjacency, 4}, - {"R_igraph_get_adjacency_sparse", (DL_FUNC) &R_igraph_get_adjacency_sparse, 4}, - {"R_igraph_get_all_eids_between", (DL_FUNC) &R_igraph_get_all_eids_between, 4}, - {"R_igraph_get_all_shortest_paths", (DL_FUNC) &R_igraph_get_all_shortest_paths, 4}, - {"R_igraph_get_all_shortest_paths_dijkstra", (DL_FUNC) &R_igraph_get_all_shortest_paths_dijkstra, 5}, - {"R_igraph_get_all_simple_paths", (DL_FUNC) &R_igraph_get_all_simple_paths, 5}, - {"R_igraph_get_biadjacency", (DL_FUNC) &R_igraph_get_biadjacency, 2}, - {"R_igraph_get_edgelist", (DL_FUNC) &R_igraph_get_edgelist, 2}, - {"R_igraph_get_eids", (DL_FUNC) &R_igraph_get_eids, 4}, - {"R_igraph_get_isomorphisms_vf2", (DL_FUNC) &R_igraph_get_isomorphisms_vf2, 6}, - {"R_igraph_get_isomorphisms_vf2_callback_closure", (DL_FUNC) &R_igraph_get_isomorphisms_vf2_callback_closure, 7}, - {"R_igraph_get_k_shortest_paths", (DL_FUNC) &R_igraph_get_k_shortest_paths, 6}, - {"R_igraph_get_laplacian", (DL_FUNC) &R_igraph_get_laplacian, 4}, - {"R_igraph_get_laplacian_sparse", (DL_FUNC) &R_igraph_get_laplacian_sparse, 4}, - {"R_igraph_get_shortest_path", (DL_FUNC) &R_igraph_get_shortest_path, 4}, - {"R_igraph_get_shortest_path_astar", (DL_FUNC) &R_igraph_get_shortest_path_astar, 6}, - {"R_igraph_get_shortest_path_bellman_ford", (DL_FUNC) &R_igraph_get_shortest_path_bellman_ford, 5}, - {"R_igraph_get_shortest_path_dijkstra", (DL_FUNC) &R_igraph_get_shortest_path_dijkstra, 5}, - {"R_igraph_get_shortest_paths", (DL_FUNC) &R_igraph_get_shortest_paths, 4}, - {"R_igraph_get_shortest_paths_bellman_ford", (DL_FUNC) &R_igraph_get_shortest_paths_bellman_ford, 5}, - {"R_igraph_get_shortest_paths_dijkstra", (DL_FUNC) &R_igraph_get_shortest_paths_dijkstra, 5}, - {"R_igraph_get_stochastic", (DL_FUNC) &R_igraph_get_stochastic, 3}, - {"R_igraph_get_stochastic_sparse", (DL_FUNC) &R_igraph_get_stochastic_sparse, 3}, - {"R_igraph_get_subisomorphisms_vf2", (DL_FUNC) &R_igraph_get_subisomorphisms_vf2, 6}, - {"R_igraph_get_subisomorphisms_vf2_callback_closure", (DL_FUNC) &R_igraph_get_subisomorphisms_vf2_callback_closure, 7}, - {"R_igraph_get_widest_path", (DL_FUNC) &R_igraph_get_widest_path, 5}, - {"R_igraph_get_widest_paths", (DL_FUNC) &R_igraph_get_widest_paths, 5}, - {"R_igraph_girth", (DL_FUNC) &R_igraph_girth, 1}, - {"R_igraph_global_efficiency", (DL_FUNC) &R_igraph_global_efficiency, 3}, - {"R_igraph_gomory_hu_tree", (DL_FUNC) &R_igraph_gomory_hu_tree, 2}, - {"R_igraph_graph_center", (DL_FUNC) &R_igraph_graph_center, 2}, - {"R_igraph_graph_center_dijkstra", (DL_FUNC) &R_igraph_graph_center_dijkstra, 3}, - {"R_igraph_graph_count", (DL_FUNC) &R_igraph_graph_count, 2}, - {"R_igraph_graph_power", (DL_FUNC) &R_igraph_graph_power, 3}, - {"R_igraph_graphlets", (DL_FUNC) &R_igraph_graphlets, 3}, - {"R_igraph_graphlets_candidate_basis", (DL_FUNC) &R_igraph_graphlets_candidate_basis, 2}, - {"R_igraph_graphlets_project", (DL_FUNC) &R_igraph_graphlets_project, 6}, - {"R_igraph_grg_game", (DL_FUNC) &R_igraph_grg_game, 3}, - {"R_igraph_growing_random_game", (DL_FUNC) &R_igraph_growing_random_game, 4}, - {"R_igraph_harmonic_centrality", (DL_FUNC) &R_igraph_harmonic_centrality, 5}, - {"R_igraph_harmonic_centrality_cutoff", (DL_FUNC) &R_igraph_harmonic_centrality_cutoff, 6}, - {"R_igraph_has_attribute_table", (DL_FUNC) &R_igraph_has_attribute_table, 0}, - {"R_igraph_has_loop", (DL_FUNC) &R_igraph_has_loop, 1}, - {"R_igraph_has_multiple", (DL_FUNC) &R_igraph_has_multiple, 1}, - {"R_igraph_has_mutual", (DL_FUNC) &R_igraph_has_mutual, 2}, - {"R_igraph_hrg_consensus", (DL_FUNC) &R_igraph_hrg_consensus, 4}, - {"R_igraph_hrg_create", (DL_FUNC) &R_igraph_hrg_create, 2}, - {"R_igraph_hrg_fit", (DL_FUNC) &R_igraph_hrg_fit, 4}, - {"R_igraph_hrg_game", (DL_FUNC) &R_igraph_hrg_game, 1}, - {"R_igraph_hrg_predict", (DL_FUNC) &R_igraph_hrg_predict, 5}, - {"R_igraph_hrg_resize", (DL_FUNC) &R_igraph_hrg_resize, 2}, - {"R_igraph_hrg_sample", (DL_FUNC) &R_igraph_hrg_sample, 1}, - {"R_igraph_hrg_sample_many", (DL_FUNC) &R_igraph_hrg_sample_many, 2}, - {"R_igraph_hrg_size", (DL_FUNC) &R_igraph_hrg_size, 1}, - {"R_igraph_hsbm_game", (DL_FUNC) &R_igraph_hsbm_game, 5}, - {"R_igraph_hsbm_list_game", (DL_FUNC) &R_igraph_hsbm_list_game, 5}, - {"R_igraph_hub_and_authority_scores", (DL_FUNC) &R_igraph_hub_and_authority_scores, 4}, - {"R_igraph_hub_score", (DL_FUNC) &R_igraph_hub_score, 4}, - {"R_igraph_hypercube", (DL_FUNC) &R_igraph_hypercube, 2}, - {"R_igraph_incident", (DL_FUNC) &R_igraph_incident, 3}, - {"R_igraph_independence_number", (DL_FUNC) &R_igraph_independence_number, 1}, - {"R_igraph_independent_vertex_sets", (DL_FUNC) &R_igraph_independent_vertex_sets, 3}, - {"R_igraph_induced_subgraph", (DL_FUNC) &R_igraph_induced_subgraph, 3}, - {"R_igraph_induced_subgraph_map", (DL_FUNC) &R_igraph_induced_subgraph_map, 3}, - {"R_igraph_intersection", (DL_FUNC) &R_igraph_intersection, 2}, - {"R_igraph_intersection_many", (DL_FUNC) &R_igraph_intersection_many, 1}, - {"R_igraph_invalidate_cache", (DL_FUNC) &R_igraph_invalidate_cache, 1}, - {"R_igraph_is_acyclic", (DL_FUNC) &R_igraph_is_acyclic, 1}, - {"R_igraph_is_biconnected", (DL_FUNC) &R_igraph_is_biconnected, 1}, - {"R_igraph_is_bigraphical", (DL_FUNC) &R_igraph_is_bigraphical, 3}, - {"R_igraph_is_bipartite", (DL_FUNC) &R_igraph_is_bipartite, 1}, - {"R_igraph_is_bipartite_coloring", (DL_FUNC) &R_igraph_is_bipartite_coloring, 2}, - {"R_igraph_is_chordal", (DL_FUNC) &R_igraph_is_chordal, 3}, - {"R_igraph_is_clique", (DL_FUNC) &R_igraph_is_clique, 3}, - {"R_igraph_is_complete", (DL_FUNC) &R_igraph_is_complete, 1}, - {"R_igraph_is_connected", (DL_FUNC) &R_igraph_is_connected, 2}, - {"R_igraph_is_dag", (DL_FUNC) &R_igraph_is_dag, 1}, - {"R_igraph_is_directed", (DL_FUNC) &R_igraph_is_directed, 1}, - {"R_igraph_is_edge_coloring", (DL_FUNC) &R_igraph_is_edge_coloring, 2}, - {"R_igraph_is_eulerian", (DL_FUNC) &R_igraph_is_eulerian, 1}, - {"R_igraph_is_forest", (DL_FUNC) &R_igraph_is_forest, 2}, - {"R_igraph_is_graphical", (DL_FUNC) &R_igraph_is_graphical, 3}, - {"R_igraph_is_independent_vertex_set", (DL_FUNC) &R_igraph_is_independent_vertex_set, 2}, - {"R_igraph_is_loop", (DL_FUNC) &R_igraph_is_loop, 2}, - {"R_igraph_is_matching", (DL_FUNC) &R_igraph_is_matching, 3}, - {"R_igraph_is_maximal_matching", (DL_FUNC) &R_igraph_is_maximal_matching, 3}, - {"R_igraph_is_minimal_separator", (DL_FUNC) &R_igraph_is_minimal_separator, 2}, - {"R_igraph_is_multiple", (DL_FUNC) &R_igraph_is_multiple, 2}, - {"R_igraph_is_mutual", (DL_FUNC) &R_igraph_is_mutual, 3}, - {"R_igraph_is_perfect", (DL_FUNC) &R_igraph_is_perfect, 1}, - {"R_igraph_is_same_graph", (DL_FUNC) &R_igraph_is_same_graph, 2}, - {"R_igraph_is_separator", (DL_FUNC) &R_igraph_is_separator, 2}, - {"R_igraph_is_simple", (DL_FUNC) &R_igraph_is_simple, 1}, - {"R_igraph_is_tree", (DL_FUNC) &R_igraph_is_tree, 2}, - {"R_igraph_is_vertex_coloring", (DL_FUNC) &R_igraph_is_vertex_coloring, 2}, - {"R_igraph_isoclass", (DL_FUNC) &R_igraph_isoclass, 1}, - {"R_igraph_isoclass_create", (DL_FUNC) &R_igraph_isoclass_create, 3}, - {"R_igraph_isoclass_subgraph", (DL_FUNC) &R_igraph_isoclass_subgraph, 2}, - {"R_igraph_isomorphic", (DL_FUNC) &R_igraph_isomorphic, 2}, - {"R_igraph_isomorphic_bliss", (DL_FUNC) &R_igraph_isomorphic_bliss, 5}, - {"R_igraph_isomorphic_vf2", (DL_FUNC) &R_igraph_isomorphic_vf2, 6}, - {"R_igraph_join", (DL_FUNC) &R_igraph_join, 2}, - {"R_igraph_joint_degree_distribution", (DL_FUNC) &R_igraph_joint_degree_distribution, 8}, - {"R_igraph_joint_degree_matrix", (DL_FUNC) &R_igraph_joint_degree_matrix, 4}, - {"R_igraph_joint_type_distribution", (DL_FUNC) &R_igraph_joint_type_distribution, 6}, - {"R_igraph_k_regular_game", (DL_FUNC) &R_igraph_k_regular_game, 4}, - {"R_igraph_kary_tree", (DL_FUNC) &R_igraph_kary_tree, 3}, - {"R_igraph_kautz", (DL_FUNC) &R_igraph_kautz, 2}, - {"R_igraph_laplacian_spectral_embedding", (DL_FUNC) &R_igraph_laplacian_spectral_embedding, 7}, - {"R_igraph_largest_cliques", (DL_FUNC) &R_igraph_largest_cliques, 1}, - {"R_igraph_largest_independent_vertex_sets", (DL_FUNC) &R_igraph_largest_independent_vertex_sets, 1}, - {"R_igraph_largest_weighted_cliques", (DL_FUNC) &R_igraph_largest_weighted_cliques, 2}, - {"R_igraph_lastcit_game", (DL_FUNC) &R_igraph_lastcit_game, 5}, - {"R_igraph_layout_align", (DL_FUNC) &R_igraph_layout_align, 2}, - {"R_igraph_layout_bipartite", (DL_FUNC) &R_igraph_layout_bipartite, 5}, - {"R_igraph_layout_circle", (DL_FUNC) &R_igraph_layout_circle, 2}, - {"R_igraph_layout_davidson_harel", (DL_FUNC) &R_igraph_layout_davidson_harel, 11}, - {"R_igraph_layout_drl", (DL_FUNC) &R_igraph_layout_drl, 5}, - {"R_igraph_layout_drl_3d", (DL_FUNC) &R_igraph_layout_drl_3d, 5}, - {"R_igraph_layout_fruchterman_reingold", (DL_FUNC) &R_igraph_layout_fruchterman_reingold, 11}, - {"R_igraph_layout_fruchterman_reingold_3d", (DL_FUNC) &R_igraph_layout_fruchterman_reingold_3d, 12}, - {"R_igraph_layout_gem", (DL_FUNC) &R_igraph_layout_gem, 7}, - {"R_igraph_layout_graphopt", (DL_FUNC) &R_igraph_layout_graphopt, 9}, - {"R_igraph_layout_grid", (DL_FUNC) &R_igraph_layout_grid, 2}, - {"R_igraph_layout_grid_3d", (DL_FUNC) &R_igraph_layout_grid_3d, 3}, - {"R_igraph_layout_kamada_kawai", (DL_FUNC) &R_igraph_layout_kamada_kawai, 11}, - {"R_igraph_layout_kamada_kawai_3d", (DL_FUNC) &R_igraph_layout_kamada_kawai_3d, 13}, - {"R_igraph_layout_lgl", (DL_FUNC) &R_igraph_layout_lgl, 8}, - {"R_igraph_layout_mds", (DL_FUNC) &R_igraph_layout_mds, 3}, - {"R_igraph_layout_merge_dla", (DL_FUNC) &R_igraph_layout_merge_dla, 2}, - {"R_igraph_layout_random", (DL_FUNC) &R_igraph_layout_random, 1}, - {"R_igraph_layout_random_3d", (DL_FUNC) &R_igraph_layout_random_3d, 1}, - {"R_igraph_layout_reingold_tilford", (DL_FUNC) &R_igraph_layout_reingold_tilford, 4}, - {"R_igraph_layout_reingold_tilford_circular", (DL_FUNC) &R_igraph_layout_reingold_tilford_circular, 4}, - {"R_igraph_layout_sphere", (DL_FUNC) &R_igraph_layout_sphere, 1}, - {"R_igraph_layout_star", (DL_FUNC) &R_igraph_layout_star, 3}, - {"R_igraph_layout_sugiyama", (DL_FUNC) &R_igraph_layout_sugiyama, 6}, - {"R_igraph_layout_umap", (DL_FUNC) &R_igraph_layout_umap, 7}, - {"R_igraph_layout_umap_3d", (DL_FUNC) &R_igraph_layout_umap_3d, 7}, - {"R_igraph_layout_umap_compute_weights", (DL_FUNC) &R_igraph_layout_umap_compute_weights, 3}, - {"R_igraph_lcf_vector", (DL_FUNC) &R_igraph_lcf_vector, 3}, - {"R_igraph_le_community_to_membership", (DL_FUNC) &R_igraph_le_community_to_membership, 3}, - {"R_igraph_linegraph", (DL_FUNC) &R_igraph_linegraph, 1}, - {"R_igraph_list_triangles", (DL_FUNC) &R_igraph_list_triangles, 1}, - {"R_igraph_local_efficiency", (DL_FUNC) &R_igraph_local_efficiency, 5}, - {"R_igraph_local_scan_0", (DL_FUNC) &R_igraph_local_scan_0, 3}, - {"R_igraph_local_scan_0_them", (DL_FUNC) &R_igraph_local_scan_0_them, 4}, - {"R_igraph_local_scan_1_ecount", (DL_FUNC) &R_igraph_local_scan_1_ecount, 3}, - {"R_igraph_local_scan_1_ecount_them", (DL_FUNC) &R_igraph_local_scan_1_ecount_them, 4}, - {"R_igraph_local_scan_k_ecount", (DL_FUNC) &R_igraph_local_scan_k_ecount, 4}, - {"R_igraph_local_scan_k_ecount_them", (DL_FUNC) &R_igraph_local_scan_k_ecount_them, 5}, - {"R_igraph_local_scan_neighborhood_ecount", (DL_FUNC) &R_igraph_local_scan_neighborhood_ecount, 3}, - {"R_igraph_local_scan_subset_ecount", (DL_FUNC) &R_igraph_local_scan_subset_ecount, 3}, - {"R_igraph_maxdegree", (DL_FUNC) &R_igraph_maxdegree, 4}, - {"R_igraph_maxflow", (DL_FUNC) &R_igraph_maxflow, 4}, - {"R_igraph_maxflow_value", (DL_FUNC) &R_igraph_maxflow_value, 4}, - {"R_igraph_maximal_cliques", (DL_FUNC) &R_igraph_maximal_cliques, 3}, - {"R_igraph_maximal_cliques_callback_closure", (DL_FUNC) &R_igraph_maximal_cliques_callback_closure, 4}, - {"R_igraph_maximal_cliques_count", (DL_FUNC) &R_igraph_maximal_cliques_count, 3}, - {"R_igraph_maximal_cliques_file", (DL_FUNC) &R_igraph_maximal_cliques_file, 4}, - {"R_igraph_maximal_cliques_hist", (DL_FUNC) &R_igraph_maximal_cliques_hist, 3}, - {"R_igraph_maximal_cliques_subset", (DL_FUNC) &R_igraph_maximal_cliques_subset, 5}, - {"R_igraph_maximal_independent_vertex_sets", (DL_FUNC) &R_igraph_maximal_independent_vertex_sets, 1}, - {"R_igraph_maximum_bipartite_matching", (DL_FUNC) &R_igraph_maximum_bipartite_matching, 4}, - {"R_igraph_maximum_cardinality_search", (DL_FUNC) &R_igraph_maximum_cardinality_search, 1}, - {"R_igraph_mean_degree", (DL_FUNC) &R_igraph_mean_degree, 2}, - {"R_igraph_mincut", (DL_FUNC) &R_igraph_mincut, 2}, - {"R_igraph_mincut_value", (DL_FUNC) &R_igraph_mincut_value, 2}, - {"R_igraph_minimum_cycle_basis", (DL_FUNC) &R_igraph_minimum_cycle_basis, 5}, - {"R_igraph_minimum_size_separators", (DL_FUNC) &R_igraph_minimum_size_separators, 1}, - {"R_igraph_minimum_spanning_tree", (DL_FUNC) &R_igraph_minimum_spanning_tree, 2}, - {"R_igraph_minimum_spanning_tree_prim", (DL_FUNC) &R_igraph_minimum_spanning_tree_prim, 2}, - {"R_igraph_minimum_spanning_tree_unweighted", (DL_FUNC) &R_igraph_minimum_spanning_tree_unweighted, 1}, - {"R_igraph_modularity", (DL_FUNC) &R_igraph_modularity, 5}, - {"R_igraph_modularity_matrix", (DL_FUNC) &R_igraph_modularity_matrix, 4}, - {"R_igraph_moran_process", (DL_FUNC) &R_igraph_moran_process, 5}, - {"R_igraph_motifs_randesu", (DL_FUNC) &R_igraph_motifs_randesu, 3}, - {"R_igraph_motifs_randesu_callback_closure", (DL_FUNC) &R_igraph_motifs_randesu_callback_closure, 4}, - {"R_igraph_motifs_randesu_estimate", (DL_FUNC) &R_igraph_motifs_randesu_estimate, 5}, - {"R_igraph_motifs_randesu_no", (DL_FUNC) &R_igraph_motifs_randesu_no, 3}, - {"R_igraph_mycielski_graph", (DL_FUNC) &R_igraph_mycielski_graph, 1}, - {"R_igraph_mycielskian", (DL_FUNC) &R_igraph_mycielskian, 2}, - {"R_igraph_neighborhood", (DL_FUNC) &R_igraph_neighborhood, 5}, - {"R_igraph_neighborhood_graphs", (DL_FUNC) &R_igraph_neighborhood_graphs, 5}, - {"R_igraph_neighborhood_size", (DL_FUNC) &R_igraph_neighborhood_size, 5}, - {"R_igraph_neighbors", (DL_FUNC) &R_igraph_neighbors, 3}, - {"R_igraph_pagerank", (DL_FUNC) &R_igraph_pagerank, 7}, - {"R_igraph_path_graph", (DL_FUNC) &R_igraph_path_graph, 3}, - {"R_igraph_path_length_hist", (DL_FUNC) &R_igraph_path_length_hist, 2}, - {"R_igraph_permute_vertices", (DL_FUNC) &R_igraph_permute_vertices, 2}, - {"R_igraph_personalized_pagerank", (DL_FUNC) &R_igraph_personalized_pagerank, 8}, - {"R_igraph_personalized_pagerank_vs", (DL_FUNC) &R_igraph_personalized_pagerank_vs, 8}, - {"R_igraph_power_law_fit", (DL_FUNC) &R_igraph_power_law_fit, 3}, - {"R_igraph_preference_game", (DL_FUNC) &R_igraph_preference_game, 7}, - {"R_igraph_product", (DL_FUNC) &R_igraph_product, 3}, - {"R_igraph_progress", (DL_FUNC) &R_igraph_progress, 2}, - {"R_igraph_pseudo_diameter", (DL_FUNC) &R_igraph_pseudo_diameter, 4}, - {"R_igraph_pseudo_diameter_dijkstra", (DL_FUNC) &R_igraph_pseudo_diameter_dijkstra, 5}, - {"R_igraph_radius", (DL_FUNC) &R_igraph_radius, 2}, - {"R_igraph_radius_dijkstra", (DL_FUNC) &R_igraph_radius_dijkstra, 3}, - {"R_igraph_random_edge_walk", (DL_FUNC) &R_igraph_random_edge_walk, 6}, - {"R_igraph_random_sample", (DL_FUNC) &R_igraph_random_sample, 3}, - {"R_igraph_random_spanning_tree", (DL_FUNC) &R_igraph_random_spanning_tree, 2}, - {"R_igraph_random_walk", (DL_FUNC) &R_igraph_random_walk, 6}, - {"R_igraph_read_graph_dimacs_flow", (DL_FUNC) &R_igraph_read_graph_dimacs_flow, 2}, - {"R_igraph_read_graph_dl", (DL_FUNC) &R_igraph_read_graph_dl, 2}, - {"R_igraph_read_graph_edgelist", (DL_FUNC) &R_igraph_read_graph_edgelist, 3}, - {"R_igraph_read_graph_gml", (DL_FUNC) &R_igraph_read_graph_gml, 1}, - {"R_igraph_read_graph_graphdb", (DL_FUNC) &R_igraph_read_graph_graphdb, 2}, - {"R_igraph_read_graph_graphml", (DL_FUNC) &R_igraph_read_graph_graphml, 2}, - {"R_igraph_read_graph_lgl", (DL_FUNC) &R_igraph_read_graph_lgl, 4}, - {"R_igraph_read_graph_ncol", (DL_FUNC) &R_igraph_read_graph_ncol, 5}, - {"R_igraph_read_graph_pajek", (DL_FUNC) &R_igraph_read_graph_pajek, 1}, - {"R_igraph_realize_bipartite_degree_sequence", (DL_FUNC) &R_igraph_realize_bipartite_degree_sequence, 4}, - {"R_igraph_realize_degree_sequence", (DL_FUNC) &R_igraph_realize_degree_sequence, 4}, - {"R_igraph_recent_degree_aging_game", (DL_FUNC) &R_igraph_recent_degree_aging_game, 10}, - {"R_igraph_recent_degree_game", (DL_FUNC) &R_igraph_recent_degree_game, 8}, - {"R_igraph_reciprocity", (DL_FUNC) &R_igraph_reciprocity, 3}, - {"R_igraph_regular_tree", (DL_FUNC) &R_igraph_regular_tree, 3}, - {"R_igraph_reindex_membership", (DL_FUNC) &R_igraph_reindex_membership, 1}, - {"R_igraph_residual_graph", (DL_FUNC) &R_igraph_residual_graph, 3}, - {"R_igraph_reverse_edges", (DL_FUNC) &R_igraph_reverse_edges, 2}, - {"R_igraph_reverse_residual_graph", (DL_FUNC) &R_igraph_reverse_residual_graph, 3}, - {"R_igraph_rewire", (DL_FUNC) &R_igraph_rewire, 3}, - {"R_igraph_rewire_directed_edges", (DL_FUNC) &R_igraph_rewire_directed_edges, 4}, - {"R_igraph_rewire_edges", (DL_FUNC) &R_igraph_rewire_edges, 4}, - {"R_igraph_rich_club_sequence", (DL_FUNC) &R_igraph_rich_club_sequence, 6}, - {"R_igraph_ring", (DL_FUNC) &R_igraph_ring, 4}, - {"R_igraph_rooted_product", (DL_FUNC) &R_igraph_rooted_product, 3}, - {"R_igraph_roots_for_tree_layout", (DL_FUNC) &R_igraph_roots_for_tree_layout, 3}, - {"R_igraph_roulette_wheel_imitation", (DL_FUNC) &R_igraph_roulette_wheel_imitation, 6}, - {"R_igraph_running_mean", (DL_FUNC) &R_igraph_running_mean, 2}, - {"R_igraph_sample_dirichlet", (DL_FUNC) &R_igraph_sample_dirichlet, 2}, - {"R_igraph_sample_sphere_surface", (DL_FUNC) &R_igraph_sample_sphere_surface, 4}, - {"R_igraph_sample_sphere_volume", (DL_FUNC) &R_igraph_sample_sphere_volume, 4}, - {"R_igraph_sbm_game", (DL_FUNC) &R_igraph_sbm_game, 5}, - {"R_igraph_similarity_dice", (DL_FUNC) &R_igraph_similarity_dice, 4}, - {"R_igraph_similarity_dice_es", (DL_FUNC) &R_igraph_similarity_dice_es, 4}, - {"R_igraph_similarity_dice_pairs", (DL_FUNC) &R_igraph_similarity_dice_pairs, 4}, - {"R_igraph_similarity_inverse_log_weighted", (DL_FUNC) &R_igraph_similarity_inverse_log_weighted, 3}, - {"R_igraph_similarity_jaccard", (DL_FUNC) &R_igraph_similarity_jaccard, 4}, - {"R_igraph_similarity_jaccard_es", (DL_FUNC) &R_igraph_similarity_jaccard_es, 4}, - {"R_igraph_similarity_jaccard_pairs", (DL_FUNC) &R_igraph_similarity_jaccard_pairs, 4}, - {"R_igraph_simple_cycles", (DL_FUNC) &R_igraph_simple_cycles, 4}, - {"R_igraph_simple_cycles_callback_closure", (DL_FUNC) &R_igraph_simple_cycles_callback_closure, 5}, - {"R_igraph_simple_interconnected_islands_game", (DL_FUNC) &R_igraph_simple_interconnected_islands_game, 4}, - {"R_igraph_simplify", (DL_FUNC) &R_igraph_simplify, 4}, - {"R_igraph_simplify_and_colorize", (DL_FUNC) &R_igraph_simplify_and_colorize, 1}, - {"R_igraph_sir", (DL_FUNC) &R_igraph_sir, 4}, - {"R_igraph_site_percolation", (DL_FUNC) &R_igraph_site_percolation, 2}, - {"R_igraph_solve_lsap", (DL_FUNC) &R_igraph_solve_lsap, 2}, - {"R_igraph_spanner", (DL_FUNC) &R_igraph_spanner, 3}, - {"R_igraph_sparse_adjacency", (DL_FUNC) &R_igraph_sparse_adjacency, 3}, - {"R_igraph_sparse_weighted_adjacency", (DL_FUNC) &R_igraph_sparse_weighted_adjacency, 3}, - {"R_igraph_split_join_distance", (DL_FUNC) &R_igraph_split_join_distance, 2}, - {"R_igraph_square_lattice", (DL_FUNC) &R_igraph_square_lattice, 5}, - {"R_igraph_st_edge_connectivity", (DL_FUNC) &R_igraph_st_edge_connectivity, 3}, - {"R_igraph_st_mincut", (DL_FUNC) &R_igraph_st_mincut, 4}, - {"R_igraph_st_mincut_value", (DL_FUNC) &R_igraph_st_mincut_value, 4}, - {"R_igraph_st_vertex_connectivity", (DL_FUNC) &R_igraph_st_vertex_connectivity, 4}, - {"R_igraph_star", (DL_FUNC) &R_igraph_star, 3}, - {"R_igraph_static_fitness_game", (DL_FUNC) &R_igraph_static_fitness_game, 5}, - {"R_igraph_static_power_law_game", (DL_FUNC) &R_igraph_static_power_law_game, 7}, - {"R_igraph_status", (DL_FUNC) &R_igraph_status, 1}, - {"R_igraph_stochastic_imitation", (DL_FUNC) &R_igraph_stochastic_imitation, 6}, - {"R_igraph_strength", (DL_FUNC) &R_igraph_strength, 5}, - {"R_igraph_strerror", (DL_FUNC) &R_igraph_strerror, 1}, - {"R_igraph_subcomponent", (DL_FUNC) &R_igraph_subcomponent, 3}, - {"R_igraph_subgraph_from_edges", (DL_FUNC) &R_igraph_subgraph_from_edges, 3}, - {"R_igraph_subisomorphic", (DL_FUNC) &R_igraph_subisomorphic, 2}, - {"R_igraph_subisomorphic_vf2", (DL_FUNC) &R_igraph_subisomorphic_vf2, 6}, - {"R_igraph_symmetric_tree", (DL_FUNC) &R_igraph_symmetric_tree, 2}, - {"R_igraph_to_directed", (DL_FUNC) &R_igraph_to_directed, 2}, - {"R_igraph_to_prufer", (DL_FUNC) &R_igraph_to_prufer, 1}, - {"R_igraph_to_undirected", (DL_FUNC) &R_igraph_to_undirected, 3}, - {"R_igraph_topological_sorting", (DL_FUNC) &R_igraph_topological_sorting, 2}, - {"R_igraph_transitive_closure", (DL_FUNC) &R_igraph_transitive_closure, 1}, - {"R_igraph_transitive_closure_dag", (DL_FUNC) &R_igraph_transitive_closure_dag, 1}, - {"R_igraph_transitivity_avglocal_undirected", (DL_FUNC) &R_igraph_transitivity_avglocal_undirected, 2}, - {"R_igraph_transitivity_barrat", (DL_FUNC) &R_igraph_transitivity_barrat, 4}, - {"R_igraph_transitivity_local_undirected", (DL_FUNC) &R_igraph_transitivity_local_undirected, 3}, - {"R_igraph_transitivity_undirected", (DL_FUNC) &R_igraph_transitivity_undirected, 2}, - {"R_igraph_tree_from_parent_vector", (DL_FUNC) &R_igraph_tree_from_parent_vector, 2}, - {"R_igraph_tree_game", (DL_FUNC) &R_igraph_tree_game, 3}, - {"R_igraph_triad_census", (DL_FUNC) &R_igraph_triad_census, 1}, - {"R_igraph_triangular_lattice", (DL_FUNC) &R_igraph_triangular_lattice, 3}, - {"R_igraph_trussness", (DL_FUNC) &R_igraph_trussness, 1}, - {"R_igraph_turan", (DL_FUNC) &R_igraph_turan, 2}, - {"R_igraph_unfold_tree", (DL_FUNC) &R_igraph_unfold_tree, 3}, - {"R_igraph_union", (DL_FUNC) &R_igraph_union, 2}, - {"R_igraph_union_many", (DL_FUNC) &R_igraph_union_many, 1}, - {"R_igraph_vcount", (DL_FUNC) &R_igraph_vcount, 1}, - {"R_igraph_version", (DL_FUNC) &R_igraph_version, 0}, - {"R_igraph_vertex_coloring_greedy", (DL_FUNC) &R_igraph_vertex_coloring_greedy, 2}, - {"R_igraph_vertex_connectivity", (DL_FUNC) &R_igraph_vertex_connectivity, 2}, - {"R_igraph_vertex_disjoint_paths", (DL_FUNC) &R_igraph_vertex_disjoint_paths, 3}, - {"R_igraph_vertex_path_from_edge_path", (DL_FUNC) &R_igraph_vertex_path_from_edge_path, 4}, - {"R_igraph_voronoi", (DL_FUNC) &R_igraph_voronoi, 5}, - {"R_igraph_watts_strogatz_game", (DL_FUNC) &R_igraph_watts_strogatz_game, 6}, - {"R_igraph_weighted_adjacency", (DL_FUNC) &R_igraph_weighted_adjacency, 3}, - {"R_igraph_weighted_clique_number", (DL_FUNC) &R_igraph_weighted_clique_number, 2}, - {"R_igraph_weighted_cliques", (DL_FUNC) &R_igraph_weighted_cliques, 5}, - {"R_igraph_weighted_sparsemat", (DL_FUNC) &R_igraph_weighted_sparsemat, 4}, - {"R_igraph_wheel", (DL_FUNC) &R_igraph_wheel, 3}, - {"R_igraph_widest_path_widths_dijkstra", (DL_FUNC) &R_igraph_widest_path_widths_dijkstra, 5}, - {"R_igraph_widest_path_widths_floyd_warshall", (DL_FUNC) &R_igraph_widest_path_widths_floyd_warshall, 5}, - {"R_igraph_write_graph_dimacs_flow", (DL_FUNC) &R_igraph_write_graph_dimacs_flow, 5}, - {"R_igraph_write_graph_dot", (DL_FUNC) &R_igraph_write_graph_dot, 2}, - {"R_igraph_write_graph_edgelist", (DL_FUNC) &R_igraph_write_graph_edgelist, 2}, - {"R_igraph_write_graph_gml", (DL_FUNC) &R_igraph_write_graph_gml, 5}, - {"R_igraph_write_graph_graphml", (DL_FUNC) &R_igraph_write_graph_graphml, 3}, - {"R_igraph_write_graph_leda", (DL_FUNC) &R_igraph_write_graph_leda, 4}, - {"R_igraph_write_graph_lgl", (DL_FUNC) &R_igraph_write_graph_lgl, 5}, - {"R_igraph_write_graph_ncol", (DL_FUNC) &R_igraph_write_graph_ncol, 4}, - {"R_igraph_write_graph_pajek", (DL_FUNC) &R_igraph_write_graph_pajek, 2}, - {"Rx_igraph_add_edges_manual", (DL_FUNC) &Rx_igraph_add_edges_manual, 2}, - {"Rx_igraph_add_env", (DL_FUNC) &Rx_igraph_add_env, 1}, - {"Rx_igraph_add_myid_to_env", (DL_FUNC) &Rx_igraph_add_myid_to_env, 1}, - {"Rx_igraph_add_version_to_env", (DL_FUNC) &Rx_igraph_add_version_to_env, 1}, - {"Rx_igraph_address", (DL_FUNC) &Rx_igraph_address, 1}, - {"Rx_igraph_adjacent_vertices", (DL_FUNC) &Rx_igraph_adjacent_vertices, 3}, - {"Rx_igraph_arpack", (DL_FUNC) &Rx_igraph_arpack, 5}, - {"Rx_igraph_arpack_unpack_complex", (DL_FUNC) &Rx_igraph_arpack_unpack_complex, 3}, - {"Rx_igraph_barabasi_aging_game", (DL_FUNC) &Rx_igraph_barabasi_aging_game, 12}, - {"Rx_igraph_barabasi_game", (DL_FUNC) &Rx_igraph_barabasi_game, 9}, - {"Rx_igraph_bfs", (DL_FUNC) &Rx_igraph_bfs, 15}, - {"Rx_igraph_bipartite_projection", (DL_FUNC) &Rx_igraph_bipartite_projection, 4}, - {"Rx_igraph_callaway_traits_game", (DL_FUNC) &Rx_igraph_callaway_traits_game, 6}, - {"Rx_igraph_cited_type_game", (DL_FUNC) &Rx_igraph_cited_type_game, 5}, - {"Rx_igraph_citing_cited_type_game", (DL_FUNC) &Rx_igraph_citing_cited_type_game, 5}, - {"Rx_igraph_community_edge_betweenness", (DL_FUNC) &Rx_igraph_community_edge_betweenness, 8}, - {"Rx_igraph_community_fastgreedy", (DL_FUNC) &Rx_igraph_community_fastgreedy, 5}, - {"Rx_igraph_community_to_membership2", (DL_FUNC) &Rx_igraph_community_to_membership2, 3}, - {"Rx_igraph_compose", (DL_FUNC) &Rx_igraph_compose, 3}, - {"Rx_igraph_connect_neighborhood", (DL_FUNC) &Rx_igraph_connect_neighborhood, 3}, - {"Rx_igraph_copy_env", (DL_FUNC) &Rx_igraph_copy_env, 1}, - {"Rx_igraph_copy_from", (DL_FUNC) &Rx_igraph_copy_from, 1}, - {"Rx_igraph_copy_to", (DL_FUNC) &Rx_igraph_copy_to, 1}, - {"Rx_igraph_create", (DL_FUNC) &Rx_igraph_create, 3}, - {"Rx_igraph_decompose", (DL_FUNC) &Rx_igraph_decompose, 4}, - {"Rx_igraph_degree_sequence_game", (DL_FUNC) &Rx_igraph_degree_sequence_game, 3}, - {"Rx_igraph_dfs", (DL_FUNC) &Rx_igraph_dfs, 12}, - {"Rx_igraph_diameter", (DL_FUNC) &Rx_igraph_diameter, 4}, - {"Rx_igraph_disjoint_union", (DL_FUNC) &Rx_igraph_disjoint_union, 1}, - {"Rx_igraph_edge_disjoint_paths", (DL_FUNC) &Rx_igraph_edge_disjoint_paths, 3}, - {"Rx_igraph_es_adj", (DL_FUNC) &Rx_igraph_es_adj, 4}, - {"Rx_igraph_es_pairs", (DL_FUNC) &Rx_igraph_es_pairs, 3}, - {"Rx_igraph_es_path", (DL_FUNC) &Rx_igraph_es_path, 3}, - {"Rx_igraph_establishment_game", (DL_FUNC) &Rx_igraph_establishment_game, 6}, - {"Rx_igraph_farthest_points", (DL_FUNC) &Rx_igraph_farthest_points, 4}, - {"Rx_igraph_finalizer", (DL_FUNC) &Rx_igraph_finalizer, 0}, - {"Rx_igraph_full", (DL_FUNC) &Rx_igraph_full, 3}, - {"Rx_igraph_get_adjacency", (DL_FUNC) &Rx_igraph_get_adjacency, 4}, - {"Rx_igraph_get_adjedgelist", (DL_FUNC) &Rx_igraph_get_adjedgelist, 3}, - {"Rx_igraph_get_adjlist", (DL_FUNC) &Rx_igraph_get_adjlist, 4}, - {"Rx_igraph_get_all_simple_paths_pp", (DL_FUNC) &Rx_igraph_get_all_simple_paths_pp, 1}, - {"Rx_igraph_get_attr_mode", (DL_FUNC) &Rx_igraph_get_attr_mode, 2}, - {"Rx_igraph_get_diameter", (DL_FUNC) &Rx_igraph_get_diameter, 4}, - {"Rx_igraph_get_eids", (DL_FUNC) &Rx_igraph_get_eids, 4}, - {"Rx_igraph_get_graph_id", (DL_FUNC) &Rx_igraph_get_graph_id, 1}, - {"Rx_igraph_get_shortest_paths", (DL_FUNC) &Rx_igraph_get_shortest_paths, 10}, - {"Rx_igraph_girth", (DL_FUNC) &Rx_igraph_girth, 2}, - {"Rx_igraph_graph_version", (DL_FUNC) &Rx_igraph_graph_version, 1}, - {"Rx_igraph_grg_game", (DL_FUNC) &Rx_igraph_grg_game, 4}, - {"Rx_igraph_i_levc_arp", (DL_FUNC) &Rx_igraph_i_levc_arp, 3}, - {"Rx_igraph_identical_graphs", (DL_FUNC) &Rx_igraph_identical_graphs, 3}, - {"Rx_igraph_incident_edges", (DL_FUNC) &Rx_igraph_incident_edges, 3}, - {"Rx_igraph_independent_vertex_sets", (DL_FUNC) &Rx_igraph_independent_vertex_sets, 3}, - {"Rx_igraph_intersection", (DL_FUNC) &Rx_igraph_intersection, 2}, - {"Rx_igraph_is_chordal", (DL_FUNC) &Rx_igraph_is_chordal, 5}, - {"Rx_igraph_kary_tree", (DL_FUNC) &Rx_igraph_kary_tree, 3}, - {"Rx_igraph_lastcit_game", (DL_FUNC) &Rx_igraph_lastcit_game, 5}, - {"Rx_igraph_layout_drl", (DL_FUNC) &Rx_igraph_layout_drl, 5}, - {"Rx_igraph_layout_drl_3d", (DL_FUNC) &Rx_igraph_layout_drl_3d, 5}, - {"Rx_igraph_layout_fruchterman_reingold", (DL_FUNC) &Rx_igraph_layout_fruchterman_reingold, 10}, - {"Rx_igraph_layout_fruchterman_reingold_3d", (DL_FUNC) &Rx_igraph_layout_fruchterman_reingold_3d, 11}, - {"Rx_igraph_layout_graphopt", (DL_FUNC) &Rx_igraph_layout_graphopt, 8}, - {"Rx_igraph_layout_kamada_kawai", (DL_FUNC) &Rx_igraph_layout_kamada_kawai, 10}, - {"Rx_igraph_layout_kamada_kawai_3d", (DL_FUNC) &Rx_igraph_layout_kamada_kawai_3d, 12}, - {"Rx_igraph_layout_lgl", (DL_FUNC) &Rx_igraph_layout_lgl, 8}, - {"Rx_igraph_layout_merge_dla", (DL_FUNC) &Rx_igraph_layout_merge_dla, 2}, - {"Rx_igraph_layout_reingold_tilford", (DL_FUNC) &Rx_igraph_layout_reingold_tilford, 5}, - {"Rx_igraph_make_weak_ref", (DL_FUNC) &Rx_igraph_make_weak_ref, 3}, - {"Rx_igraph_maximal_cliques", (DL_FUNC) &Rx_igraph_maximal_cliques, 4}, - {"Rx_igraph_maximal_cliques_count", (DL_FUNC) &Rx_igraph_maximal_cliques_count, 4}, - {"Rx_igraph_maximal_cliques_file", (DL_FUNC) &Rx_igraph_maximal_cliques_file, 5}, - {"Rx_igraph_mybracket2", (DL_FUNC) &Rx_igraph_mybracket2, 3}, - {"Rx_igraph_mybracket2_copy", (DL_FUNC) &Rx_igraph_mybracket2_copy, 3}, - {"Rx_igraph_mybracket2_names", (DL_FUNC) &Rx_igraph_mybracket2_names, 3}, - {"Rx_igraph_mybracket2_set", (DL_FUNC) &Rx_igraph_mybracket2_set, 4}, - {"Rx_igraph_mybracket3_set", (DL_FUNC) &Rx_igraph_mybracket3_set, 5}, - {"Rx_igraph_neighborhood", (DL_FUNC) &Rx_igraph_neighborhood, 5}, - {"Rx_igraph_neighborhood_graphs", (DL_FUNC) &Rx_igraph_neighborhood_graphs, 5}, - {"Rx_igraph_neighborhood_size", (DL_FUNC) &Rx_igraph_neighborhood_size, 5}, - {"Rx_igraph_no_components", (DL_FUNC) &Rx_igraph_no_components, 2}, - {"Rx_igraph_power_law_fit_new", (DL_FUNC) &Rx_igraph_power_law_fit_new, 5}, - {"Rx_igraph_random_sample", (DL_FUNC) &Rx_igraph_random_sample, 3}, - {"Rx_igraph_read_graph_dimacs", (DL_FUNC) &Rx_igraph_read_graph_dimacs, 2}, - {"Rx_igraph_read_graph_edgelist", (DL_FUNC) &Rx_igraph_read_graph_edgelist, 3}, - {"Rx_igraph_read_graph_lgl", (DL_FUNC) &Rx_igraph_read_graph_lgl, 4}, - {"Rx_igraph_read_graph_ncol", (DL_FUNC) &Rx_igraph_read_graph_ncol, 5}, - {"Rx_igraph_recent_degree_aging_game", (DL_FUNC) &Rx_igraph_recent_degree_aging_game, 10}, - {"Rx_igraph_ring", (DL_FUNC) &Rx_igraph_ring, 4}, - {"Rx_igraph_set_verbose", (DL_FUNC) &Rx_igraph_set_verbose, 1}, - {"Rx_igraph_shortest_paths", (DL_FUNC) &Rx_igraph_shortest_paths, 6}, - {"Rx_igraph_spinglass_community", (DL_FUNC) &Rx_igraph_spinglass_community, 11}, - {"Rx_igraph_spinglass_my_community", (DL_FUNC) &Rx_igraph_spinglass_my_community, 6}, - {"Rx_igraph_st_edge_connectivity", (DL_FUNC) &Rx_igraph_st_edge_connectivity, 3}, - {"Rx_igraph_st_mincut_value", (DL_FUNC) &Rx_igraph_st_mincut_value, 4}, - {"Rx_igraph_st_vertex_connectivity", (DL_FUNC) &Rx_igraph_st_vertex_connectivity, 3}, - {"Rx_igraph_star", (DL_FUNC) &Rx_igraph_star, 3}, - {"Rx_igraph_subcomponent", (DL_FUNC) &Rx_igraph_subcomponent, 3}, - {"Rx_igraph_subisomorphic_lad", (DL_FUNC) &Rx_igraph_subisomorphic_lad, 7}, - {"Rx_igraph_test_error_with_source", (DL_FUNC) &Rx_igraph_test_error_with_source, 0}, - {"Rx_igraph_transitivity_local_undirected_all", (DL_FUNC) &Rx_igraph_transitivity_local_undirected_all, 2}, - {"Rx_igraph_union", (DL_FUNC) &Rx_igraph_union, 2}, - {"Rx_igraph_vcount", (DL_FUNC) &Rx_igraph_vcount, 1}, - {"Rx_igraph_vertex_disjoint_paths", (DL_FUNC) &Rx_igraph_vertex_disjoint_paths, 3}, - {"Rx_igraph_vs_adj", (DL_FUNC) &Rx_igraph_vs_adj, 4}, - {"Rx_igraph_vs_nei", (DL_FUNC) &Rx_igraph_vs_nei, 4}, - {"Rx_igraph_walktrap_community", (DL_FUNC) &Rx_igraph_walktrap_community, 6}, - {"Rx_igraph_watts_strogatz_game", (DL_FUNC) &Rx_igraph_watts_strogatz_game, 6}, - {"Rx_igraph_weak_ref_key", (DL_FUNC) &Rx_igraph_weak_ref_key, 1}, - {"Rx_igraph_weak_ref_run_finalizer", (DL_FUNC) &Rx_igraph_weak_ref_run_finalizer, 1}, - {"Rx_igraph_weak_ref_value", (DL_FUNC) &Rx_igraph_weak_ref_value, 1}, - {"Rx_igraph_write_graph_dimacs", (DL_FUNC) &Rx_igraph_write_graph_dimacs, 5}, - {"Rx_igraph_write_graph_lgl", (DL_FUNC) &Rx_igraph_write_graph_lgl, 5}, - {"Rx_igraph_write_graph_ncol", (DL_FUNC) &Rx_igraph_write_graph_ncol, 4}, - {"UUID_gen", (DL_FUNC) &UUID_gen, 1}, - {"_igraph_getsphere", (DL_FUNC) &_igraph_getsphere, 7}, - {"_igraph_igraph_hcass2", (DL_FUNC) &_igraph_igraph_hcass2, 3}, + {"R_igraph_add_edge", (DL_FUNC) &R_igraph_add_edge, 3}, + {"R_igraph_add_edges", (DL_FUNC) &R_igraph_add_edges, 2}, + {"R_igraph_add_vertices", (DL_FUNC) &R_igraph_add_vertices, 2}, + {"R_igraph_adhesion", (DL_FUNC) &R_igraph_adhesion, 2}, + {"R_igraph_adjacency", (DL_FUNC) &R_igraph_adjacency, 3}, + {"R_igraph_adjacency_spectral_embedding", (DL_FUNC) &R_igraph_adjacency_spectral_embedding, 7}, + {"R_igraph_adjlist", (DL_FUNC) &R_igraph_adjlist, 3}, + {"R_igraph_all_minimal_st_separators", (DL_FUNC) &R_igraph_all_minimal_st_separators, 1}, + {"R_igraph_all_st_cuts", (DL_FUNC) &R_igraph_all_st_cuts, 3}, + {"R_igraph_all_st_mincuts", (DL_FUNC) &R_igraph_all_st_mincuts, 4}, + {"R_igraph_almost_equals", (DL_FUNC) &R_igraph_almost_equals, 3}, + {"R_igraph_are_adjacent", (DL_FUNC) &R_igraph_are_adjacent, 3}, + {"R_igraph_are_connected", (DL_FUNC) &R_igraph_are_connected, 3}, + {"R_igraph_articulation_points", (DL_FUNC) &R_igraph_articulation_points, 1}, + {"R_igraph_assortativity", (DL_FUNC) &R_igraph_assortativity, 5}, + {"R_igraph_assortativity_degree", (DL_FUNC) &R_igraph_assortativity_degree, 2}, + {"R_igraph_assortativity_nominal", (DL_FUNC) &R_igraph_assortativity_nominal, 4}, + {"R_igraph_asymmetric_preference_game", (DL_FUNC) &R_igraph_asymmetric_preference_game, 6}, + {"R_igraph_atlas", (DL_FUNC) &R_igraph_atlas, 1}, + {"R_igraph_authority_score", (DL_FUNC) &R_igraph_authority_score, 4}, + {"R_igraph_automorphism_group", (DL_FUNC) &R_igraph_automorphism_group, 3}, + {"R_igraph_average_local_efficiency", (DL_FUNC) &R_igraph_average_local_efficiency, 4}, + {"R_igraph_average_path_length", (DL_FUNC) &R_igraph_average_path_length, 3}, + {"R_igraph_average_path_length_dijkstra", (DL_FUNC) &R_igraph_average_path_length_dijkstra, 4}, + {"R_igraph_avg_nearest_neighbor_degree", (DL_FUNC) &R_igraph_avg_nearest_neighbor_degree, 5}, + {"R_igraph_barabasi_aging_game", (DL_FUNC) &R_igraph_barabasi_aging_game, 12}, + {"R_igraph_barabasi_game", (DL_FUNC) &R_igraph_barabasi_game, 9}, + {"R_igraph_betweenness", (DL_FUNC) &R_igraph_betweenness, 4}, + {"R_igraph_betweenness_cutoff", (DL_FUNC) &R_igraph_betweenness_cutoff, 5}, + {"R_igraph_betweenness_subset", (DL_FUNC) &R_igraph_betweenness_subset, 6}, + {"R_igraph_bfs_simple", (DL_FUNC) &R_igraph_bfs_simple, 3}, + {"R_igraph_biadjacency", (DL_FUNC) &R_igraph_biadjacency, 4}, + {"R_igraph_bibcoupling", (DL_FUNC) &R_igraph_bibcoupling, 2}, + {"R_igraph_biconnected_components", (DL_FUNC) &R_igraph_biconnected_components, 1}, + {"R_igraph_bipartite_game", (DL_FUNC) &R_igraph_bipartite_game, 7}, + {"R_igraph_bipartite_game_gnm", (DL_FUNC) &R_igraph_bipartite_game_gnm, 5}, + {"R_igraph_bipartite_game_gnp", (DL_FUNC) &R_igraph_bipartite_game_gnp, 5}, + {"R_igraph_bipartite_projection", (DL_FUNC) &R_igraph_bipartite_projection, 3}, + {"R_igraph_bipartite_projection_size", (DL_FUNC) &R_igraph_bipartite_projection_size, 2}, + {"R_igraph_bond_percolation", (DL_FUNC) &R_igraph_bond_percolation, 2}, + {"R_igraph_bridges", (DL_FUNC) &R_igraph_bridges, 1}, + {"R_igraph_callaway_traits_game", (DL_FUNC) &R_igraph_callaway_traits_game, 6}, + {"R_igraph_canonical_permutation", (DL_FUNC) &R_igraph_canonical_permutation, 3}, + {"R_igraph_centralization", (DL_FUNC) &R_igraph_centralization, 3}, + {"R_igraph_centralization_betweenness", (DL_FUNC) &R_igraph_centralization_betweenness, 3}, + {"R_igraph_centralization_betweenness_tmax", (DL_FUNC) &R_igraph_centralization_betweenness_tmax, 3}, + {"R_igraph_centralization_closeness", (DL_FUNC) &R_igraph_centralization_closeness, 3}, + {"R_igraph_centralization_closeness_tmax", (DL_FUNC) &R_igraph_centralization_closeness_tmax, 3}, + {"R_igraph_centralization_degree", (DL_FUNC) &R_igraph_centralization_degree, 4}, + {"R_igraph_centralization_degree_tmax", (DL_FUNC) &R_igraph_centralization_degree_tmax, 4}, + {"R_igraph_centralization_eigenvector_centrality", (DL_FUNC) &R_igraph_centralization_eigenvector_centrality, 5}, + {"R_igraph_centralization_eigenvector_centrality_tmax", (DL_FUNC) &R_igraph_centralization_eigenvector_centrality_tmax, 4}, + {"R_igraph_chung_lu_game", (DL_FUNC) &R_igraph_chung_lu_game, 4}, + {"R_igraph_circulant", (DL_FUNC) &R_igraph_circulant, 3}, + {"R_igraph_cited_type_game", (DL_FUNC) &R_igraph_cited_type_game, 5}, + {"R_igraph_citing_cited_type_game", (DL_FUNC) &R_igraph_citing_cited_type_game, 5}, + {"R_igraph_clique_number", (DL_FUNC) &R_igraph_clique_number, 1}, + {"R_igraph_clique_size_hist", (DL_FUNC) &R_igraph_clique_size_hist, 3}, + {"R_igraph_cliques", (DL_FUNC) &R_igraph_cliques, 3}, + {"R_igraph_cliques_callback_closure", (DL_FUNC) &R_igraph_cliques_callback_closure, 4}, + {"R_igraph_closeness", (DL_FUNC) &R_igraph_closeness, 5}, + {"R_igraph_closeness_cutoff", (DL_FUNC) &R_igraph_closeness_cutoff, 6}, + {"R_igraph_cmp_epsilon", (DL_FUNC) &R_igraph_cmp_epsilon, 3}, + {"R_igraph_cocitation", (DL_FUNC) &R_igraph_cocitation, 2}, + {"R_igraph_cohesion", (DL_FUNC) &R_igraph_cohesion, 2}, + {"R_igraph_cohesive_blocks", (DL_FUNC) &R_igraph_cohesive_blocks, 1}, + {"R_igraph_community_eb_get_merges", (DL_FUNC) &R_igraph_community_eb_get_merges, 4}, + {"R_igraph_community_edge_betweenness", (DL_FUNC) &R_igraph_community_edge_betweenness, 3}, + {"R_igraph_community_fastgreedy", (DL_FUNC) &R_igraph_community_fastgreedy, 2}, + {"R_igraph_community_fluid_communities", (DL_FUNC) &R_igraph_community_fluid_communities, 2}, + {"R_igraph_community_infomap", (DL_FUNC) &R_igraph_community_infomap, 4}, + {"R_igraph_community_label_propagation", (DL_FUNC) &R_igraph_community_label_propagation, 5}, + {"R_igraph_community_leading_eigenvector_callback_closure", (DL_FUNC) &R_igraph_community_leading_eigenvector_callback_closure, 10}, + {"R_igraph_community_leiden", (DL_FUNC) &R_igraph_community_leiden, 8}, + {"R_igraph_community_multilevel", (DL_FUNC) &R_igraph_community_multilevel, 3}, + {"R_igraph_community_optimal_modularity", (DL_FUNC) &R_igraph_community_optimal_modularity, 2}, + {"R_igraph_community_spinglass", (DL_FUNC) &R_igraph_community_spinglass, 11}, + {"R_igraph_community_spinglass_single", (DL_FUNC) &R_igraph_community_spinglass_single, 6}, + {"R_igraph_community_to_membership", (DL_FUNC) &R_igraph_community_to_membership, 3}, + {"R_igraph_community_walktrap", (DL_FUNC) &R_igraph_community_walktrap, 3}, + {"R_igraph_compare_communities", (DL_FUNC) &R_igraph_compare_communities, 3}, + {"R_igraph_complementer", (DL_FUNC) &R_igraph_complementer, 2}, + {"R_igraph_compose", (DL_FUNC) &R_igraph_compose, 2}, + {"R_igraph_connect_neighborhood", (DL_FUNC) &R_igraph_connect_neighborhood, 3}, + {"R_igraph_connected_components", (DL_FUNC) &R_igraph_connected_components, 2}, + {"R_igraph_constraint", (DL_FUNC) &R_igraph_constraint, 3}, + {"R_igraph_contract_vertices", (DL_FUNC) &R_igraph_contract_vertices, 3}, + {"R_igraph_convergence_degree", (DL_FUNC) &R_igraph_convergence_degree, 1}, + {"R_igraph_convex_hull_2d", (DL_FUNC) &R_igraph_convex_hull_2d, 1}, + {"R_igraph_copy", (DL_FUNC) &R_igraph_copy, 1}, + {"R_igraph_coreness", (DL_FUNC) &R_igraph_coreness, 2}, + {"R_igraph_correlated_game", (DL_FUNC) &R_igraph_correlated_game, 4}, + {"R_igraph_correlated_pair_game", (DL_FUNC) &R_igraph_correlated_pair_game, 5}, + {"R_igraph_count_adjacent_triangles", (DL_FUNC) &R_igraph_count_adjacent_triangles, 2}, + {"R_igraph_count_automorphisms", (DL_FUNC) &R_igraph_count_automorphisms, 3}, + {"R_igraph_count_isomorphisms_vf2", (DL_FUNC) &R_igraph_count_isomorphisms_vf2, 6}, + {"R_igraph_count_loops", (DL_FUNC) &R_igraph_count_loops, 1}, + {"R_igraph_count_multiple", (DL_FUNC) &R_igraph_count_multiple, 2}, + {"R_igraph_count_reachable", (DL_FUNC) &R_igraph_count_reachable, 2}, + {"R_igraph_count_subisomorphisms_vf2", (DL_FUNC) &R_igraph_count_subisomorphisms_vf2, 6}, + {"R_igraph_count_triangles", (DL_FUNC) &R_igraph_count_triangles, 1}, + {"R_igraph_create", (DL_FUNC) &R_igraph_create, 3}, + {"R_igraph_create_bipartite", (DL_FUNC) &R_igraph_create_bipartite, 3}, + {"R_igraph_cycle_graph", (DL_FUNC) &R_igraph_cycle_graph, 3}, + {"R_igraph_de_bruijn", (DL_FUNC) &R_igraph_de_bruijn, 2}, + {"R_igraph_decompose", (DL_FUNC) &R_igraph_decompose, 4}, + {"R_igraph_degree", (DL_FUNC) &R_igraph_degree, 4}, + {"R_igraph_degree_correlation_vector", (DL_FUNC) &R_igraph_degree_correlation_vector, 5}, + {"R_igraph_degree_sequence_game", (DL_FUNC) &R_igraph_degree_sequence_game, 3}, + {"R_igraph_delete_edges", (DL_FUNC) &R_igraph_delete_edges, 2}, + {"R_igraph_delete_vertices", (DL_FUNC) &R_igraph_delete_vertices, 2}, + {"R_igraph_delete_vertices_idx", (DL_FUNC) &R_igraph_delete_vertices_idx, 2}, + {"R_igraph_density", (DL_FUNC) &R_igraph_density, 2}, + {"R_igraph_deterministic_optimal_imitation", (DL_FUNC) &R_igraph_deterministic_optimal_imitation, 6}, + {"R_igraph_diameter", (DL_FUNC) &R_igraph_diameter, 3}, + {"R_igraph_diameter_dijkstra", (DL_FUNC) &R_igraph_diameter_dijkstra, 4}, + {"R_igraph_difference", (DL_FUNC) &R_igraph_difference, 2}, + {"R_igraph_dim_select", (DL_FUNC) &R_igraph_dim_select, 1}, + {"R_igraph_disjoint_union", (DL_FUNC) &R_igraph_disjoint_union, 2}, + {"R_igraph_disjoint_union_many", (DL_FUNC) &R_igraph_disjoint_union_many, 1}, + {"R_igraph_distances", (DL_FUNC) &R_igraph_distances, 4}, + {"R_igraph_distances_bellman_ford", (DL_FUNC) &R_igraph_distances_bellman_ford, 5}, + {"R_igraph_distances_cutoff", (DL_FUNC) &R_igraph_distances_cutoff, 5}, + {"R_igraph_distances_dijkstra", (DL_FUNC) &R_igraph_distances_dijkstra, 5}, + {"R_igraph_distances_dijkstra_cutoff", (DL_FUNC) &R_igraph_distances_dijkstra_cutoff, 6}, + {"R_igraph_distances_floyd_warshall", (DL_FUNC) &R_igraph_distances_floyd_warshall, 6}, + {"R_igraph_distances_johnson", (DL_FUNC) &R_igraph_distances_johnson, 4}, + {"R_igraph_diversity", (DL_FUNC) &R_igraph_diversity, 3}, + {"R_igraph_dominator_tree", (DL_FUNC) &R_igraph_dominator_tree, 3}, + {"R_igraph_dot_product_game", (DL_FUNC) &R_igraph_dot_product_game, 2}, + {"R_igraph_dyad_census", (DL_FUNC) &R_igraph_dyad_census, 1}, + {"R_igraph_ecc", (DL_FUNC) &R_igraph_ecc, 5}, + {"R_igraph_eccentricity", (DL_FUNC) &R_igraph_eccentricity, 3}, + {"R_igraph_eccentricity_dijkstra", (DL_FUNC) &R_igraph_eccentricity_dijkstra, 4}, + {"R_igraph_ecount", (DL_FUNC) &R_igraph_ecount, 1}, + {"R_igraph_edge", (DL_FUNC) &R_igraph_edge, 2}, + {"R_igraph_edge_betweenness", (DL_FUNC) &R_igraph_edge_betweenness, 3}, + {"R_igraph_edge_betweenness_cutoff", (DL_FUNC) &R_igraph_edge_betweenness_cutoff, 4}, + {"R_igraph_edge_betweenness_subset", (DL_FUNC) &R_igraph_edge_betweenness_subset, 6}, + {"R_igraph_edge_connectivity", (DL_FUNC) &R_igraph_edge_connectivity, 2}, + {"R_igraph_edge_disjoint_paths", (DL_FUNC) &R_igraph_edge_disjoint_paths, 3}, + {"R_igraph_edgelist_percolation", (DL_FUNC) &R_igraph_edgelist_percolation, 1}, + {"R_igraph_edges", (DL_FUNC) &R_igraph_edges, 2}, + {"R_igraph_eigen_adjacency", (DL_FUNC) &R_igraph_eigen_adjacency, 4}, + {"R_igraph_eigenvector_centrality", (DL_FUNC) &R_igraph_eigenvector_centrality, 5}, + {"R_igraph_empty", (DL_FUNC) &R_igraph_empty, 2}, + {"R_igraph_empty_attrs", (DL_FUNC) &R_igraph_empty_attrs, 2}, + {"R_igraph_erdos_renyi_game_gnm", (DL_FUNC) &R_igraph_erdos_renyi_game_gnm, 4}, + {"R_igraph_erdos_renyi_game_gnp", (DL_FUNC) &R_igraph_erdos_renyi_game_gnp, 4}, + {"R_igraph_establishment_game", (DL_FUNC) &R_igraph_establishment_game, 6}, + {"R_igraph_eulerian_cycle", (DL_FUNC) &R_igraph_eulerian_cycle, 1}, + {"R_igraph_eulerian_path", (DL_FUNC) &R_igraph_eulerian_path, 1}, + {"R_igraph_even_tarjan_reduction", (DL_FUNC) &R_igraph_even_tarjan_reduction, 1}, + {"R_igraph_expand_path_to_pairs", (DL_FUNC) &R_igraph_expand_path_to_pairs, 1}, + {"R_igraph_extended_chordal_ring", (DL_FUNC) &R_igraph_extended_chordal_ring, 3}, + {"R_igraph_famous", (DL_FUNC) &R_igraph_famous, 1}, + {"R_igraph_feedback_arc_set", (DL_FUNC) &R_igraph_feedback_arc_set, 3}, + {"R_igraph_feedback_vertex_set", (DL_FUNC) &R_igraph_feedback_vertex_set, 3}, + {"R_igraph_finalizer", (DL_FUNC) &R_igraph_finalizer, 0}, + {"R_igraph_find_cycle", (DL_FUNC) &R_igraph_find_cycle, 2}, + {"R_igraph_forest_fire_game", (DL_FUNC) &R_igraph_forest_fire_game, 5}, + {"R_igraph_from_hrg_dendrogram", (DL_FUNC) &R_igraph_from_hrg_dendrogram, 1}, + {"R_igraph_from_prufer", (DL_FUNC) &R_igraph_from_prufer, 1}, + {"R_igraph_full", (DL_FUNC) &R_igraph_full, 3}, + {"R_igraph_full_bipartite", (DL_FUNC) &R_igraph_full_bipartite, 4}, + {"R_igraph_full_citation", (DL_FUNC) &R_igraph_full_citation, 2}, + {"R_igraph_full_multipartite", (DL_FUNC) &R_igraph_full_multipartite, 3}, + {"R_igraph_fundamental_cycles", (DL_FUNC) &R_igraph_fundamental_cycles, 4}, + {"R_igraph_generalized_petersen", (DL_FUNC) &R_igraph_generalized_petersen, 2}, + {"R_igraph_get_adjacency", (DL_FUNC) &R_igraph_get_adjacency, 4}, + {"R_igraph_get_adjacency_sparse", (DL_FUNC) &R_igraph_get_adjacency_sparse, 4}, + {"R_igraph_get_all_eids_between", (DL_FUNC) &R_igraph_get_all_eids_between, 4}, + {"R_igraph_get_all_shortest_paths", (DL_FUNC) &R_igraph_get_all_shortest_paths, 4}, + {"R_igraph_get_all_shortest_paths_dijkstra", (DL_FUNC) &R_igraph_get_all_shortest_paths_dijkstra, 5}, + {"R_igraph_get_all_simple_paths", (DL_FUNC) &R_igraph_get_all_simple_paths, 5}, + {"R_igraph_get_biadjacency", (DL_FUNC) &R_igraph_get_biadjacency, 2}, + {"R_igraph_get_edgelist", (DL_FUNC) &R_igraph_get_edgelist, 2}, + {"R_igraph_get_eids", (DL_FUNC) &R_igraph_get_eids, 4}, + {"R_igraph_get_isomorphisms_vf2", (DL_FUNC) &R_igraph_get_isomorphisms_vf2, 6}, + {"R_igraph_get_isomorphisms_vf2_callback_closure", (DL_FUNC) &R_igraph_get_isomorphisms_vf2_callback_closure, 7}, + {"R_igraph_get_k_shortest_paths", (DL_FUNC) &R_igraph_get_k_shortest_paths, 6}, + {"R_igraph_get_laplacian", (DL_FUNC) &R_igraph_get_laplacian, 4}, + {"R_igraph_get_laplacian_sparse", (DL_FUNC) &R_igraph_get_laplacian_sparse, 4}, + {"R_igraph_get_shortest_path", (DL_FUNC) &R_igraph_get_shortest_path, 4}, + {"R_igraph_get_shortest_path_astar", (DL_FUNC) &R_igraph_get_shortest_path_astar, 6}, + {"R_igraph_get_shortest_path_bellman_ford", (DL_FUNC) &R_igraph_get_shortest_path_bellman_ford, 5}, + {"R_igraph_get_shortest_path_dijkstra", (DL_FUNC) &R_igraph_get_shortest_path_dijkstra, 5}, + {"R_igraph_get_shortest_paths", (DL_FUNC) &R_igraph_get_shortest_paths, 4}, + {"R_igraph_get_shortest_paths_bellman_ford", (DL_FUNC) &R_igraph_get_shortest_paths_bellman_ford, 5}, + {"R_igraph_get_shortest_paths_dijkstra", (DL_FUNC) &R_igraph_get_shortest_paths_dijkstra, 5}, + {"R_igraph_get_stochastic", (DL_FUNC) &R_igraph_get_stochastic, 3}, + {"R_igraph_get_stochastic_sparse", (DL_FUNC) &R_igraph_get_stochastic_sparse, 3}, + {"R_igraph_get_subisomorphisms_vf2", (DL_FUNC) &R_igraph_get_subisomorphisms_vf2, 6}, + {"R_igraph_get_subisomorphisms_vf2_callback_closure", (DL_FUNC) &R_igraph_get_subisomorphisms_vf2_callback_closure, 7}, + {"R_igraph_get_widest_path", (DL_FUNC) &R_igraph_get_widest_path, 5}, + {"R_igraph_get_widest_paths", (DL_FUNC) &R_igraph_get_widest_paths, 5}, + {"R_igraph_girth", (DL_FUNC) &R_igraph_girth, 1}, + {"R_igraph_global_efficiency", (DL_FUNC) &R_igraph_global_efficiency, 3}, + {"R_igraph_gomory_hu_tree", (DL_FUNC) &R_igraph_gomory_hu_tree, 2}, + {"R_igraph_graph_center", (DL_FUNC) &R_igraph_graph_center, 2}, + {"R_igraph_graph_center_dijkstra", (DL_FUNC) &R_igraph_graph_center_dijkstra, 3}, + {"R_igraph_graph_count", (DL_FUNC) &R_igraph_graph_count, 2}, + {"R_igraph_graph_power", (DL_FUNC) &R_igraph_graph_power, 3}, + {"R_igraph_graphlets", (DL_FUNC) &R_igraph_graphlets, 3}, + {"R_igraph_graphlets_candidate_basis", (DL_FUNC) &R_igraph_graphlets_candidate_basis, 2}, + {"R_igraph_graphlets_project", (DL_FUNC) &R_igraph_graphlets_project, 6}, + {"R_igraph_grg_game", (DL_FUNC) &R_igraph_grg_game, 3}, + {"R_igraph_growing_random_game", (DL_FUNC) &R_igraph_growing_random_game, 4}, + {"R_igraph_harmonic_centrality", (DL_FUNC) &R_igraph_harmonic_centrality, 5}, + {"R_igraph_harmonic_centrality_cutoff", (DL_FUNC) &R_igraph_harmonic_centrality_cutoff, 6}, + {"R_igraph_has_attribute_table", (DL_FUNC) &R_igraph_has_attribute_table, 0}, + {"R_igraph_has_loop", (DL_FUNC) &R_igraph_has_loop, 1}, + {"R_igraph_has_multiple", (DL_FUNC) &R_igraph_has_multiple, 1}, + {"R_igraph_has_mutual", (DL_FUNC) &R_igraph_has_mutual, 2}, + {"R_igraph_hrg_consensus", (DL_FUNC) &R_igraph_hrg_consensus, 4}, + {"R_igraph_hrg_create", (DL_FUNC) &R_igraph_hrg_create, 2}, + {"R_igraph_hrg_fit", (DL_FUNC) &R_igraph_hrg_fit, 4}, + {"R_igraph_hrg_game", (DL_FUNC) &R_igraph_hrg_game, 1}, + {"R_igraph_hrg_predict", (DL_FUNC) &R_igraph_hrg_predict, 5}, + {"R_igraph_hrg_resize", (DL_FUNC) &R_igraph_hrg_resize, 2}, + {"R_igraph_hrg_sample", (DL_FUNC) &R_igraph_hrg_sample, 1}, + {"R_igraph_hrg_sample_many", (DL_FUNC) &R_igraph_hrg_sample_many, 2}, + {"R_igraph_hrg_size", (DL_FUNC) &R_igraph_hrg_size, 1}, + {"R_igraph_hsbm_game", (DL_FUNC) &R_igraph_hsbm_game, 5}, + {"R_igraph_hsbm_list_game", (DL_FUNC) &R_igraph_hsbm_list_game, 5}, + {"R_igraph_hub_and_authority_scores", (DL_FUNC) &R_igraph_hub_and_authority_scores, 4}, + {"R_igraph_hub_score", (DL_FUNC) &R_igraph_hub_score, 4}, + {"R_igraph_hypercube", (DL_FUNC) &R_igraph_hypercube, 2}, + {"R_igraph_incident", (DL_FUNC) &R_igraph_incident, 3}, + {"R_igraph_independence_number", (DL_FUNC) &R_igraph_independence_number, 1}, + {"R_igraph_independent_vertex_sets", (DL_FUNC) &R_igraph_independent_vertex_sets, 3}, + {"R_igraph_induced_subgraph", (DL_FUNC) &R_igraph_induced_subgraph, 3}, + {"R_igraph_induced_subgraph_map", (DL_FUNC) &R_igraph_induced_subgraph_map, 3}, + {"R_igraph_intersection", (DL_FUNC) &R_igraph_intersection, 2}, + {"R_igraph_intersection_many", (DL_FUNC) &R_igraph_intersection_many, 1}, + {"R_igraph_invalidate_cache", (DL_FUNC) &R_igraph_invalidate_cache, 1}, + {"R_igraph_is_acyclic", (DL_FUNC) &R_igraph_is_acyclic, 1}, + {"R_igraph_is_biconnected", (DL_FUNC) &R_igraph_is_biconnected, 1}, + {"R_igraph_is_bigraphical", (DL_FUNC) &R_igraph_is_bigraphical, 3}, + {"R_igraph_is_bipartite", (DL_FUNC) &R_igraph_is_bipartite, 1}, + {"R_igraph_is_bipartite_coloring", (DL_FUNC) &R_igraph_is_bipartite_coloring, 2}, + {"R_igraph_is_chordal", (DL_FUNC) &R_igraph_is_chordal, 3}, + {"R_igraph_is_clique", (DL_FUNC) &R_igraph_is_clique, 3}, + {"R_igraph_is_complete", (DL_FUNC) &R_igraph_is_complete, 1}, + {"R_igraph_is_connected", (DL_FUNC) &R_igraph_is_connected, 2}, + {"R_igraph_is_dag", (DL_FUNC) &R_igraph_is_dag, 1}, + {"R_igraph_is_directed", (DL_FUNC) &R_igraph_is_directed, 1}, + {"R_igraph_is_edge_coloring", (DL_FUNC) &R_igraph_is_edge_coloring, 2}, + {"R_igraph_is_eulerian", (DL_FUNC) &R_igraph_is_eulerian, 1}, + {"R_igraph_is_forest", (DL_FUNC) &R_igraph_is_forest, 2}, + {"R_igraph_is_graphical", (DL_FUNC) &R_igraph_is_graphical, 3}, + {"R_igraph_is_independent_vertex_set", (DL_FUNC) &R_igraph_is_independent_vertex_set, 2}, + {"R_igraph_is_loop", (DL_FUNC) &R_igraph_is_loop, 2}, + {"R_igraph_is_matching", (DL_FUNC) &R_igraph_is_matching, 3}, + {"R_igraph_is_maximal_matching", (DL_FUNC) &R_igraph_is_maximal_matching, 3}, + {"R_igraph_is_minimal_separator", (DL_FUNC) &R_igraph_is_minimal_separator, 2}, + {"R_igraph_is_multiple", (DL_FUNC) &R_igraph_is_multiple, 2}, + {"R_igraph_is_mutual", (DL_FUNC) &R_igraph_is_mutual, 3}, + {"R_igraph_is_perfect", (DL_FUNC) &R_igraph_is_perfect, 1}, + {"R_igraph_is_same_graph", (DL_FUNC) &R_igraph_is_same_graph, 2}, + {"R_igraph_is_separator", (DL_FUNC) &R_igraph_is_separator, 2}, + {"R_igraph_is_simple", (DL_FUNC) &R_igraph_is_simple, 1}, + {"R_igraph_is_tree", (DL_FUNC) &R_igraph_is_tree, 2}, + {"R_igraph_is_vertex_coloring", (DL_FUNC) &R_igraph_is_vertex_coloring, 2}, + {"R_igraph_isoclass", (DL_FUNC) &R_igraph_isoclass, 1}, + {"R_igraph_isoclass_create", (DL_FUNC) &R_igraph_isoclass_create, 3}, + {"R_igraph_isoclass_subgraph", (DL_FUNC) &R_igraph_isoclass_subgraph, 2}, + {"R_igraph_isomorphic", (DL_FUNC) &R_igraph_isomorphic, 2}, + {"R_igraph_isomorphic_bliss", (DL_FUNC) &R_igraph_isomorphic_bliss, 5}, + {"R_igraph_isomorphic_vf2", (DL_FUNC) &R_igraph_isomorphic_vf2, 6}, + {"R_igraph_join", (DL_FUNC) &R_igraph_join, 2}, + {"R_igraph_joint_degree_distribution", (DL_FUNC) &R_igraph_joint_degree_distribution, 8}, + {"R_igraph_joint_degree_matrix", (DL_FUNC) &R_igraph_joint_degree_matrix, 4}, + {"R_igraph_joint_type_distribution", (DL_FUNC) &R_igraph_joint_type_distribution, 6}, + {"R_igraph_k_regular_game", (DL_FUNC) &R_igraph_k_regular_game, 4}, + {"R_igraph_kary_tree", (DL_FUNC) &R_igraph_kary_tree, 3}, + {"R_igraph_kautz", (DL_FUNC) &R_igraph_kautz, 2}, + {"R_igraph_laplacian_spectral_embedding", (DL_FUNC) &R_igraph_laplacian_spectral_embedding, 7}, + {"R_igraph_largest_cliques", (DL_FUNC) &R_igraph_largest_cliques, 1}, + {"R_igraph_largest_independent_vertex_sets", (DL_FUNC) &R_igraph_largest_independent_vertex_sets, 1}, + {"R_igraph_largest_weighted_cliques", (DL_FUNC) &R_igraph_largest_weighted_cliques, 2}, + {"R_igraph_lastcit_game", (DL_FUNC) &R_igraph_lastcit_game, 5}, + {"R_igraph_layout_align", (DL_FUNC) &R_igraph_layout_align, 2}, + {"R_igraph_layout_bipartite", (DL_FUNC) &R_igraph_layout_bipartite, 5}, + {"R_igraph_layout_circle", (DL_FUNC) &R_igraph_layout_circle, 2}, + {"R_igraph_layout_davidson_harel", (DL_FUNC) &R_igraph_layout_davidson_harel, 11}, + {"R_igraph_layout_drl", (DL_FUNC) &R_igraph_layout_drl, 5}, + {"R_igraph_layout_drl_3d", (DL_FUNC) &R_igraph_layout_drl_3d, 5}, + {"R_igraph_layout_fruchterman_reingold", (DL_FUNC) &R_igraph_layout_fruchterman_reingold, 11}, + {"R_igraph_layout_fruchterman_reingold_3d", (DL_FUNC) &R_igraph_layout_fruchterman_reingold_3d, 12}, + {"R_igraph_layout_gem", (DL_FUNC) &R_igraph_layout_gem, 7}, + {"R_igraph_layout_graphopt", (DL_FUNC) &R_igraph_layout_graphopt, 9}, + {"R_igraph_layout_grid", (DL_FUNC) &R_igraph_layout_grid, 2}, + {"R_igraph_layout_grid_3d", (DL_FUNC) &R_igraph_layout_grid_3d, 3}, + {"R_igraph_layout_kamada_kawai", (DL_FUNC) &R_igraph_layout_kamada_kawai, 11}, + {"R_igraph_layout_kamada_kawai_3d", (DL_FUNC) &R_igraph_layout_kamada_kawai_3d, 13}, + {"R_igraph_layout_lgl", (DL_FUNC) &R_igraph_layout_lgl, 8}, + {"R_igraph_layout_mds", (DL_FUNC) &R_igraph_layout_mds, 3}, + {"R_igraph_layout_merge_dla", (DL_FUNC) &R_igraph_layout_merge_dla, 2}, + {"R_igraph_layout_random", (DL_FUNC) &R_igraph_layout_random, 1}, + {"R_igraph_layout_random_3d", (DL_FUNC) &R_igraph_layout_random_3d, 1}, + {"R_igraph_layout_reingold_tilford", (DL_FUNC) &R_igraph_layout_reingold_tilford, 4}, + {"R_igraph_layout_reingold_tilford_circular", (DL_FUNC) &R_igraph_layout_reingold_tilford_circular, 4}, + {"R_igraph_layout_sphere", (DL_FUNC) &R_igraph_layout_sphere, 1}, + {"R_igraph_layout_star", (DL_FUNC) &R_igraph_layout_star, 3}, + {"R_igraph_layout_sugiyama", (DL_FUNC) &R_igraph_layout_sugiyama, 6}, + {"R_igraph_layout_umap", (DL_FUNC) &R_igraph_layout_umap, 7}, + {"R_igraph_layout_umap_3d", (DL_FUNC) &R_igraph_layout_umap_3d, 7}, + {"R_igraph_layout_umap_compute_weights", (DL_FUNC) &R_igraph_layout_umap_compute_weights, 3}, + {"R_igraph_lcf_vector", (DL_FUNC) &R_igraph_lcf_vector, 3}, + {"R_igraph_le_community_to_membership", (DL_FUNC) &R_igraph_le_community_to_membership, 3}, + {"R_igraph_levc_arpack_multiplier", (DL_FUNC) &R_igraph_levc_arpack_multiplier, 3}, + {"R_igraph_linegraph", (DL_FUNC) &R_igraph_linegraph, 1}, + {"R_igraph_list_triangles", (DL_FUNC) &R_igraph_list_triangles, 1}, + {"R_igraph_local_efficiency", (DL_FUNC) &R_igraph_local_efficiency, 5}, + {"R_igraph_local_scan_0", (DL_FUNC) &R_igraph_local_scan_0, 3}, + {"R_igraph_local_scan_0_them", (DL_FUNC) &R_igraph_local_scan_0_them, 4}, + {"R_igraph_local_scan_1_ecount", (DL_FUNC) &R_igraph_local_scan_1_ecount, 3}, + {"R_igraph_local_scan_1_ecount_them", (DL_FUNC) &R_igraph_local_scan_1_ecount_them, 4}, + {"R_igraph_local_scan_k_ecount", (DL_FUNC) &R_igraph_local_scan_k_ecount, 4}, + {"R_igraph_local_scan_k_ecount_them", (DL_FUNC) &R_igraph_local_scan_k_ecount_them, 5}, + {"R_igraph_local_scan_neighborhood_ecount", (DL_FUNC) &R_igraph_local_scan_neighborhood_ecount, 3}, + {"R_igraph_local_scan_subset_ecount", (DL_FUNC) &R_igraph_local_scan_subset_ecount, 3}, + {"R_igraph_maxdegree", (DL_FUNC) &R_igraph_maxdegree, 4}, + {"R_igraph_maxflow", (DL_FUNC) &R_igraph_maxflow, 4}, + {"R_igraph_maxflow_value", (DL_FUNC) &R_igraph_maxflow_value, 4}, + {"R_igraph_maximal_cliques", (DL_FUNC) &R_igraph_maximal_cliques, 3}, + {"R_igraph_maximal_cliques_callback_closure", (DL_FUNC) &R_igraph_maximal_cliques_callback_closure, 4}, + {"R_igraph_maximal_cliques_count", (DL_FUNC) &R_igraph_maximal_cliques_count, 3}, + {"R_igraph_maximal_cliques_file", (DL_FUNC) &R_igraph_maximal_cliques_file, 4}, + {"R_igraph_maximal_cliques_hist", (DL_FUNC) &R_igraph_maximal_cliques_hist, 3}, + {"R_igraph_maximal_cliques_subset", (DL_FUNC) &R_igraph_maximal_cliques_subset, 5}, + {"R_igraph_maximal_independent_vertex_sets", (DL_FUNC) &R_igraph_maximal_independent_vertex_sets, 1}, + {"R_igraph_maximum_bipartite_matching", (DL_FUNC) &R_igraph_maximum_bipartite_matching, 4}, + {"R_igraph_maximum_cardinality_search", (DL_FUNC) &R_igraph_maximum_cardinality_search, 1}, + {"R_igraph_mean_degree", (DL_FUNC) &R_igraph_mean_degree, 2}, + {"R_igraph_mincut", (DL_FUNC) &R_igraph_mincut, 2}, + {"R_igraph_mincut_value", (DL_FUNC) &R_igraph_mincut_value, 2}, + {"R_igraph_minimum_cycle_basis", (DL_FUNC) &R_igraph_minimum_cycle_basis, 5}, + {"R_igraph_minimum_size_separators", (DL_FUNC) &R_igraph_minimum_size_separators, 1}, + {"R_igraph_minimum_spanning_tree", (DL_FUNC) &R_igraph_minimum_spanning_tree, 2}, + {"R_igraph_minimum_spanning_tree_prim", (DL_FUNC) &R_igraph_minimum_spanning_tree_prim, 2}, + {"R_igraph_minimum_spanning_tree_unweighted", (DL_FUNC) &R_igraph_minimum_spanning_tree_unweighted, 1}, + {"R_igraph_modularity", (DL_FUNC) &R_igraph_modularity, 5}, + {"R_igraph_modularity_matrix", (DL_FUNC) &R_igraph_modularity_matrix, 4}, + {"R_igraph_moran_process", (DL_FUNC) &R_igraph_moran_process, 5}, + {"R_igraph_motifs_randesu", (DL_FUNC) &R_igraph_motifs_randesu, 3}, + {"R_igraph_motifs_randesu_callback_closure", (DL_FUNC) &R_igraph_motifs_randesu_callback_closure, 4}, + {"R_igraph_motifs_randesu_estimate", (DL_FUNC) &R_igraph_motifs_randesu_estimate, 5}, + {"R_igraph_motifs_randesu_no", (DL_FUNC) &R_igraph_motifs_randesu_no, 3}, + {"R_igraph_mycielski_graph", (DL_FUNC) &R_igraph_mycielski_graph, 1}, + {"R_igraph_mycielskian", (DL_FUNC) &R_igraph_mycielskian, 2}, + {"R_igraph_neighborhood", (DL_FUNC) &R_igraph_neighborhood, 5}, + {"R_igraph_neighborhood_graphs", (DL_FUNC) &R_igraph_neighborhood_graphs, 5}, + {"R_igraph_neighborhood_size", (DL_FUNC) &R_igraph_neighborhood_size, 5}, + {"R_igraph_neighbors", (DL_FUNC) &R_igraph_neighbors, 3}, + {"R_igraph_pagerank", (DL_FUNC) &R_igraph_pagerank, 7}, + {"R_igraph_path_graph", (DL_FUNC) &R_igraph_path_graph, 3}, + {"R_igraph_path_length_hist", (DL_FUNC) &R_igraph_path_length_hist, 2}, + {"R_igraph_permute_vertices", (DL_FUNC) &R_igraph_permute_vertices, 2}, + {"R_igraph_personalized_pagerank", (DL_FUNC) &R_igraph_personalized_pagerank, 8}, + {"R_igraph_personalized_pagerank_vs", (DL_FUNC) &R_igraph_personalized_pagerank_vs, 8}, + {"R_igraph_power_law_fit", (DL_FUNC) &R_igraph_power_law_fit, 3}, + {"R_igraph_preference_game", (DL_FUNC) &R_igraph_preference_game, 7}, + {"R_igraph_product", (DL_FUNC) &R_igraph_product, 3}, + {"R_igraph_progress", (DL_FUNC) &R_igraph_progress, 2}, + {"R_igraph_pseudo_diameter", (DL_FUNC) &R_igraph_pseudo_diameter, 4}, + {"R_igraph_pseudo_diameter_dijkstra", (DL_FUNC) &R_igraph_pseudo_diameter_dijkstra, 5}, + {"R_igraph_radius", (DL_FUNC) &R_igraph_radius, 2}, + {"R_igraph_radius_dijkstra", (DL_FUNC) &R_igraph_radius_dijkstra, 3}, + {"R_igraph_random_edge_walk", (DL_FUNC) &R_igraph_random_edge_walk, 6}, + {"R_igraph_random_sample", (DL_FUNC) &R_igraph_random_sample, 3}, + {"R_igraph_random_spanning_tree", (DL_FUNC) &R_igraph_random_spanning_tree, 2}, + {"R_igraph_random_walk", (DL_FUNC) &R_igraph_random_walk, 6}, + {"R_igraph_read_graph_dimacs_flow", (DL_FUNC) &R_igraph_read_graph_dimacs_flow, 2}, + {"R_igraph_read_graph_dl", (DL_FUNC) &R_igraph_read_graph_dl, 2}, + {"R_igraph_read_graph_edgelist", (DL_FUNC) &R_igraph_read_graph_edgelist, 3}, + {"R_igraph_read_graph_gml", (DL_FUNC) &R_igraph_read_graph_gml, 1}, + {"R_igraph_read_graph_graphdb", (DL_FUNC) &R_igraph_read_graph_graphdb, 2}, + {"R_igraph_read_graph_graphml", (DL_FUNC) &R_igraph_read_graph_graphml, 2}, + {"R_igraph_read_graph_lgl", (DL_FUNC) &R_igraph_read_graph_lgl, 4}, + {"R_igraph_read_graph_ncol", (DL_FUNC) &R_igraph_read_graph_ncol, 5}, + {"R_igraph_read_graph_pajek", (DL_FUNC) &R_igraph_read_graph_pajek, 1}, + {"R_igraph_realize_bipartite_degree_sequence", (DL_FUNC) &R_igraph_realize_bipartite_degree_sequence, 4}, + {"R_igraph_realize_degree_sequence", (DL_FUNC) &R_igraph_realize_degree_sequence, 4}, + {"R_igraph_recent_degree_aging_game", (DL_FUNC) &R_igraph_recent_degree_aging_game, 10}, + {"R_igraph_recent_degree_game", (DL_FUNC) &R_igraph_recent_degree_game, 8}, + {"R_igraph_reciprocity", (DL_FUNC) &R_igraph_reciprocity, 3}, + {"R_igraph_regular_tree", (DL_FUNC) &R_igraph_regular_tree, 3}, + {"R_igraph_reindex_membership", (DL_FUNC) &R_igraph_reindex_membership, 1}, + {"R_igraph_residual_graph", (DL_FUNC) &R_igraph_residual_graph, 3}, + {"R_igraph_reverse_edges", (DL_FUNC) &R_igraph_reverse_edges, 2}, + {"R_igraph_reverse_residual_graph", (DL_FUNC) &R_igraph_reverse_residual_graph, 3}, + {"R_igraph_rewire", (DL_FUNC) &R_igraph_rewire, 3}, + {"R_igraph_rewire_directed_edges", (DL_FUNC) &R_igraph_rewire_directed_edges, 4}, + {"R_igraph_rewire_edges", (DL_FUNC) &R_igraph_rewire_edges, 4}, + {"R_igraph_rich_club_sequence", (DL_FUNC) &R_igraph_rich_club_sequence, 6}, + {"R_igraph_ring", (DL_FUNC) &R_igraph_ring, 4}, + {"R_igraph_rooted_product", (DL_FUNC) &R_igraph_rooted_product, 3}, + {"R_igraph_roots_for_tree_layout", (DL_FUNC) &R_igraph_roots_for_tree_layout, 3}, + {"R_igraph_roulette_wheel_imitation", (DL_FUNC) &R_igraph_roulette_wheel_imitation, 6}, + {"R_igraph_running_mean", (DL_FUNC) &R_igraph_running_mean, 2}, + {"R_igraph_sample_dirichlet", (DL_FUNC) &R_igraph_sample_dirichlet, 2}, + {"R_igraph_sample_sphere_surface", (DL_FUNC) &R_igraph_sample_sphere_surface, 4}, + {"R_igraph_sample_sphere_volume", (DL_FUNC) &R_igraph_sample_sphere_volume, 4}, + {"R_igraph_sbm_game", (DL_FUNC) &R_igraph_sbm_game, 5}, + {"R_igraph_similarity_dice", (DL_FUNC) &R_igraph_similarity_dice, 4}, + {"R_igraph_similarity_dice_es", (DL_FUNC) &R_igraph_similarity_dice_es, 4}, + {"R_igraph_similarity_dice_pairs", (DL_FUNC) &R_igraph_similarity_dice_pairs, 4}, + {"R_igraph_similarity_inverse_log_weighted", (DL_FUNC) &R_igraph_similarity_inverse_log_weighted, 3}, + {"R_igraph_similarity_jaccard", (DL_FUNC) &R_igraph_similarity_jaccard, 4}, + {"R_igraph_similarity_jaccard_es", (DL_FUNC) &R_igraph_similarity_jaccard_es, 4}, + {"R_igraph_similarity_jaccard_pairs", (DL_FUNC) &R_igraph_similarity_jaccard_pairs, 4}, + {"R_igraph_simple_cycles", (DL_FUNC) &R_igraph_simple_cycles, 4}, + {"R_igraph_simple_cycles_callback_closure", (DL_FUNC) &R_igraph_simple_cycles_callback_closure, 5}, + {"R_igraph_simple_interconnected_islands_game", (DL_FUNC) &R_igraph_simple_interconnected_islands_game, 4}, + {"R_igraph_simplify", (DL_FUNC) &R_igraph_simplify, 4}, + {"R_igraph_simplify_and_colorize", (DL_FUNC) &R_igraph_simplify_and_colorize, 1}, + {"R_igraph_sir", (DL_FUNC) &R_igraph_sir, 4}, + {"R_igraph_site_percolation", (DL_FUNC) &R_igraph_site_percolation, 2}, + {"R_igraph_solve_lsap", (DL_FUNC) &R_igraph_solve_lsap, 2}, + {"R_igraph_spanner", (DL_FUNC) &R_igraph_spanner, 3}, + {"R_igraph_sparse_adjacency", (DL_FUNC) &R_igraph_sparse_adjacency, 3}, + {"R_igraph_sparse_weighted_adjacency", (DL_FUNC) &R_igraph_sparse_weighted_adjacency, 3}, + {"R_igraph_split_join_distance", (DL_FUNC) &R_igraph_split_join_distance, 2}, + {"R_igraph_square_lattice", (DL_FUNC) &R_igraph_square_lattice, 5}, + {"R_igraph_st_edge_connectivity", (DL_FUNC) &R_igraph_st_edge_connectivity, 3}, + {"R_igraph_st_mincut", (DL_FUNC) &R_igraph_st_mincut, 4}, + {"R_igraph_st_mincut_value", (DL_FUNC) &R_igraph_st_mincut_value, 4}, + {"R_igraph_st_vertex_connectivity", (DL_FUNC) &R_igraph_st_vertex_connectivity, 4}, + {"R_igraph_star", (DL_FUNC) &R_igraph_star, 3}, + {"R_igraph_static_fitness_game", (DL_FUNC) &R_igraph_static_fitness_game, 5}, + {"R_igraph_static_power_law_game", (DL_FUNC) &R_igraph_static_power_law_game, 7}, + {"R_igraph_status", (DL_FUNC) &R_igraph_status, 1}, + {"R_igraph_stochastic_imitation", (DL_FUNC) &R_igraph_stochastic_imitation, 6}, + {"R_igraph_strength", (DL_FUNC) &R_igraph_strength, 5}, + {"R_igraph_strerror", (DL_FUNC) &R_igraph_strerror, 1}, + {"R_igraph_subcomponent", (DL_FUNC) &R_igraph_subcomponent, 3}, + {"R_igraph_subgraph_from_edges", (DL_FUNC) &R_igraph_subgraph_from_edges, 3}, + {"R_igraph_subisomorphic", (DL_FUNC) &R_igraph_subisomorphic, 2}, + {"R_igraph_subisomorphic_vf2", (DL_FUNC) &R_igraph_subisomorphic_vf2, 6}, + {"R_igraph_symmetric_tree", (DL_FUNC) &R_igraph_symmetric_tree, 2}, + {"R_igraph_to_directed", (DL_FUNC) &R_igraph_to_directed, 2}, + {"R_igraph_to_prufer", (DL_FUNC) &R_igraph_to_prufer, 1}, + {"R_igraph_to_undirected", (DL_FUNC) &R_igraph_to_undirected, 3}, + {"R_igraph_topological_sorting", (DL_FUNC) &R_igraph_topological_sorting, 2}, + {"R_igraph_transitive_closure", (DL_FUNC) &R_igraph_transitive_closure, 1}, + {"R_igraph_transitive_closure_dag", (DL_FUNC) &R_igraph_transitive_closure_dag, 1}, + {"R_igraph_transitivity_avglocal_undirected", (DL_FUNC) &R_igraph_transitivity_avglocal_undirected, 2}, + {"R_igraph_transitivity_barrat", (DL_FUNC) &R_igraph_transitivity_barrat, 4}, + {"R_igraph_transitivity_local_undirected", (DL_FUNC) &R_igraph_transitivity_local_undirected, 3}, + {"R_igraph_transitivity_undirected", (DL_FUNC) &R_igraph_transitivity_undirected, 2}, + {"R_igraph_tree_from_parent_vector", (DL_FUNC) &R_igraph_tree_from_parent_vector, 2}, + {"R_igraph_tree_game", (DL_FUNC) &R_igraph_tree_game, 3}, + {"R_igraph_triad_census", (DL_FUNC) &R_igraph_triad_census, 1}, + {"R_igraph_triangular_lattice", (DL_FUNC) &R_igraph_triangular_lattice, 3}, + {"R_igraph_trussness", (DL_FUNC) &R_igraph_trussness, 1}, + {"R_igraph_turan", (DL_FUNC) &R_igraph_turan, 2}, + {"R_igraph_unfold_tree", (DL_FUNC) &R_igraph_unfold_tree, 3}, + {"R_igraph_union", (DL_FUNC) &R_igraph_union, 2}, + {"R_igraph_union_many", (DL_FUNC) &R_igraph_union_many, 1}, + {"R_igraph_vcount", (DL_FUNC) &R_igraph_vcount, 1}, + {"R_igraph_version", (DL_FUNC) &R_igraph_version, 0}, + {"R_igraph_vertex_coloring_greedy", (DL_FUNC) &R_igraph_vertex_coloring_greedy, 2}, + {"R_igraph_vertex_connectivity", (DL_FUNC) &R_igraph_vertex_connectivity, 2}, + {"R_igraph_vertex_disjoint_paths", (DL_FUNC) &R_igraph_vertex_disjoint_paths, 3}, + {"R_igraph_vertex_path_from_edge_path", (DL_FUNC) &R_igraph_vertex_path_from_edge_path, 4}, + {"R_igraph_voronoi", (DL_FUNC) &R_igraph_voronoi, 5}, + {"R_igraph_watts_strogatz_game", (DL_FUNC) &R_igraph_watts_strogatz_game, 6}, + {"R_igraph_weighted_adjacency", (DL_FUNC) &R_igraph_weighted_adjacency, 3}, + {"R_igraph_weighted_clique_number", (DL_FUNC) &R_igraph_weighted_clique_number, 2}, + {"R_igraph_weighted_cliques", (DL_FUNC) &R_igraph_weighted_cliques, 5}, + {"R_igraph_weighted_sparsemat", (DL_FUNC) &R_igraph_weighted_sparsemat, 4}, + {"R_igraph_wheel", (DL_FUNC) &R_igraph_wheel, 3}, + {"R_igraph_widest_path_widths_dijkstra", (DL_FUNC) &R_igraph_widest_path_widths_dijkstra, 5}, + {"R_igraph_widest_path_widths_floyd_warshall", (DL_FUNC) &R_igraph_widest_path_widths_floyd_warshall, 5}, + {"R_igraph_write_graph_dimacs_flow", (DL_FUNC) &R_igraph_write_graph_dimacs_flow, 5}, + {"R_igraph_write_graph_dot", (DL_FUNC) &R_igraph_write_graph_dot, 2}, + {"R_igraph_write_graph_edgelist", (DL_FUNC) &R_igraph_write_graph_edgelist, 2}, + {"R_igraph_write_graph_gml", (DL_FUNC) &R_igraph_write_graph_gml, 5}, + {"R_igraph_write_graph_graphml", (DL_FUNC) &R_igraph_write_graph_graphml, 3}, + {"R_igraph_write_graph_leda", (DL_FUNC) &R_igraph_write_graph_leda, 4}, + {"R_igraph_write_graph_lgl", (DL_FUNC) &R_igraph_write_graph_lgl, 5}, + {"R_igraph_write_graph_ncol", (DL_FUNC) &R_igraph_write_graph_ncol, 4}, + {"R_igraph_write_graph_pajek", (DL_FUNC) &R_igraph_write_graph_pajek, 2}, + {"Rx_igraph_add_edges_manual", (DL_FUNC) &Rx_igraph_add_edges_manual, 2}, + {"Rx_igraph_add_env", (DL_FUNC) &Rx_igraph_add_env, 1}, + {"Rx_igraph_add_myid_to_env", (DL_FUNC) &Rx_igraph_add_myid_to_env, 1}, + {"Rx_igraph_add_version_to_env", (DL_FUNC) &Rx_igraph_add_version_to_env, 1}, + {"Rx_igraph_address", (DL_FUNC) &Rx_igraph_address, 1}, + {"Rx_igraph_adjacent_vertices", (DL_FUNC) &Rx_igraph_adjacent_vertices, 3}, + {"Rx_igraph_arpack", (DL_FUNC) &Rx_igraph_arpack, 5}, + {"Rx_igraph_arpack_unpack_complex", (DL_FUNC) &Rx_igraph_arpack_unpack_complex, 3}, + {"Rx_igraph_barabasi_aging_game", (DL_FUNC) &Rx_igraph_barabasi_aging_game, 12}, + {"Rx_igraph_barabasi_game", (DL_FUNC) &Rx_igraph_barabasi_game, 9}, + {"Rx_igraph_bfs", (DL_FUNC) &Rx_igraph_bfs, 15}, + {"Rx_igraph_bipartite_projection", (DL_FUNC) &Rx_igraph_bipartite_projection, 4}, + {"Rx_igraph_callaway_traits_game", (DL_FUNC) &Rx_igraph_callaway_traits_game, 6}, + {"Rx_igraph_cited_type_game", (DL_FUNC) &Rx_igraph_cited_type_game, 5}, + {"Rx_igraph_citing_cited_type_game", (DL_FUNC) &Rx_igraph_citing_cited_type_game, 5}, + {"Rx_igraph_community_edge_betweenness", (DL_FUNC) &Rx_igraph_community_edge_betweenness, 8}, + {"Rx_igraph_community_fastgreedy", (DL_FUNC) &Rx_igraph_community_fastgreedy, 5}, + {"Rx_igraph_community_to_membership2", (DL_FUNC) &Rx_igraph_community_to_membership2, 3}, + {"Rx_igraph_compose", (DL_FUNC) &Rx_igraph_compose, 3}, + {"Rx_igraph_connect_neighborhood", (DL_FUNC) &Rx_igraph_connect_neighborhood, 3}, + {"Rx_igraph_copy_env", (DL_FUNC) &Rx_igraph_copy_env, 1}, + {"Rx_igraph_copy_from", (DL_FUNC) &Rx_igraph_copy_from, 1}, + {"Rx_igraph_copy_to", (DL_FUNC) &Rx_igraph_copy_to, 1}, + {"Rx_igraph_create", (DL_FUNC) &Rx_igraph_create, 3}, + {"Rx_igraph_decompose", (DL_FUNC) &Rx_igraph_decompose, 4}, + {"Rx_igraph_degree_sequence_game", (DL_FUNC) &Rx_igraph_degree_sequence_game, 3}, + {"Rx_igraph_dfs", (DL_FUNC) &Rx_igraph_dfs, 12}, + {"Rx_igraph_diameter", (DL_FUNC) &Rx_igraph_diameter, 4}, + {"Rx_igraph_disjoint_union", (DL_FUNC) &Rx_igraph_disjoint_union, 1}, + {"Rx_igraph_edge_disjoint_paths", (DL_FUNC) &Rx_igraph_edge_disjoint_paths, 3}, + {"Rx_igraph_es_adj", (DL_FUNC) &Rx_igraph_es_adj, 4}, + {"Rx_igraph_es_pairs", (DL_FUNC) &Rx_igraph_es_pairs, 3}, + {"Rx_igraph_es_path", (DL_FUNC) &Rx_igraph_es_path, 3}, + {"Rx_igraph_establishment_game", (DL_FUNC) &Rx_igraph_establishment_game, 6}, + {"Rx_igraph_farthest_points", (DL_FUNC) &Rx_igraph_farthest_points, 4}, + {"Rx_igraph_finalizer", (DL_FUNC) &Rx_igraph_finalizer, 0}, + {"Rx_igraph_full", (DL_FUNC) &Rx_igraph_full, 3}, + {"Rx_igraph_get_adjacency", (DL_FUNC) &Rx_igraph_get_adjacency, 4}, + {"Rx_igraph_get_adjedgelist", (DL_FUNC) &Rx_igraph_get_adjedgelist, 3}, + {"Rx_igraph_get_adjlist", (DL_FUNC) &Rx_igraph_get_adjlist, 4}, + {"Rx_igraph_get_all_simple_paths_pp", (DL_FUNC) &Rx_igraph_get_all_simple_paths_pp, 1}, + {"Rx_igraph_get_attr_mode", (DL_FUNC) &Rx_igraph_get_attr_mode, 2}, + {"Rx_igraph_get_diameter", (DL_FUNC) &Rx_igraph_get_diameter, 4}, + {"Rx_igraph_get_eids", (DL_FUNC) &Rx_igraph_get_eids, 4}, + {"Rx_igraph_get_graph_id", (DL_FUNC) &Rx_igraph_get_graph_id, 1}, + {"Rx_igraph_get_shortest_paths", (DL_FUNC) &Rx_igraph_get_shortest_paths, 10}, + {"Rx_igraph_girth", (DL_FUNC) &Rx_igraph_girth, 2}, + {"Rx_igraph_graph_version", (DL_FUNC) &Rx_igraph_graph_version, 1}, + {"Rx_igraph_grg_game", (DL_FUNC) &Rx_igraph_grg_game, 4}, + {"Rx_igraph_identical_graphs", (DL_FUNC) &Rx_igraph_identical_graphs, 3}, + {"Rx_igraph_incident_edges", (DL_FUNC) &Rx_igraph_incident_edges, 3}, + {"Rx_igraph_independent_vertex_sets", (DL_FUNC) &Rx_igraph_independent_vertex_sets, 3}, + {"Rx_igraph_intersection", (DL_FUNC) &Rx_igraph_intersection, 2}, + {"Rx_igraph_is_chordal", (DL_FUNC) &Rx_igraph_is_chordal, 5}, + {"Rx_igraph_kary_tree", (DL_FUNC) &Rx_igraph_kary_tree, 3}, + {"Rx_igraph_lastcit_game", (DL_FUNC) &Rx_igraph_lastcit_game, 5}, + {"Rx_igraph_layout_drl", (DL_FUNC) &Rx_igraph_layout_drl, 5}, + {"Rx_igraph_layout_drl_3d", (DL_FUNC) &Rx_igraph_layout_drl_3d, 5}, + {"Rx_igraph_layout_fruchterman_reingold", (DL_FUNC) &Rx_igraph_layout_fruchterman_reingold, 10}, + {"Rx_igraph_layout_fruchterman_reingold_3d", (DL_FUNC) &Rx_igraph_layout_fruchterman_reingold_3d, 11}, + {"Rx_igraph_layout_graphopt", (DL_FUNC) &Rx_igraph_layout_graphopt, 8}, + {"Rx_igraph_layout_kamada_kawai", (DL_FUNC) &Rx_igraph_layout_kamada_kawai, 10}, + {"Rx_igraph_layout_kamada_kawai_3d", (DL_FUNC) &Rx_igraph_layout_kamada_kawai_3d, 12}, + {"Rx_igraph_layout_lgl", (DL_FUNC) &Rx_igraph_layout_lgl, 8}, + {"Rx_igraph_layout_merge_dla", (DL_FUNC) &Rx_igraph_layout_merge_dla, 2}, + {"Rx_igraph_layout_reingold_tilford", (DL_FUNC) &Rx_igraph_layout_reingold_tilford, 5}, + {"Rx_igraph_make_weak_ref", (DL_FUNC) &Rx_igraph_make_weak_ref, 3}, + {"Rx_igraph_maximal_cliques", (DL_FUNC) &Rx_igraph_maximal_cliques, 4}, + {"Rx_igraph_maximal_cliques_count", (DL_FUNC) &Rx_igraph_maximal_cliques_count, 4}, + {"Rx_igraph_maximal_cliques_file", (DL_FUNC) &Rx_igraph_maximal_cliques_file, 5}, + {"Rx_igraph_mybracket2", (DL_FUNC) &Rx_igraph_mybracket2, 3}, + {"Rx_igraph_mybracket2_copy", (DL_FUNC) &Rx_igraph_mybracket2_copy, 3}, + {"Rx_igraph_mybracket2_names", (DL_FUNC) &Rx_igraph_mybracket2_names, 3}, + {"Rx_igraph_mybracket2_set", (DL_FUNC) &Rx_igraph_mybracket2_set, 4}, + {"Rx_igraph_mybracket3_set", (DL_FUNC) &Rx_igraph_mybracket3_set, 5}, + {"Rx_igraph_neighborhood", (DL_FUNC) &Rx_igraph_neighborhood, 5}, + {"Rx_igraph_neighborhood_graphs", (DL_FUNC) &Rx_igraph_neighborhood_graphs, 5}, + {"Rx_igraph_neighborhood_size", (DL_FUNC) &Rx_igraph_neighborhood_size, 5}, + {"Rx_igraph_no_components", (DL_FUNC) &Rx_igraph_no_components, 2}, + {"Rx_igraph_power_law_fit_new", (DL_FUNC) &Rx_igraph_power_law_fit_new, 5}, + {"Rx_igraph_random_sample", (DL_FUNC) &Rx_igraph_random_sample, 3}, + {"Rx_igraph_read_graph_dimacs", (DL_FUNC) &Rx_igraph_read_graph_dimacs, 2}, + {"Rx_igraph_read_graph_edgelist", (DL_FUNC) &Rx_igraph_read_graph_edgelist, 3}, + {"Rx_igraph_read_graph_lgl", (DL_FUNC) &Rx_igraph_read_graph_lgl, 4}, + {"Rx_igraph_read_graph_ncol", (DL_FUNC) &Rx_igraph_read_graph_ncol, 5}, + {"Rx_igraph_recent_degree_aging_game", (DL_FUNC) &Rx_igraph_recent_degree_aging_game, 10}, + {"Rx_igraph_ring", (DL_FUNC) &Rx_igraph_ring, 4}, + {"Rx_igraph_set_verbose", (DL_FUNC) &Rx_igraph_set_verbose, 1}, + {"Rx_igraph_shortest_paths", (DL_FUNC) &Rx_igraph_shortest_paths, 6}, + {"Rx_igraph_spinglass_community", (DL_FUNC) &Rx_igraph_spinglass_community, 11}, + {"Rx_igraph_spinglass_my_community", (DL_FUNC) &Rx_igraph_spinglass_my_community, 6}, + {"Rx_igraph_st_edge_connectivity", (DL_FUNC) &Rx_igraph_st_edge_connectivity, 3}, + {"Rx_igraph_st_mincut_value", (DL_FUNC) &Rx_igraph_st_mincut_value, 4}, + {"Rx_igraph_st_vertex_connectivity", (DL_FUNC) &Rx_igraph_st_vertex_connectivity, 3}, + {"Rx_igraph_star", (DL_FUNC) &Rx_igraph_star, 3}, + {"Rx_igraph_subcomponent", (DL_FUNC) &Rx_igraph_subcomponent, 3}, + {"Rx_igraph_subisomorphic_lad", (DL_FUNC) &Rx_igraph_subisomorphic_lad, 7}, + {"Rx_igraph_test_error_with_source", (DL_FUNC) &Rx_igraph_test_error_with_source, 0}, + {"Rx_igraph_transitivity_local_undirected_all", (DL_FUNC) &Rx_igraph_transitivity_local_undirected_all, 2}, + {"Rx_igraph_union", (DL_FUNC) &Rx_igraph_union, 2}, + {"Rx_igraph_vcount", (DL_FUNC) &Rx_igraph_vcount, 1}, + {"Rx_igraph_vertex_disjoint_paths", (DL_FUNC) &Rx_igraph_vertex_disjoint_paths, 3}, + {"Rx_igraph_vs_adj", (DL_FUNC) &Rx_igraph_vs_adj, 4}, + {"Rx_igraph_vs_nei", (DL_FUNC) &Rx_igraph_vs_nei, 4}, + {"Rx_igraph_walktrap_community", (DL_FUNC) &Rx_igraph_walktrap_community, 6}, + {"Rx_igraph_watts_strogatz_game", (DL_FUNC) &Rx_igraph_watts_strogatz_game, 6}, + {"Rx_igraph_weak_ref_key", (DL_FUNC) &Rx_igraph_weak_ref_key, 1}, + {"Rx_igraph_weak_ref_run_finalizer", (DL_FUNC) &Rx_igraph_weak_ref_run_finalizer, 1}, + {"Rx_igraph_weak_ref_value", (DL_FUNC) &Rx_igraph_weak_ref_value, 1}, + {"Rx_igraph_write_graph_dimacs", (DL_FUNC) &Rx_igraph_write_graph_dimacs, 5}, + {"Rx_igraph_write_graph_lgl", (DL_FUNC) &Rx_igraph_write_graph_lgl, 5}, + {"Rx_igraph_write_graph_ncol", (DL_FUNC) &Rx_igraph_write_graph_ncol, 4}, + {"UUID_gen", (DL_FUNC) &UUID_gen, 1}, + {"_igraph_getsphere", (DL_FUNC) &_igraph_getsphere, 7}, + {"_igraph_igraph_hcass2", (DL_FUNC) &_igraph_igraph_hcass2, 3}, {NULL, NULL, 0} }; } diff --git a/src/rcallback.c b/src/rcallback.c index 9921dc86407..71041bcfb6f 100644 --- a/src/rcallback.c +++ b/src/rcallback.c @@ -280,3 +280,122 @@ igraph_error_t igraph_get_subisomorphisms_vf2_callback_closure( R_igraph_isomorphism_handler, NULL, NULL, &data); } + +/* Leading eigenvector community detection callback support */ + +/* Structure to hold ARPACK function pointer */ +typedef struct { + igraph_arpack_function_t *fun; +} R_igraph_arpack_function_container_t; + +/* Extended callback data structure for leading eigenvector */ +typedef struct { + SEXP callback; + SEXP extra; + SEXP env; + SEXP env_arp; +} R_igraph_levc_callback_data_t; + +/* Helper function to call ARPACK multiplier from R - exported for use from R */ +SEXP R_igraph_levc_arpack_multiplier(SEXP extP, SEXP extE, SEXP pv) { + R_igraph_arpack_function_container_t *cont = R_ExternalPtrAddr(extP); + igraph_arpack_function_t *fun = cont->fun; + void *extra = R_ExternalPtrAddr(extE); + SEXP res; + + PROTECT(res = NEW_NUMERIC(Rf_xlength(pv))); + fun(REAL(res), REAL(pv), Rf_xlength(pv), extra); + + UNPROTECT(1); + return res; +} + +/* Handler for leading eigenvector callbacks - converts C types to R types */ +igraph_error_t R_igraph_levc_handler( + const igraph_vector_int_t *membership, + igraph_integer_t comm, + igraph_real_t eigenvalue, + const igraph_vector_t *eigenvector, + igraph_arpack_function_t *arpack_multiplier, + void *arpack_extra, + void *extra) { + + R_igraph_levc_callback_data_t *data = (R_igraph_levc_callback_data_t *)extra; + SEXP callback = data->callback; + SEXP s_memb, s_comm, s_evalue, s_evector, s_multip; + SEXP R_fcall, R_multip_call; + SEXP res, l1, l2, l3; + int result; + R_igraph_arpack_function_container_t cont = { arpack_multiplier }; + + /* Convert C types to R types */ + PROTECT(s_memb = Ry_igraph_vector_int_to_SEXP(membership)); + PROTECT(s_comm = NEW_NUMERIC(1)); + REAL(s_comm)[0] = comm; + PROTECT(s_evalue = NEW_NUMERIC(1)); + REAL(s_evalue)[0] = eigenvalue; + PROTECT(s_evector = Ry_igraph_vector_to_SEXP(eigenvector)); + + /* Create the ARPACK multiplier function accessible from R */ + PROTECT(l1 = Rf_install("igraph.i.levc.arp")); + PROTECT(l2 = R_MakeExternalPtr((void*)&cont, R_NilValue, R_NilValue)); + PROTECT(l3 = R_MakeExternalPtr(arpack_extra, R_NilValue, R_NilValue)); + PROTECT(R_multip_call = Rf_lang3(l1, l2, l3)); + PROTECT(s_multip = Rf_eval(R_multip_call, data->env_arp)); + + /* Build the call: callback(membership, community, value, vector, multiplier, extra) */ + PROTECT(R_fcall = Rx_igraph_i_lang7(callback, s_memb, s_comm, s_evalue, s_evector, s_multip, data->extra)); + PROTECT(res = Rf_eval(R_fcall, data->env)); + + /* Check if result is an error condition (from tryCatch) */ + if (Rf_inherits(res, "error")) { + UNPROTECT(11); + igraph_error("Error in R callback function", __FILE__, __LINE__, IGRAPH_FAILURE); + return IGRAPH_FAILURE; + } + + result = (int) REAL(AS_NUMERIC(res))[0]; + + UNPROTECT(11); + return result; +} + +/* Closure function for leading eigenvector community detection */ +igraph_error_t igraph_community_leading_eigenvector_callback_closure( + const igraph_t *graph, + const igraph_vector_t *weights, + igraph_matrix_int_t *merges, + igraph_vector_int_t *membership, + igraph_integer_t steps, + igraph_arpack_options_t *options, + igraph_real_t *modularity, + igraph_bool_t start, + igraph_vector_t *eigenvalues, + igraph_vector_list_t *eigenvectors, + igraph_vector_t *history, + SEXP callback, + SEXP extra, + SEXP env, + SEXP env_arp) { + + /* If callback is NULL, pass NULL to the C function */ + if (Rf_isNull(callback)) { + return igraph_community_leading_eigenvector( + graph, weights, merges, membership, steps, options, modularity, start, + eigenvalues, eigenvectors, history, + NULL, NULL); + } + + /* Otherwise, use the handler */ + R_igraph_levc_callback_data_t data = { + .callback = callback, + .extra = extra ? extra : R_NilValue, /* Convert NULL to R_NilValue */ + .env = env, + .env_arp = env_arp + }; + + return igraph_community_leading_eigenvector( + graph, weights, merges, membership, steps, options, modularity, start, + eigenvalues, eigenvectors, history, + R_igraph_levc_handler, &data); +} diff --git a/src/rinterface.c b/src/rinterface.c index c276088ad3d..0afdc23675c 100644 --- a/src/rinterface.c +++ b/src/rinterface.c @@ -12323,101 +12323,6 @@ SEXP R_igraph_reindex_membership(SEXP membership) { return(r_result); } -/*-------------------------------------------/ -/ igraph_community_leading_eigenvector / -/-------------------------------------------*/ -SEXP R_igraph_community_leading_eigenvector(SEXP graph, SEXP weights, SEXP membership, SEXP steps, SEXP options, SEXP start) { - /* Declarations */ - igraph_t c_graph; - igraph_vector_t c_weights; - igraph_matrix_int_t c_merges; - igraph_vector_int_t c_membership; - igraph_integer_t c_steps; - igraph_arpack_options_t c_options; - igraph_real_t c_modularity; - igraph_bool_t c_start; - igraph_vector_t c_eigenvalues; - igraph_vector_list_t c_eigenvectors; - igraph_vector_t c_history; - - - SEXP merges; - SEXP modularity; - SEXP eigenvalues; - SEXP eigenvectors; - SEXP history; - - SEXP r_result, r_names; - /* Convert input */ - Rz_SEXP_to_igraph(graph, &c_graph); - if (!Rf_isNull(weights)) { - Rz_SEXP_to_vector(weights, &c_weights); - } - IGRAPH_R_CHECK(igraph_matrix_int_init(&c_merges, 0, 0)); - IGRAPH_FINALLY(igraph_matrix_int_destroy, &c_merges); - if (!Rf_isNull(membership)) { - IGRAPH_R_CHECK(Rz_SEXP_to_vector_int_copy(membership, &c_membership)); - IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); - } else { - IGRAPH_R_CHECK(igraph_vector_int_init(&c_membership, 0)); - IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); - } - IGRAPH_R_CHECK_INT(steps); - c_steps = (igraph_integer_t) REAL(steps)[0]; - Rz_SEXP_to_igraph_arpack_options(options, &c_options); - IGRAPH_R_CHECK_BOOL(start); - c_start = LOGICAL(start)[0]; - IGRAPH_R_CHECK(igraph_vector_init(&c_eigenvalues, 0)); - IGRAPH_FINALLY(igraph_vector_destroy, &c_eigenvalues); - IGRAPH_R_CHECK(igraph_vector_list_init(&c_eigenvectors, 0)); - IGRAPH_FINALLY(igraph_vector_list_destroy, &c_eigenvectors); - IGRAPH_R_CHECK(igraph_vector_init(&c_history, 0)); - IGRAPH_FINALLY(igraph_vector_destroy, &c_history); - /* Call igraph */ - IGRAPH_R_CHECK(igraph_community_leading_eigenvector(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_merges, &c_membership, c_steps, &c_options, &c_modularity, c_start, &c_eigenvalues, &c_eigenvectors, &c_history, 0, 0)); - - /* Convert output */ - PROTECT(r_result=NEW_LIST(7)); - PROTECT(r_names=NEW_CHARACTER(7)); - PROTECT(merges=Ry_igraph_matrix_int_to_SEXP(&c_merges)); - igraph_matrix_int_destroy(&c_merges); - IGRAPH_FINALLY_CLEAN(1); - PROTECT(membership=Ry_igraph_vector_int_to_SEXP(&c_membership)); - igraph_vector_int_destroy(&c_membership); - IGRAPH_FINALLY_CLEAN(1); - PROTECT(options=Ry_igraph_arpack_options_to_SEXP(&c_options)); - PROTECT(modularity=NEW_NUMERIC(1)); - REAL(modularity)[0]=c_modularity; - PROTECT(eigenvalues=Ry_igraph_vector_to_SEXP(&c_eigenvalues)); - igraph_vector_destroy(&c_eigenvalues); - IGRAPH_FINALLY_CLEAN(1); - PROTECT(eigenvectors=Rx_igraph_vector_list_to_SEXP(&c_eigenvectors)); - igraph_vector_list_destroy(&c_eigenvectors); - IGRAPH_FINALLY_CLEAN(1); - PROTECT(history=Ry_igraph_vector_to_SEXP(&c_history)); - igraph_vector_destroy(&c_history); - IGRAPH_FINALLY_CLEAN(1); - SET_VECTOR_ELT(r_result, 0, merges); - SET_VECTOR_ELT(r_result, 1, membership); - SET_VECTOR_ELT(r_result, 2, options); - SET_VECTOR_ELT(r_result, 3, modularity); - SET_VECTOR_ELT(r_result, 4, eigenvalues); - SET_VECTOR_ELT(r_result, 5, eigenvectors); - SET_VECTOR_ELT(r_result, 6, history); - SET_STRING_ELT(r_names, 0, Rf_mkChar("merges")); - SET_STRING_ELT(r_names, 1, Rf_mkChar("membership")); - SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); - SET_STRING_ELT(r_names, 3, Rf_mkChar("modularity")); - SET_STRING_ELT(r_names, 4, Rf_mkChar("eigenvalues")); - SET_STRING_ELT(r_names, 5, Rf_mkChar("eigenvectors")); - SET_STRING_ELT(r_names, 6, Rf_mkChar("history")); - SET_NAMES(r_result, r_names); - UNPROTECT(8); - - UNPROTECT(1); - return(r_result); -} - /*-------------------------------------------/ / igraph_community_fluid_communities / /-------------------------------------------*/ @@ -18889,6 +18794,103 @@ SEXP R_igraph_maximal_cliques_callback_closure(SEXP graph, SEXP min_size, SEXP m return(R_NilValue); } +/*-------------------------------------------/ +/ igraph_community_leading_eigenvector_callback_closure / +/-------------------------------------------*/ +SEXP R_igraph_community_leading_eigenvector_callback_closure(SEXP graph, SEXP weights, SEXP membership, SEXP steps, SEXP options, SEXP start, SEXP callback, SEXP extra, SEXP env, SEXP env_arp) { + /* Declarations */ + igraph_t c_graph; + igraph_vector_t c_weights; + igraph_matrix_int_t c_merges; + igraph_vector_int_t c_membership; + igraph_integer_t c_steps; + igraph_arpack_options_t c_options; + igraph_real_t c_modularity; + igraph_bool_t c_start; + igraph_vector_t c_eigenvalues; + igraph_vector_list_t c_eigenvectors; + igraph_vector_t c_history; + + + + + SEXP merges; + SEXP modularity; + SEXP eigenvalues; + SEXP eigenvectors; + SEXP history; + + SEXP r_result, r_names; + /* Convert input */ + Rz_SEXP_to_igraph(graph, &c_graph); + if (!Rf_isNull(weights)) { + Rz_SEXP_to_vector(weights, &c_weights); + } + IGRAPH_R_CHECK(igraph_matrix_int_init(&c_merges, 0, 0)); + IGRAPH_FINALLY(igraph_matrix_int_destroy, &c_merges); + if (!Rf_isNull(membership)) { + IGRAPH_R_CHECK(Rz_SEXP_to_vector_int_copy(membership, &c_membership)); + IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); + } else { + IGRAPH_R_CHECK(igraph_vector_int_init(&c_membership, 0)); + IGRAPH_FINALLY(igraph_vector_int_destroy, &c_membership); + } + IGRAPH_R_CHECK_INT(steps); + c_steps = (igraph_integer_t) REAL(steps)[0]; + Rz_SEXP_to_igraph_arpack_options(options, &c_options); + IGRAPH_R_CHECK_BOOL(start); + c_start = LOGICAL(start)[0]; + IGRAPH_R_CHECK(igraph_vector_init(&c_eigenvalues, 0)); + IGRAPH_FINALLY(igraph_vector_destroy, &c_eigenvalues); + IGRAPH_R_CHECK(igraph_vector_list_init(&c_eigenvectors, 0)); + IGRAPH_FINALLY(igraph_vector_list_destroy, &c_eigenvectors); + IGRAPH_R_CHECK(igraph_vector_init(&c_history, 0)); + IGRAPH_FINALLY(igraph_vector_destroy, &c_history); + /* Call igraph */ + IGRAPH_R_CHECK(igraph_community_leading_eigenvector_callback_closure(&c_graph, (Rf_isNull(weights) ? 0 : &c_weights), &c_merges, &c_membership, c_steps, &c_options, &c_modularity, c_start, &c_eigenvalues, &c_eigenvectors, &c_history, callback, extra, env, env_arp)); + + /* Convert output */ + PROTECT(r_result=NEW_LIST(7)); + PROTECT(r_names=NEW_CHARACTER(7)); + PROTECT(merges=Ry_igraph_matrix_int_to_SEXP(&c_merges)); + igraph_matrix_int_destroy(&c_merges); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(membership=Ry_igraph_vector_int_to_SEXP(&c_membership)); + igraph_vector_int_destroy(&c_membership); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(options=Ry_igraph_arpack_options_to_SEXP(&c_options)); + PROTECT(modularity=NEW_NUMERIC(1)); + REAL(modularity)[0]=c_modularity; + PROTECT(eigenvalues=Ry_igraph_vector_to_SEXP(&c_eigenvalues)); + igraph_vector_destroy(&c_eigenvalues); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(eigenvectors=Rx_igraph_vector_list_to_SEXP(&c_eigenvectors)); + igraph_vector_list_destroy(&c_eigenvectors); + IGRAPH_FINALLY_CLEAN(1); + PROTECT(history=Ry_igraph_vector_to_SEXP(&c_history)); + igraph_vector_destroy(&c_history); + IGRAPH_FINALLY_CLEAN(1); + SET_VECTOR_ELT(r_result, 0, merges); + SET_VECTOR_ELT(r_result, 1, membership); + SET_VECTOR_ELT(r_result, 2, options); + SET_VECTOR_ELT(r_result, 3, modularity); + SET_VECTOR_ELT(r_result, 4, eigenvalues); + SET_VECTOR_ELT(r_result, 5, eigenvectors); + SET_VECTOR_ELT(r_result, 6, history); + SET_STRING_ELT(r_names, 0, Rf_mkChar("merges")); + SET_STRING_ELT(r_names, 1, Rf_mkChar("membership")); + SET_STRING_ELT(r_names, 2, Rf_mkChar("options")); + SET_STRING_ELT(r_names, 3, Rf_mkChar("modularity")); + SET_STRING_ELT(r_names, 4, Rf_mkChar("eigenvalues")); + SET_STRING_ELT(r_names, 5, Rf_mkChar("eigenvectors")); + SET_STRING_ELT(r_names, 6, Rf_mkChar("history")); + SET_NAMES(r_result, r_names); + UNPROTECT(8); + + UNPROTECT(1); + return(r_result); +} + /*-------------------------------------------/ / igraph_get_isomorphisms_vf2_callback_closure / /-------------------------------------------*/ diff --git a/src/rinterface.h b/src/rinterface.h index 6941e4cad4e..852a6ae48ae 100644 --- a/src/rinterface.h +++ b/src/rinterface.h @@ -230,3 +230,32 @@ igraph_error_t igraph_get_subisomorphisms_vf2_callback_closure( const igraph_vector_int_t *edge_color1, const igraph_vector_int_t *edge_color2, SEXP callback); + +/* Leading eigenvector community detection */ +SEXP R_igraph_levc_arpack_multiplier(SEXP extP, SEXP extE, SEXP pv); + +igraph_error_t R_igraph_levc_handler( + const igraph_vector_int_t *membership, + igraph_integer_t comm, + igraph_real_t eigenvalue, + const igraph_vector_t *eigenvector, + igraph_arpack_function_t *arpack_multiplier, + void *arpack_extra, + void *extra); + +igraph_error_t igraph_community_leading_eigenvector_callback_closure( + const igraph_t *graph, + const igraph_vector_t *weights, + igraph_matrix_int_t *merges, + igraph_vector_int_t *membership, + igraph_integer_t steps, + igraph_arpack_options_t *options, + igraph_real_t *modularity, + igraph_bool_t start, + igraph_vector_t *eigenvalues, + igraph_vector_list_t *eigenvectors, + igraph_vector_t *history, + SEXP callback, + SEXP extra, + SEXP env, + SEXP env_arp); diff --git a/tests/testthat/test-community.R b/tests/testthat/test-community.R index ed8f5f19ef8..be11c33e03b 100644 --- a/tests/testthat/test-community.R +++ b/tests/testthat/test-community.R @@ -236,22 +236,17 @@ test_that("cluster_leading_eigen works", { ) }) -test_that("cluster_leading_eigen callback deprecated", { +test_that("cluster_leading_eigen callback works", { withr::local_seed(20230115) karate <- make_graph("Zachary") - # Test that callback parameter is deprecated - expect_error( - cluster_leading_eigen(karate, callback = function(...) 0), - class = "lifecycle_error_deprecated" - ) + # Test with a simple callback that always returns 0 (continue) + karate_lc <- cluster_leading_eigen(karate, callback = function(...) 0) - # Test that extra parameter is deprecated - expect_error( - cluster_leading_eigen(karate, extra = "test"), - class = "lifecycle_error_deprecated" - ) + # Should still get valid results + expect_equal(karate_lc$modularity, modularity(karate, karate_lc$membership)) + expect_length(karate_lc$membership, vcount(karate)) }) test_that("cluster_leading_eigen is deterministic", { ## Stress-test. We skip this on R 3.4 and 3.5 because it seems like diff --git a/tools/stimulus/functions-R.yaml b/tools/stimulus/functions-R.yaml index cc13f36acc0..aa06589a2ae 100644 --- a/tools/stimulus/functions-R.yaml +++ b/tools/stimulus/functions-R.yaml @@ -657,6 +657,10 @@ igraph_le_community_to_membership: igraph_reindex_membership: igraph_community_leading_eigenvector: + # Has callback parameter - use manual wrapper + IGNORE: RR, RC, RInit + +igraph_community_leading_eigenvector_callback_closure: PARAMS: |- GRAPH graph, OPTIONAL EDGEWEIGHTS weights, OPTIONAL OUT MATRIX_INT merges, OPTIONAL INOUT VECTOR_INT membership, @@ -666,8 +670,10 @@ igraph_community_leading_eigenvector: OPTIONAL OUT VECTOR eigenvalues, OPTIONAL OUT VECTOR_LIST eigenvectors, OPTIONAL OUT VECTOR history, - OPTIONAL NULL callback, - OPTIONAL NULL callback_extra + CLOSURE callback=NULL, + CLOSURE_EXTRA extra=NULL, + CLOSURE_ENV env=parent.frame(), + CLOSURE_ENV_ARP env_arp=environment(igraph.i.levc.arp) DEPS: weights ON graph, membership ON graph R: CLASS: igraph.eigenc diff --git a/tools/stimulus/types-RC.yaml b/tools/stimulus/types-RC.yaml index 67f597530c8..07a2db93200 100644 --- a/tools/stimulus/types-RC.yaml +++ b/tools/stimulus/types-RC.yaml @@ -625,6 +625,21 @@ CLOSURE: CTYPE: ~ HEADER: '%I%' +CLOSURE_EXTRA: + CALL: '%I%' + CTYPE: ~ + HEADER: '%I%' + +CLOSURE_ENV: + CALL: '%I%' + CTYPE: ~ + HEADER: '%I%' + +CLOSURE_ENV_ARP: + CALL: '%I%' + CTYPE: ~ + HEADER: '%I%' + ISOCOMPAT_FUNC: CALL: '0' CTYPE: ~ diff --git a/tools/stimulus/types-RR.yaml b/tools/stimulus/types-RR.yaml index 628d59afb30..7dc36ffbe81 100644 --- a/tools/stimulus/types-RR.yaml +++ b/tools/stimulus/types-RR.yaml @@ -380,16 +380,32 @@ EXTRA: CLOSURE: CALL: '%I%_wrapped' INCONV: | - if (!is.function(%I%)) { - cli::cli_abort("{.arg callback} must be a function") - } - %I%_wrapped <- function(...) { - tryCatch( - %I%(...), - error = function(e) e - ) + if (!is.null(%I%)) { + if (!is.function(%I%)) { + cli::cli_abort("{.arg callback} must be a function") + } + %I%_wrapped <- function(...) { + tryCatch( + %I%(...), + error = function(e) e + ) + } + } else { + %I%_wrapped <- NULL } +CLOSURE_EXTRA: + CALL: '%I%' + HEADER: '%I%' + +CLOSURE_ENV: + CALL: '%I%' + HEADER: '%I%' + +CLOSURE_ENV_ARP: + CALL: '%I%' + HEADER: '%I%' + ISOCOMPAT_FUNC: CALL: {} HEADER: ~ From 895d7af26a5bd6cc090aafc59e56daa7181106ab Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Sun, 25 Jan 2026 21:29:30 +0000 Subject: [PATCH 06/12] fix: resolve segfault in callback and add function declaration Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- R/aaa-auto.R | 2 +- R/community.R | 5 ++++- src/rcallback.c | 4 ++-- src/rinterface.h | 4 ++++ tests/testthat/_snaps/aaa-auto.md | 8 ++++++++ tools/stimulus/functions-R.yaml | 2 +- 6 files changed, 20 insertions(+), 5 deletions(-) diff --git a/R/aaa-auto.R b/R/aaa-auto.R index 73809834b08..5fb397a0556 100644 --- a/R/aaa-auto.R +++ b/R/aaa-auto.R @@ -14047,7 +14047,7 @@ community_leading_eigenvector_callback_closure_impl <- function( callback = NULL, extra = NULL, env = parent.frame(), - env_arp = environment(igraph.i.levc.arp) + env_arp ) { # Argument checks ensure_igraph(graph) diff --git a/R/community.R b/R/community.R index 80ad656025b..1f17ae5bca4 100644 --- a/R/community.R +++ b/R/community.R @@ -2262,6 +2262,9 @@ cluster_leading_eigen <- function( on.exit(.Call(R_igraph_finalizer)) # Function call using autogenerated implementation with callback support + # Get the environment for the ARPACK multiplier helper function + levc_arp_env <- environment(igraph.i.levc.arp) + res <- community_leading_eigenvector_callback_closure_impl( graph = graph, weights = weights, @@ -2272,7 +2275,7 @@ cluster_leading_eigen <- function( callback = callback, extra = extra, env = env, - env_arp = environment(igraph.i.levc.arp) + env_arp = levc_arp_env ) if (igraph_opt("add.vertex.names") && is_named(graph)) { diff --git a/src/rcallback.c b/src/rcallback.c index 71041bcfb6f..cbab37de643 100644 --- a/src/rcallback.c +++ b/src/rcallback.c @@ -390,8 +390,8 @@ igraph_error_t igraph_community_leading_eigenvector_callback_closure( R_igraph_levc_callback_data_t data = { .callback = callback, .extra = extra ? extra : R_NilValue, /* Convert NULL to R_NilValue */ - .env = env, - .env_arp = env_arp + .env = env ? env : R_GlobalEnv, /* Ensure env is never NULL */ + .env_arp = env_arp ? env_arp : R_GlobalEnv /* Ensure env_arp is never NULL */ }; return igraph_community_leading_eigenvector( diff --git a/src/rinterface.h b/src/rinterface.h index 852a6ae48ae..7c04022dd9f 100644 --- a/src/rinterface.h +++ b/src/rinterface.h @@ -156,6 +156,10 @@ igraph_error_t Rw_get_int_scalar(SEXP sexp, R_xlen_t index, igraph_integer_t *re igraph_error_t Rw_get_real_scalar(SEXP sexp, R_xlen_t index, igraph_real_t *res); igraph_error_t Rw_get_bool_scalar(SEXP sexp, R_xlen_t index, igraph_bool_t *res); +/* Helper functions */ +SEXP Rx_igraph_i_lang7(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y); +SEXP Rx_igraph_getListElement(SEXP list, const char *str); + /* Declarations for functions from rinterface.c needed by wrappers in rinterface_extra.c */ SEXP R_igraph_adjacency(SEXP adjmatrix, SEXP mode, SEXP loops); SEXP R_igraph_weighted_adjacency(SEXP adjmatrix, SEXP mode, SEXP loops); diff --git a/tests/testthat/_snaps/aaa-auto.md b/tests/testthat/_snaps/aaa-auto.md index e86955cd2b3..cc0c9a2091e 100644 --- a/tests/testthat/_snaps/aaa-auto.md +++ b/tests/testthat/_snaps/aaa-auto.md @@ -11007,6 +11007,14 @@ [1] 0 0 0 1 1 1 +# community_leading_eigenvector_impl errors + + Code + community_leading_eigenvector_impl(graph = g, steps = -100) + Condition + Error in `community_leading_eigenvector_impl()`: + ! could not find function "community_leading_eigenvector_impl" + # edge_connectivity_impl basic Code diff --git a/tools/stimulus/functions-R.yaml b/tools/stimulus/functions-R.yaml index aa06589a2ae..889db732aaa 100644 --- a/tools/stimulus/functions-R.yaml +++ b/tools/stimulus/functions-R.yaml @@ -673,7 +673,7 @@ igraph_community_leading_eigenvector_callback_closure: CLOSURE callback=NULL, CLOSURE_EXTRA extra=NULL, CLOSURE_ENV env=parent.frame(), - CLOSURE_ENV_ARP env_arp=environment(igraph.i.levc.arp) + CLOSURE_ENV_ARP env_arp DEPS: weights ON graph, membership ON graph R: CLASS: igraph.eigenc From 61101f6b56426fa6f37a85eb8febefb35cc139cf Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Mon, 26 Jan 2026 03:41:43 +0000 Subject: [PATCH 07/12] test: restore original callback tests to ensure functionality is preserved Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- tests/testthat/test-community.R | 62 ++++++++++++++++++++++++++------- 1 file changed, 50 insertions(+), 12 deletions(-) diff --git a/tests/testthat/test-community.R b/tests/testthat/test-community.R index be11c33e03b..1d5880863d6 100644 --- a/tests/testthat/test-community.R +++ b/tests/testthat/test-community.R @@ -209,8 +209,31 @@ test_that("label.propagation.community works", { test_that("cluster_leading_eigen works", { withr::local_seed(20230115) + check_eigen_value <- function( + membership, + community, + value, + vector, + multiplier, + extra + ) { + M <- sapply(1:length(vector), function(x) { + v <- rep(0, length(vector)) + v[x] <- 1 + multiplier(v) + }) + ev <- eigen(M) + ret <- 0 + expect_equal(ev$values[1], value) + if (sign(ev$vectors[1, 1]) != sign(vector[1])) { + ev$vectors <- -ev$vectors + } + expect_equal(ev$vectors[, 1], vector) + 0 + } + karate <- make_graph("Zachary") - karate_lc <- cluster_leading_eigen(karate) + karate_lc <- cluster_leading_eigen(karate, callback = check_eigen_value) expect_equal(karate_lc$modularity, modularity(karate, karate_lc$membership)) expect_equal( @@ -234,19 +257,34 @@ test_that("cluster_leading_eigen works", { class = "table" ) ) -}) -test_that("cluster_leading_eigen callback works", { - withr::local_seed(20230115) + ## Check that the modularity matrix is correct + + mod_mat_caller <- function( + membership, + community, + value, + vector, + multiplier, + extra + ) { + M <- sapply(1:length(vector), function(x) { + v <- rep(0, length(vector)) + v[x] <- 1 + multiplier(v) + }) + myc <- membership == community + B <- A[myc, myc] - (deg[myc] %*% t(deg[myc])) / 2 / ec + BG <- B - diag(rowSums(B)) + + expect_equal(M, BG) + 0 + } - karate <- make_graph("Zachary") - - # Test with a simple callback that always returns 0 (continue) - karate_lc <- cluster_leading_eigen(karate, callback = function(...) 0) - - # Should still get valid results - expect_equal(karate_lc$modularity, modularity(karate, karate_lc$membership)) - expect_length(karate_lc$membership, vcount(karate)) + A <- as_adjacency_matrix(karate, sparse = FALSE) + ec <- ecount(karate) + deg <- degree(karate) + karate_lc2 <- cluster_leading_eigen(karate, callback = mod_mat_caller) }) test_that("cluster_leading_eigen is deterministic", { ## Stress-test. We skip this on R 3.4 and 3.5 because it seems like From 9c40f22508e10306b33d46def9c640b0cc9279eb Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Mon, 26 Jan 2026 03:51:37 +0000 Subject: [PATCH 08/12] fix: correct function name in aaa-auto tests to use community_leading_eigenvector_callback_closure_impl Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com> --- tests/testthat/_snaps/aaa-auto.md | 14 -------------- tests/testthat/test-aaa-auto.R | 21 +++++++++++++-------- 2 files changed, 13 insertions(+), 22 deletions(-) diff --git a/tests/testthat/_snaps/aaa-auto.md b/tests/testthat/_snaps/aaa-auto.md index cc0c9a2091e..611e6e06066 100644 --- a/tests/testthat/_snaps/aaa-auto.md +++ b/tests/testthat/_snaps/aaa-auto.md @@ -11007,20 +11007,6 @@ [1] 0 0 0 1 1 1 -# community_leading_eigenvector_impl errors - - Code - community_leading_eigenvector_impl(graph = g, steps = -100) - Condition - Error in `community_leading_eigenvector_impl()`: - ! could not find function "community_leading_eigenvector_impl" - -# edge_connectivity_impl basic - - Code - edge_connectivity_impl(graph = g) - Output - [1] 2 # vertex_connectivity_impl basic diff --git a/tests/testthat/test-aaa-auto.R b/tests/testthat/test-aaa-auto.R index b804ffbf815..c52ef1455a7 100644 --- a/tests/testthat/test-aaa-auto.R +++ b/tests/testthat/test-aaa-auto.R @@ -10867,13 +10867,16 @@ test_that("community_edge_betweenness_impl basic", { expect_snapshot(community_edge_betweenness_impl(graph = g, directed = FALSE)) }) -test_that("community_leading_eigenvector_impl basic", { +test_that("community_leading_eigenvector_callback_closure_impl basic", { withr::local_seed(20250909) local_igraph_options(print.id = FALSE) # Test with a simple graph g <- make_graph("Zachary") - result <- community_leading_eigenvector_impl(graph = g) + result <- community_leading_eigenvector_callback_closure_impl( + graph = g, + env_arp = environment(igraph.i.levc.arp) + ) expect_snapshot({ cat("Result class:\n") @@ -10896,7 +10899,7 @@ test_that("community_leading_eigenvector_impl basic", { expect_true(is.numeric(result$modularity)) }) -test_that("community_leading_eigenvector_impl with start", { +test_that("community_leading_eigenvector_callback_closure_impl with start", { withr::local_seed(20250909) local_igraph_options(print.id = FALSE) @@ -10904,10 +10907,11 @@ test_that("community_leading_eigenvector_impl with start", { # Create initial membership (0-based for the impl function) initial_membership <- rep(0:1, length.out = vcount(g)) - result <- community_leading_eigenvector_impl( + result <- community_leading_eigenvector_callback_closure_impl( graph = g, membership = initial_membership, - start = TRUE + start = TRUE, + env_arp = environment(igraph.i.levc.arp) ) expect_snapshot({ @@ -10922,7 +10926,7 @@ test_that("community_leading_eigenvector_impl with start", { expect_equal(length(result$membership), vcount(g)) }) -test_that("community_leading_eigenvector_impl errors", { +test_that("community_leading_eigenvector_callback_closure_impl errors", { withr::local_seed(20250909) local_igraph_options(print.id = FALSE) @@ -10930,9 +10934,10 @@ test_that("community_leading_eigenvector_impl errors", { # Test with invalid steps expect_snapshot_igraph_error( - community_leading_eigenvector_impl( + community_leading_eigenvector_callback_closure_impl( graph = g, - steps = -100 + steps = -100, + env_arp = environment(igraph.i.levc.arp) ) ) }) From 41791cf7977639b50de3f5a704752c84de7a26b9 Mon Sep 17 00:00:00 2001 From: krlmlr Date: Mon, 26 Jan 2026 06:17:49 +0000 Subject: [PATCH 09/12] chore: Auto-update from GitHub Actions Run: https://github.com/igraph/rigraph/actions/runs/21348034902 --- R/community.R | 6 +-- tests/testthat/_snaps/aaa-auto.md | 68 +++++++++++++++++++++++++++++++ tests/testthat/test-aaa-auto.R | 18 ++++---- 3 files changed, 80 insertions(+), 12 deletions(-) diff --git a/R/community.R b/R/community.R index 1f17ae5bca4..1c48f48c7de 100644 --- a/R/community.R +++ b/R/community.R @@ -2251,7 +2251,7 @@ cluster_leading_eigen <- function( } else { weights <- NULL } - + # Convert start membership to 0-based indexing and determine start flag start_flag <- !is.null(start) if (start_flag) { @@ -2264,7 +2264,7 @@ cluster_leading_eigen <- function( # Function call using autogenerated implementation with callback support # Get the environment for the ARPACK multiplier helper function levc_arp_env <- environment(igraph.i.levc.arp) - + res <- community_leading_eigenvector_callback_closure_impl( graph = graph, weights = weights, @@ -2277,7 +2277,7 @@ cluster_leading_eigen <- function( env = env, env_arp = levc_arp_env ) - + if (igraph_opt("add.vertex.names") && is_named(graph)) { res$names <- V(graph)$name } diff --git a/tests/testthat/_snaps/aaa-auto.md b/tests/testthat/_snaps/aaa-auto.md index f8d37c531c8..e99566bc292 100644 --- a/tests/testthat/_snaps/aaa-auto.md +++ b/tests/testthat/_snaps/aaa-auto.md @@ -11007,6 +11007,74 @@ [1] 0 0 0 1 1 1 +# community_leading_eigenvector_callback_closure_impl basic + + Code + cat("Result class:\n") + Output + Result class: + Code + print(class(result)) + Output + [1] "igraph.eigenc" + Code + cat("\nMembership length:\n") + Output + + Membership length: + Code + print(length(result$membership)) + Output + [1] 34 + Code + cat("\nModularity:\n") + Output + + Modularity: + Code + print(result$modularity) + Output + [1] 0.3934089 + Code + cat("\nMerges dimensions:\n") + Output + + Merges dimensions: + Code + print(dim(result$merges)) + Output + [1] 3 2 + +# community_leading_eigenvector_callback_closure_impl with start + + Code + cat("Result with start membership:\n") + Output + Result with start membership: + Code + cat("Membership length:\n") + Output + Membership length: + Code + print(length(result$membership)) + Output + [1] 34 + Code + cat("\nModularity:\n") + Output + + Modularity: + Code + print(result$modularity) + Output + [1] 0.2217291 + +# edge_connectivity_impl basic + + Code + edge_connectivity_impl(graph = g) + Output + [1] 2 # vertex_connectivity_impl basic diff --git a/tests/testthat/test-aaa-auto.R b/tests/testthat/test-aaa-auto.R index 1236aa01fbd..1727c3504a0 100644 --- a/tests/testthat/test-aaa-auto.R +++ b/tests/testthat/test-aaa-auto.R @@ -10870,14 +10870,14 @@ test_that("community_edge_betweenness_impl basic", { test_that("community_leading_eigenvector_callback_closure_impl basic", { withr::local_seed(20250909) local_igraph_options(print.id = FALSE) - + # Test with a simple graph g <- make_graph("Zachary") result <- community_leading_eigenvector_callback_closure_impl( graph = g, env_arp = environment(igraph.i.levc.arp) ) - + expect_snapshot({ cat("Result class:\n") print(class(result)) @@ -10888,7 +10888,7 @@ test_that("community_leading_eigenvector_callback_closure_impl basic", { cat("\nMerges dimensions:\n") print(dim(result$merges)) }) - + # Structured tests expect_s3_class(result, "igraph.eigenc") expect_true(is.list(result)) @@ -10902,18 +10902,18 @@ test_that("community_leading_eigenvector_callback_closure_impl basic", { test_that("community_leading_eigenvector_callback_closure_impl with start", { withr::local_seed(20250909) local_igraph_options(print.id = FALSE) - + g <- make_graph("Zachary") # Create initial membership (0-based for the impl function) initial_membership <- rep(0:1, length.out = vcount(g)) - + result <- community_leading_eigenvector_callback_closure_impl( graph = g, membership = initial_membership, start = TRUE, env_arp = environment(igraph.i.levc.arp) ) - + expect_snapshot({ cat("Result with start membership:\n") cat("Membership length:\n") @@ -10921,7 +10921,7 @@ test_that("community_leading_eigenvector_callback_closure_impl with start", { cat("\nModularity:\n") print(result$modularity) }) - + expect_s3_class(result, "igraph.eigenc") expect_equal(length(result$membership), vcount(g)) }) @@ -10929,9 +10929,9 @@ test_that("community_leading_eigenvector_callback_closure_impl with start", { test_that("community_leading_eigenvector_callback_closure_impl errors", { withr::local_seed(20250909) local_igraph_options(print.id = FALSE) - + g <- make_graph("Zachary") - + # Test with invalid steps expect_snapshot_igraph_error( community_leading_eigenvector_callback_closure_impl( From fc16aa429c83d70906fa815c4a4fa5c7a930896a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 26 Jan 2026 07:32:33 +0100 Subject: [PATCH 10/12] env_arp --- R/aaa-auto.R | 2 +- R/community.R | 8 +------- tests/testthat/test-aaa-auto.R | 9 +++------ tools/stimulus/functions-R.yaml | 2 +- 4 files changed, 6 insertions(+), 15 deletions(-) diff --git a/R/aaa-auto.R b/R/aaa-auto.R index 7fef3992fcb..f394c14d479 100644 --- a/R/aaa-auto.R +++ b/R/aaa-auto.R @@ -14275,7 +14275,7 @@ community_leading_eigenvector_callback_closure_impl <- function( callback = NULL, extra = NULL, env = parent.frame(), - env_arp + env_arp = environment(igraph.i.levc.arp) ) { # Argument checks ensure_igraph(graph) diff --git a/R/community.R b/R/community.R index 1c48f48c7de..3fdc0df6ec4 100644 --- a/R/community.R +++ b/R/community.R @@ -2260,11 +2260,6 @@ cluster_leading_eigen <- function( options <- modify_list(arpack_defaults(), options) - on.exit(.Call(R_igraph_finalizer)) - # Function call using autogenerated implementation with callback support - # Get the environment for the ARPACK multiplier helper function - levc_arp_env <- environment(igraph.i.levc.arp) - res <- community_leading_eigenvector_callback_closure_impl( graph = graph, weights = weights, @@ -2274,8 +2269,7 @@ cluster_leading_eigen <- function( start = start_flag, callback = callback, extra = extra, - env = env, - env_arp = levc_arp_env + env = env ) if (igraph_opt("add.vertex.names") && is_named(graph)) { diff --git a/tests/testthat/test-aaa-auto.R b/tests/testthat/test-aaa-auto.R index 1727c3504a0..27c9e68d62c 100644 --- a/tests/testthat/test-aaa-auto.R +++ b/tests/testthat/test-aaa-auto.R @@ -10874,8 +10874,7 @@ test_that("community_leading_eigenvector_callback_closure_impl basic", { # Test with a simple graph g <- make_graph("Zachary") result <- community_leading_eigenvector_callback_closure_impl( - graph = g, - env_arp = environment(igraph.i.levc.arp) + graph = g ) expect_snapshot({ @@ -10910,8 +10909,7 @@ test_that("community_leading_eigenvector_callback_closure_impl with start", { result <- community_leading_eigenvector_callback_closure_impl( graph = g, membership = initial_membership, - start = TRUE, - env_arp = environment(igraph.i.levc.arp) + start = TRUE ) expect_snapshot({ @@ -10936,8 +10934,7 @@ test_that("community_leading_eigenvector_callback_closure_impl errors", { expect_snapshot_igraph_error( community_leading_eigenvector_callback_closure_impl( graph = g, - steps = -100, - env_arp = environment(igraph.i.levc.arp) + steps = -100 ) ) }) diff --git a/tools/stimulus/functions-R.yaml b/tools/stimulus/functions-R.yaml index 6500354c394..018d397c6f7 100644 --- a/tools/stimulus/functions-R.yaml +++ b/tools/stimulus/functions-R.yaml @@ -672,7 +672,7 @@ igraph_community_leading_eigenvector_callback_closure: CLOSURE callback=NULL, CLOSURE_EXTRA extra=NULL, CLOSURE_ENV env=parent.frame(), - CLOSURE_ENV_ARP env_arp + CLOSURE_ENV_ARP env_arp=environment(igraph.i.levc.arp) DEPS: weights ON graph, membership ON graph R: CLASS: igraph.eigenc From dbbac8796eea3f9ad35b1e05b73b38e8d27e366a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 26 Jan 2026 07:39:35 +0100 Subject: [PATCH 11/12] Fix test --- tests/testthat/test-aaa-auto.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-aaa-auto.R b/tests/testthat/test-aaa-auto.R index 27c9e68d62c..e8417b517eb 100644 --- a/tests/testthat/test-aaa-auto.R +++ b/tests/testthat/test-aaa-auto.R @@ -10934,7 +10934,7 @@ test_that("community_leading_eigenvector_callback_closure_impl errors", { expect_snapshot_igraph_error( community_leading_eigenvector_callback_closure_impl( graph = g, - steps = -100 + start = TRUE ) ) }) From 2ef25248139cf805ac44c38d8d14a0bcc0038738 Mon Sep 17 00:00:00 2001 From: krlmlr Date: Mon, 26 Jan 2026 06:47:27 +0000 Subject: [PATCH 12/12] chore: Auto-update from GitHub Actions Run: https://github.com/igraph/rigraph/actions/runs/21348626984 --- tests/testthat/_snaps/aaa-auto.md | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/tests/testthat/_snaps/aaa-auto.md b/tests/testthat/_snaps/aaa-auto.md index e99566bc292..754b76eac82 100644 --- a/tests/testthat/_snaps/aaa-auto.md +++ b/tests/testthat/_snaps/aaa-auto.md @@ -11069,6 +11069,15 @@ Output [1] 0.2217291 +# community_leading_eigenvector_callback_closure_impl errors + + Code + community_leading_eigenvector_callback_closure_impl(graph = g, start = TRUE) + Condition + Error in `community_leading_eigenvector_callback_closure_impl()`: + ! Supplied memberhsip vector length does not match number of vertices. Invalid value + Source: : + # edge_connectivity_impl basic Code @@ -11702,21 +11711,13 @@ Error in `ensure_igraph()`: ! Must provide a graph object (provided `NULL`). ---- - - Code - get_eid_impl(graph = g, from = c(1, 2), to = 2) - Condition - Error: - ! `from` must specify exactly one vertex - --- Code get_eid_impl(graph = g, from = 1, to = integer(0)) Condition Error: - ! `to` must specify exactly one vertex + ! `to` must specify at least one vertex # community_voronoi_impl basic