feat: expose igraph_motifs_randesu_callback() to R for efficient motif sampling

NAMESPACE

@@ -704,6 +704,7 @@ export(mod.matrix)
 export(modularity)
 export(modularity_matrix)
 export(motifs)
+export(motifs_randesu_callback)
 export(mst)
 export(multilevel.community)
 export(neighborhood)

R/motifs.R

@@ -268,6 +268,114 @@ sample_motifs <- function(
 }
 
 
+#' Graph motifs with callback
+#'
+#' `r lifecycle::badge("experimental")`
+#'
+#' This function is similar to [motifs()], but instead of counting motifs,
+#' it calls a user-supplied callback function for each motif found.
+#' This is useful for sampling motifs from large graphs or for performing
+#' custom operations on each motif.
+#'
+#' @param graph Graph object, the input graph.
+#' @param size The size of the motif, currently sizes 3 and 4 are supported in
+#'   directed graphs and sizes 3-6 in undirected graphs.
+#' @param cut.prob Numeric vector giving the probabilities that the search
+#'   graph is cut at a certain level. Its length should be the same as the size
+#'   of the motif (the `size` argument).
+#'   If `NULL`, the default, no cuts are made.
+#' @param callback A function to be called for each motif found. The function
+#'   should accept three arguments:
+#'   \describe{
+#'     \item{graph}{The input graph object.}
+#'     \item{motif}{A named list with two elements: `vids` (the vertex IDs
+#'       in the motif) and `isoclass` (the isomorphism class of the motif).}
+#'     \item{extra}{The `extra` argument passed to `motifs_randesu_callback()`.}
+#'   }
+#'   The callback function should return `TRUE` to continue the search,
+#'   or `FALSE` to stop it.
+#' @param extra An arbitrary R object that will be passed to the callback
+#'   function as the `extra` argument.
+#' @return Invisible `NULL`. This function is called for its side effects
+#'   (calling the callback function).
+#' @seealso [motifs()], [count_motifs()], [sample_motifs()], [isomorphism_class()]
+#'
+#' @export
+#' @family graph motifs
+#' @concept graph_motifs
+#'
+#' @examples
+#' # Sample triads from a graph
+#' g <- make_graph(~ A - B - C - A - D - E - F - D - C - F)
+#'
+#' # Example 1: Count all triads
+#' triad_count <- 0
+#' motifs_randesu_callback(g, 3, callback = function(graph, motif, extra) {
+#'   triad_count <<- triad_count + 1
+#'   TRUE # continue searching
+#' })
+#' triad_count
+#'
+#' # Example 2: Stop after finding 5 triads
+#' triad_count <- 0
+#' motifs_randesu_callback(g, 3, callback = function(graph, motif, extra) {
+#'   triad_count <<- triad_count + 1
+#'   triad_count < 5 # stop when we have 5 motifs
+#' })
+#' triad_count
+#'
+#' # Example 3: Collect information about closed vs open triads
+#' # In undirected graphs, isoclass 2 represents closed triangles (A-B-C-A)
+#' # and isoclass 1 represents open paths (A-B-C)
+#' closed_triads <- 0
+#' open_triads <- 0
+#' motifs_randesu_callback(g, 3, callback = function(graph, motif, extra) {
+#'   if (motif$isoclass == 2) {
+#'     closed_triads <<- closed_triads + 1
+#'   } else if (motif$isoclass == 1) {
+#'     open_triads <<- open_triads + 1
+#'   }
+#'   TRUE
+#' })
+#' closed_triads
+#' open_triads
+#' @cdocs igraph_motifs_randesu_callback
+motifs_randesu_callback <- function(
+  graph,
+  size = 3,
+  cut.prob = NULL,
+  callback = NULL,
+  extra = NULL
+) {
+  ensure_igraph(graph)
+
+  if (!is.null(cut.prob) && length(cut.prob) != size) {
+    cli::cli_abort("{.arg cut.prob} must be the same length as {.arg size}")
+  }
+
+  if (is.null(callback)) {
+    cli::cli_abort("{.arg callback} must be a function")
+  }
+
+  if (!is.function(callback)) {
+    cli::cli_abort("{.arg callback} must be a function")
+  }
+
+  on.exit(.Call(R_igraph_finalizer))
+  .Call(
+    R_igraph_motifs_randesu_callback,
+    graph,
+    as.numeric(size),
+    if (!is.null(cut.prob)) as.numeric(cut.prob) else NULL,
+    callback,
+    extra,
+    parent.frame()
+  )
+
+  invisible(NULL)
+}
+
+
 #' Dyad census of a graph
 #'
 #' Classify dyads in a directed graphs. The relationship between each pair of

src/cpp11.cpp

@@ -331,6 +331,7 @@ extern SEXP R_igraph_modularity(SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_modularity_matrix(SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_moran_process(SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_motifs_randesu(SEXP, SEXP, SEXP);
+extern SEXP R_igraph_motifs_randesu_callback(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_motifs_randesu_estimate(SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_motifs_randesu_no(SEXP, SEXP, SEXP);
 extern SEXP R_igraph_mybracket3_set(SEXP, SEXP, SEXP, SEXP, SEXP);
@@ -857,6 +858,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"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",                    (DL_FUNC) &R_igraph_motifs_randesu_callback,                     6},
     {"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_mybracket3_set",                             (DL_FUNC) &R_igraph_mybracket3_set,                              5},

src/rinterface_extra.c

@@ -7742,6 +7742,88 @@ SEXP R_igraph_community_leading_eigenvector(SEXP graph, SEXP steps,
   return(result);
 }
 
+/*-------------------------------------------/
+/ igraph_motifs_randesu_callback             /
+/-------------------------------------------*/
+
+typedef struct {
+  SEXP graph, fun, extra, rho;
+} R_igraph_i_motifs_randesu_data_t;
+
+igraph_error_t R_igraph_motifs_randesu_handler(const igraph_t *graph,
+                                                igraph_vector_int_t *vids,
+                                                igraph_integer_t isoclass,
+                                                void *extra) {
+  R_igraph_i_motifs_randesu_data_t *data = extra;
+  SEXP args, R_fcall, result, names;
+  SEXP vids_sexp, isoclass_sexp;
+  igraph_bool_t cres;
+
+  PROTECT(args = NEW_LIST(2));
+  PROTECT(names = NEW_CHARACTER(2));
+
+  SET_STRING_ELT(names, 0, Rf_mkChar("vids"));
+  SET_STRING_ELT(names, 1, Rf_mkChar("isoclass"));
+
+  // Convert vids to R vector (1-based indexing)
+  PROTECT(vids_sexp = R_igraph_vector_int_to_SEXPp1(vids));
+  SET_VECTOR_ELT(args, 0, vids_sexp);
+
+  // Convert isoclass to R scalar
+  PROTECT(isoclass_sexp = NEW_NUMERIC(1));
+  REAL(isoclass_sexp)[0] = (double)isoclass;
+  SET_VECTOR_ELT(args, 1, isoclass_sexp);
+
+  SET_NAMES(args, names);
+
+  PROTECT(R_fcall = Rf_lang4(data->fun, data->graph, args, data->extra));
+  PROTECT(result = R_igraph_safe_eval_in_env(R_fcall, data->rho, NULL));
+  cres = Rf_asLogical(R_igraph_handle_safe_eval_result_in_env(result, data->rho));
+
+  UNPROTECT(6);
+  return cres ? IGRAPH_SUCCESS : IGRAPH_STOP;
+}
+
+attribute_visible
+SEXP R_igraph_motifs_randesu_callback(SEXP graph, SEXP size, SEXP cut_prob,
+                                      SEXP callback, SEXP extra, SEXP rho) {
+  igraph_t c_graph;
+  igraph_integer_t c_size;
+  igraph_vector_t c_cut_prob;
+  R_igraph_i_motifs_randesu_data_t cb_data, *p_cb_data = 0;
+  igraph_motifs_handler_t *p_callback = 0;
+
+  // Convert input
+  R_SEXP_to_igraph(graph, &c_graph);
+  IGRAPH_R_CHECK_INT(size);
+  c_size = (igraph_integer_t)REAL(size)[0];
+
+  if (!Rf_isNull(cut_prob)) {
+    R_SEXP_to_vector(cut_prob, &c_cut_prob);
+  }
+
+  // Setup callback if provided
+  if (!Rf_isNull(callback)) {
+    cb_data.graph = graph;
+    cb_data.fun = callback;
+    cb_data.extra = extra;
+    cb_data.rho = rho;
+    p_callback = R_igraph_motifs_randesu_handler;
+    p_cb_data = &cb_data;
+  }
+
+  // Call igraph
+  IGRAPH_R_CHECK(igraph_motifs_randesu_callback(
+    &c_graph,
+    c_size,
+    Rf_isNull(cut_prob) ? 0 : &c_cut_prob,
+    p_callback,
+    p_cb_data
+  ));
+
+  return R_NilValue;
+}
+
 SEXP R_igraph_get_eids(SEXP graph, SEXP pvp, SEXP pdirected,
                        SEXP perror) {
   igraph_t g;