C way to detect and 'separate' a binary expression - r

Question

I have a bottleneck in my code in expressions like any(x >= b | x == y) for a large x.
I'd like to avoid the allocation x >= b | x == y. I've found that it's easy to write a function for particular cases.
SEXP eval_any_or2(SEXP x, SEXP b, SEXP y) {
R_xlen_t N = xlength(x);
if (xlength(y) != N || xlength(b) != 1) {
error("Wrong lengths.");
}
const int *xp = INTEGER(x);
const int *yp = INTEGER(y);
const int *bp = INTEGER(b);
bool o = false;
for (R_xlen_t i = 0; i < N; ++i) {
if (xp[i] >= bp[0] || xp[i] == yp[i]) {
o = true;
break;
}
}
SEXP ans = PROTECT(allocVector(LGLSXP, 1));
LOGICAL(ans)[0] = o ? TRUE : FALSE;
UNPROTECT(1);
return ans;
}
However, for clarity I'd like to keep as much of the natural syntax as possible, like any_or(x >= b, x == y). So I'd like to be able to detect whether a call is of the form <vector> <operator> <vector> when <operator> is one of the standard binary operators, and each <vector> is of equal length vectors length 1. Something like this:
any_or2 <- function(expr1, expr2) {
sexp1 <- substitute(expr1)
sexp2 <- substitute(expr2)
if (!is_binary_sexp(sexp1) || !is_binary_sexp(sexp2) {
# fall through to just basic R
return(any(expr1 | expr2))
}
# In C
eval_any_or2(...) # either the substituted expression or x,y,b
}
I've attempted the following C function which detects whether a substituted expression/call is a binary expression, but (a) I'm having trouble detecting whether the operator is a binary operator and (b) getting the vectors from the expression (x, y, b in the example) to use later (either in the same C function or as passed to a C function like the one above).
#define return_false SEXP ans = PROTECT(allocVector(LGLSXP, 1)); \
LOGICAL(ans)[0] = FALSE; \
UNPROTECT(1); \
return ans; \
SEXP is_binary_sexp(SEXP sx) {
if (TYPEOF(sx) != LANGSXP) {
return_false
}
// does it have three elements?
int len = 0;
SEXP el, nxt;
for (nxt = sx; nxt != R_NilValue || len > 4; el = CAR(nxt), nxt = CDR(nxt)) {
len++;
}
if (len != 3) {
return_false;
}
if (TYPEOF(CAR(sx)) != SYMSXP) {
return_false;
}
SEXP ans = PROTECT(allocVector(LGLSXP, 1));
LOGICAL(ans)[0] = TRUE;
UNPROTECT(1);
return ans;
}
In R I would write something like:
is_binary_sexp_R <- function(sexprA) {
# sexprA is the result of substitute()
is.call(sexprA) &&
length(sexprA) == 3L &&
match(as.character(sexprA[[1]]), c("!=", "==", "<=", ">=", "<", ">"), nomatch = 0L) &&
is.name(lhs <- sexprA[[2L]])
}
but I'd like to do as much as possible in C.