Блог

У меня есть узкое место в моем коде в выражениях, например 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> when <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, которая определяет, является ли замещенное выражение / вызов двоичным выражением, но (а) у меня возникли проблемы с определением, является ли оператор двоичным оператором, и (б) получение векторов из выражения ( 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) amp;amp;
    length(sexprA) == 3L amp;amp;
    match(as.character(sexprA[[1]]), c("!=", "==", "<=", ">=", "<", ">"), nomatch = 0L) amp;amp;
    is.name(lhs <- sexprA[[2L]])
}
 

но я бы хотел сделать как можно больше на C.