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

Question

我的代码在表达式中遇到瓶颈，例如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
}

我尝试了以下 C 函数来检测替换的表达式/调用是否是二进制表达式，但是（a）我无法检测运算符是否是二进制运算符，并且（b）从表达式（x，y,b在示例中）以供稍后使用（在同一个 C 函数中或传递给与上述 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;
}

在 RI 中会写如下内容：

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 中尽可能多地做。

标签： rc