检测和“分离”二进制表达式的C方法

我的代码中有一个瓶颈,比如 any(x >= b | x == y) 为了一大笔钱 x

我想避免分配 x >= b | x == y . 我发现为特定情况编写函数很容易。

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;
}

然而,为了清晰起见,我希望尽可能多地保留自然语法,比如 any_or(x >= b, x == y) . 所以我希望能够检测到一个电话是否是这种形式的 <vector> <operator> <vector> 什么时候 <operator> 是一个标准的二进制运算符,每个 <vector> 长度等于向量长度1。大概是这样的:

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
}

x y , b 在本例中)以后使用(在同一个C函数中,或传递给类似于上面的C函数)。

#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;
}

在R中,我会这样写:

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]])
}

但我想尽可能多地用C。