diff --git a/R/aaa-auto.R b/R/aaa-auto.R index 88c40309ef..4c8854f813 100644 --- a/R/aaa-auto.R +++ b/R/aaa-auto.R @@ -81,6 +81,24 @@ get_all_eids_between_impl <- function(graph, from, to, directed=TRUE) { res } +incident_impl <- function(graph, vid, mode=c("all", "out", "in", "total")) { + # Argument checks + ensure_igraph(graph) + vid <- as_igraph_vs(graph, vid) + if (length(vid) == 0) { + stop("No vertex was specified") + } + mode <- switch(igraph.match.arg(mode), "out"=1L, "in"=2L, "all"=3L, "total"=3L) + + on.exit( .Call(R_igraph_finalizer) ) + # Function call + res <- .Call(R_igraph_incident, graph, vid-1, mode) + if (igraph_opt("return.vs.es")) { + res <- create_es(graph, res) + } + res +} + wheel_impl <- function(n, mode=c("out", "in", "undirected", "mutual"), center=0) { # Argument checks n <- as.numeric(n) diff --git a/R/interface.R b/R/interface.R index e5317fd54e..123b07ac4e 100644 --- a/R/interface.R +++ b/R/interface.R @@ -388,16 +388,15 @@ incident <- function(graph, v, mode = c("all", "out", "in", "total")) { ensure_igraph(graph) if (is_directed(graph)) { mode <- igraph.match.arg(mode) - mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3, "total" = 3) } else { - mode <- 1 + mode <- "out" } v <- as_igraph_vs(graph, v) if (length(v) == 0) { stop("No vertex was specified") } - on.exit(.Call(R_igraph_finalizer)) - res <- .Call(R_igraph_incident, graph, v - 1, as.numeric(mode)) + 1L + + res <- incident_impl(graph, vid = v, mode = mode) if (igraph_opt("return.vs.es")) { res <- create_es(graph, res) @@ -687,20 +686,16 @@ adjacent_vertices <- function(graph, v, mode = c("out", "in", "all", "total")) { incident_edges <- function(graph, v, mode = c("out", "in", "all", "total")) { ensure_igraph(graph) - vv <- as_igraph_vs(graph, v) - 1 - mode <- switch(match.arg(mode), "out" = 1, "in" = 2, "all" = 3, "total" = 3) + vv <- as_igraph_vs(graph, v) - on.exit(.Call(R_igraph_finalizer)) - - res <- .Call(R_igraph_incident_edges, graph, vv, mode) - res <- lapply(res, `+`, 1) + res <- incident_impl(graph, vid = vv, mode = mode) if (igraph_opt("return.vs.es")) { res <- lapply(res, unsafe_create_es, graph = graph, es = E(graph)) } if (is_named(graph)) { - names(res) <- V(graph)$name[vv + 1] + names(res) <- V(graph)$name[vv] } res diff --git a/src/rinterface.c b/src/rinterface.c index 046b758be1..000dccd3d0 100644 --- a/src/rinterface.c +++ b/src/rinterface.c @@ -222,6 +222,37 @@ SEXP R_igraph_get_all_eids_between(SEXP graph, SEXP from, SEXP to, SEXP directed return(r_result); } +/*-------------------------------------------/ +/ igraph_incident / +/-------------------------------------------*/ +SEXP R_igraph_incident(SEXP graph, SEXP vid, SEXP mode) { + /* Declarations */ + igraph_t c_graph; + igraph_vector_int_t c_eids; + igraph_integer_t c_vid; + igraph_neimode_t c_mode; + SEXP eids; + + SEXP r_result; + /* Convert input */ + R_SEXP_to_igraph(graph, &c_graph); + IGRAPH_R_CHECK(igraph_vector_int_init(&c_eids, 0)); + IGRAPH_FINALLY(igraph_vector_int_destroy, &c_eids); + c_vid = (igraph_integer_t) REAL(vid)[0]; + c_mode = (igraph_neimode_t) Rf_asInteger(mode); + /* Call igraph */ + IGRAPH_R_CHECK(igraph_incident(&c_graph, &c_eids, c_vid, c_mode)); + + /* Convert output */ + PROTECT(eids=R_igraph_vector_int_to_SEXPp1(&c_eids)); + igraph_vector_int_destroy(&c_eids); + IGRAPH_FINALLY_CLEAN(1); + r_result = eids; + + UNPROTECT(1); + return(r_result); +} + /*-------------------------------------------/ / igraph_adjacency / /-------------------------------------------*/ diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index 2ce149bf7e..beba2b889e 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -3894,27 +3894,6 @@ SEXP R_igraph_neighbors(SEXP graph, SEXP pvid, SEXP pmode) { return result; } -SEXP R_igraph_incident(SEXP graph, SEXP pvid, SEXP pmode) { - - igraph_t g; - igraph_vector_int_t neis; - SEXP result; - igraph_real_t vid; - igraph_neimode_t mode; - - igraph_vector_int_init(&neis, 0); - vid=REAL(pvid)[0]; - mode = (igraph_neimode_t) Rf_asInteger(pmode); - R_SEXP_to_igraph(graph, &g); - IGRAPH_R_CHECK(igraph_incident(&g, &neis, (igraph_integer_t) vid, mode)); - - PROTECT(result=R_igraph_vector_int_to_SEXP(&neis)); - igraph_vector_int_destroy(&neis); - - UNPROTECT(1); - return result; -} - SEXP R_igraph_delete_edges(SEXP graph, SEXP edges) { igraph_es_t es; @@ -8708,4 +8687,4 @@ SEXP R_igraph_add_env(SEXP graph) { SEXP R_igraph_get_graph_id(SEXP graph) { return Rf_findVar(Rf_install("myid"), R_igraph_graph_env(graph)); -} +} \ No newline at end of file diff --git a/tools/stimulus/functions-R.yaml b/tools/stimulus/functions-R.yaml index b7a2c84f43..0c1a362c40 100644 --- a/tools/stimulus/functions-R.yaml +++ b/tools/stimulus/functions-R.yaml @@ -55,7 +55,7 @@ igraph_get_all_eids_between: DEPS: from ON graph, to ON graph, eids ON graph igraph_incident: - IGNORE: RR, RC + DEPS: vid ON graph, eids ON graph igraph_is_same_graph: IGNORE: RR, RC, RInit