diff --git a/R/iterators.R b/R/iterators.R index a03ce0427ef..3a6bb2ce466 100644 --- a/R/iterators.R +++ b/R/iterators.R @@ -334,41 +334,23 @@ unsafe_create_vs <- function(graph, idx, verts = NULL) { # # This is the batch form of `unsafe_create_vs()` and replaces the # `lapply(idx_list, unsafe_create_vs, graph = graph, verts = V(graph))` -# pattern. All the per-graph work -- `V(graph)`, the shared weak reference, -# the graph id and the vertex-name source -- is hoisted out of the loop, so -# each sequence costs one `as.integer()`, one name subset and one -# `attributes<-` instead of a closure call that re-reads all of it. -# -# Having a single named entry point for "turn this list of ID vectors into a -# list of vertex sequences" also means the construction loop can be moved -# wholesale (e.g. into C) without touching any of the ~37 call sites. +# pattern. The whole per-element loop runs in C, so building many sequences +# costs no per-object R overhead (no closure call, no `as.integer()`, no +# `attributes<-`). This is what brings construction of many sequences +# (e.g. `max_cliques()`) down close to the cost of returning bare indices. create_vs_list <- function(graph, idx_list) { + # `verts <- V(graph)` is what mints the single shared weak reference and + # graph id; build it once and hand the pieces to C, which runs the + # per-element construction loop (payload coercion, name subsetting, + # attribute setting). verts <- V(graph) - vs_env <- attr(verts, "env") - vs_graph <- attr(verts, "graph") - vertex_names <- attr(verts, "names") - if (is.null(vertex_names)) { - lapply(idx_list, function(idx) { - res <- as.integer(idx) - attributes(res) <- list( - class = "igraph.vs", - env = vs_env, - graph = vs_graph - ) - res - }) - } else { - lapply(idx_list, function(idx) { - res <- as.integer(idx) - attributes(res) <- list( - names = vertex_names[res], - class = "igraph.vs", - env = vs_env, - graph = vs_graph - ) - res - }) - } + .Call( + Rx_igraph_vs_list, + idx_list, + if (is_named(graph)) vertex_attr(graph)$name else NULL, + attr(verts, "env"), + attr(verts, "graph") + ) } # Internal function to quickly convert integer vectors to igraph.es diff --git a/src/cpp11.cpp b/src/cpp11.cpp index bababf63294..cd8a136215e 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -593,6 +593,7 @@ extern SEXP Rx_igraph_transitivity_local_undirected_all(SEXP, SEXP); extern SEXP Rx_igraph_union(SEXP, SEXP); extern SEXP Rx_igraph_vcount(SEXP); extern SEXP Rx_igraph_vs_adj(SEXP, SEXP, SEXP, SEXP); +extern SEXP Rx_igraph_vs_list(SEXP, SEXP, SEXP, SEXP); extern SEXP Rx_igraph_vs_nei(SEXP, SEXP, SEXP, SEXP); extern SEXP Rx_igraph_walktrap_community(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP Rx_igraph_weak_ref_key(SEXP); @@ -1173,6 +1174,7 @@ static const R_CallMethodDef CallEntries[] = { {"Rx_igraph_union", (DL_FUNC) &Rx_igraph_union, 2}, {"Rx_igraph_vcount", (DL_FUNC) &Rx_igraph_vcount, 1}, {"Rx_igraph_vs_adj", (DL_FUNC) &Rx_igraph_vs_adj, 4}, + {"Rx_igraph_vs_list", (DL_FUNC) &Rx_igraph_vs_list, 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_weak_ref_key", (DL_FUNC) &Rx_igraph_weak_ref_key, 1}, diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index 0ffcc2f4d40..ec98a16b266 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -2611,6 +2611,70 @@ static void *Rx_igraph_altrep_to(SEXP vec, Rboolean writeable) { static R_altrep_class_t Rx_igraph_altrep_from_class; static R_altrep_class_t Rx_igraph_altrep_to_class; +/* Batch constructor for a list of vertex sequences. + * + * Builds the whole `lapply(idx_list, unsafe_create_vs, ...)` result in one C + * pass: for each vertex-ID vector it produces a fresh integer payload, attaches + * the corresponding vertex names (when the graph is named), and sets the shared + * `env` weak reference, the `graph` id and the `igraph.vs` class. This keeps the + * per-object R overhead (closure call, `as.integer`, name subset, + * `attributes<-`) out of the loop entirely. + * + * idx_list : VECSXP of vertex-ID vectors (integer or double) + * names_src : graph's full vertex-name STRSXP, or NULL for unnamed graphs + * env : the shared weak reference (or env) to set as the "env" attr + * graph_id : graph id (character scalar), or NULL to skip the "graph" attr + */ +SEXP Rx_igraph_vs_list(SEXP idx_list, SEXP names_src, SEXP env, SEXP graph_id) { + R_xlen_t n=XLENGTH(idx_list); + int named=(TYPEOF(names_src) == STRSXP); + R_xlen_t nsource=named ? XLENGTH(names_src) : 0; + SEXP env_sym=Rf_install("env"); + SEXP graph_sym=Rf_install("graph"); + SEXP out=PROTECT(Rf_allocVector(VECSXP, n)); + SEXP cls=PROTECT(Rf_mkString("igraph.vs")); + + for (R_xlen_t i=0; i < n; i++) { + SEXP elt=VECTOR_ELT(idx_list, i); + /* Fresh, unshared integer payload: coerceVector returns its argument + * unchanged when the type already matches, so duplicate in that case to + * avoid mutating a caller-owned vector. */ + SEXP payload=PROTECT(Rf_coerceVector(elt, INTSXP)); + if (payload == elt) { + UNPROTECT(1); + payload=PROTECT(Rf_duplicate(elt)); + } + + if (named) { + R_xlen_t len=XLENGTH(payload); + const int *pidx=INTEGER(payload); + SEXP nm=PROTECT(Rf_allocVector(STRSXP, len)); + for (R_xlen_t k=0; k < len; k++) { + int j=pidx[k]; + if (j == NA_INTEGER || j < 1 || j > nsource) { + SET_STRING_ELT(nm, k, NA_STRING); + } else { + SET_STRING_ELT(nm, k, STRING_ELT(names_src, j - 1)); + } + } + Rf_setAttrib(payload, R_NamesSymbol, nm); + UNPROTECT(1); + } + + Rf_setAttrib(payload, env_sym, env); + if (graph_id != R_NilValue) { + Rf_setAttrib(payload, graph_sym, graph_id); + } + Rf_setAttrib(payload, R_ClassSymbol, cls); + + SET_VECTOR_ELT(out, i, payload); + UNPROTECT(1); + } + + UNPROTECT(2); + return out; +} + /* HELPER: internal C; must use IGRAPH_CHECK */ void Rx_igraph_init_vector_class(DllInfo *dll) { Rx_igraph_altrep_from_class=R_make_altreal_class("igraph_from", "base", dll); diff --git a/touchstone/script.R b/touchstone/script.R index cc4900e25ac..481a623b77d 100644 --- a/touchstone/script.R +++ b/touchstone/script.R @@ -331,5 +331,50 @@ benchmark_run( n = 20 ) +# --------------------------------------------------------------------------- +# Group #6 - batch construction of many vertex sequences +# One shared graph reference and one hoisted name source, with the whole +# per-element loop in C, instead of per-object R work. These two calls each +# return thousands of vertex sequences from a single C core call. +# --------------------------------------------------------------------------- + +# ego() returns one vertex sequence per node -- a few thousand sequences built +# in one call. Exercises create_vs_list() through neighborhood(). +benchmark_run( + expr_before_benchmark = { + library(igraph) + set.seed(42) + g <- sample_gnm(2000L, 10000L) + V(g)$name <- paste0("v", seq_len(2000L)) + for (i in 1:2) { + ego(g, order = 2, nodes = V(g)) + } + gc(full = TRUE) + }, + ego_order2_named = for (i in 1:16) { + ego(g, order = 2, nodes = V(g)) + }, + n = 20 +) + +# Enumerate simple paths between hubs on a named graph: another high-volume +# vertex-sequence-list path (create_vs_list() via all_simple_paths()). +benchmark_run( + expr_before_benchmark = { + library(igraph) + set.seed(42) + g <- sample_gnm(500L, 2500L) + V(g)$name <- paste0("v", seq_len(500L)) + for (i in 1:2) { + all_simple_paths(g, 1, 2:6, cutoff = 5) + } + gc(full = TRUE) + }, + all_simple_paths_named = for (i in 1:33) { + all_simple_paths(g, 1, 2:6, cutoff = 5) + }, + n = 20 +) + # Create the artifacts consumed by the GitHub Action. benchmark_analyze()