[Rcpp-devel] calling R function triggers tryCatch() ???

[Romain Francois]

Le 03/10/13 13:03, Thomas Tse a écrit :
> Hi,
>
> I'm trying to implement a faster version of apply(x, 1L, FUN) in C++ but
> found some strange behaviors.
>
> // [[Rcpp::export]]
> NumericVector rowApply(NumericMatrix& x, const Function& FUN)
> {
>    int n = x.nrow();
>    NumericVector result = no_init(n);
>
>    for (int r = 0; r < n; r++) {
> result[r] = as<double>(FUN(x(r, _) ) );
>    }
>    return result;
> }
>
>> M <- matrix(1:15, nrow=3);
>> apply(M, 1L, mean)
> [1] 7 8 9
>> rowApply(M, mean);
> [1] 7 8 9
>> identical(rowApply(M, mean), apply(M, 1L, mean));
> [1] TRUE
>
>
> so far so good, with rowApply() is identical to apply(, 1L, ), and the
> speed of rowApply() (in these cases) are faster as measured by benchmark().
>
>
> HOWEVER, when I Rprof() my own project that uses rowApply(), I found a
> lot of time WASTED in calling tryCatch(), tryCatchList(), tryCatchOne(),
> doTryCatch() and evalq().
>
> so, I do this:

Yes. We use tryCatch because we have to fight between C++ and R 
exception models.


If you know your function will not generate an R error, you can use that 
sort of construct to evaluate it without the tryCatch layer :

// [[Rcpp::export]]
NumericVector rowApply(NumericMatrix& x, const Function& FUN){
   int n = x.nrow();
   NumericVector result = no_init(n);

   for (int r = 0; r < n; r++) {
       Language call(FUN, x(r, _)) ;
       result[r] = as<double>(call.fast_eval());
   }
   return result;
}

or more efficiently:

// [[Rcpp::export]]
NumericVector rowApply(NumericMatrix& x, const Function& FUN){
   int n = x.nrow();
   NumericVector result = no_init(n);

   Language call(FUN, R_NilValue) ;
   Language::Proxy proxy( call, 1 );
   for (int r = 0; r < n; r++) {
       proxy = x(r, _) ;
       result[r] = as<double>(call.fast_eval());
   }
   return result;
}

The key here is fast_eval, which just calls R's Rf_eval.

If you go down this road, you have to make sure your function does not 
generate R errors.

Romain


>> debug(tryCatch);
>
> then,
>
>> apply(M, 1L, mean)
> [1] 7 8 9
>
> we see that apply(, 1L, ) runs just fine (without calling things like
> tryCatch() ).
>
>
> UNFORTUNATELY:
>
>> rowApply(M, mean);
> debugging in: tryCatch(evalq(function (x, ...)
> UseMethod("mean")(c(1, 4, 7, 10, 13)), <environment>), error =
> .rcpp_error_recorder)
> debug: {
>      tryCatchList <- function(expr, names, parentenv, handlers) {
>          nh <- length(names)
>          if (nh > 1L)
>              tryCatchOne(tryCatchList(expr, names[-nh], parentenv,
>                  handlers[-nh]), names[nh], parentenv, handlers[[nh]])
>          else if (nh == 1L)
>              tryCatchOne(expr, names, parentenv, handlers[[1L]])
>          else expr
>      }
>      tryCatchOne <- function(expr, name, parentenv, handler) {
>          doTryCatch <- function(expr, name, parentenv, handler) {
>              .Internal(.addCondHands(name, list(handler), parentenv,
>                  environment(), FALSE))
>              expr
>          }
>          value <- doTryCatch(return(expr), name, parentenv, handler)
>          if (is.null(value[[1L]])) {
>              msg <- .Internal(geterrmessage())
>              call <- value[[2L]]
>              cond <- simpleError(msg, call)
>          }
>          else cond <- value[[1L]]
> value[[3L]](cond)
>      }
>      if (!missing(finally))
>          on.exit(finally)
>      handlers <- list(...)
>      classes <- names(handlers)
>      parentenv <- parent.frame()
>      if (length(classes) != length(handlers))
>          stop("bad handler specification")
>      tryCatchList(expr, classes, parentenv, handlers)
> }
> Browse[2]>
> debug: tryCatchList <- function(expr, names, parentenv, handlers) {
>      nh <- length(names)
>      if (nh > 1L)
> tryCatchOne(tryCatchList(expr, names[-nh], parentenv,
>              handlers[-nh]), names[nh], parentenv, handlers[[nh]])
>      else if (nh == 1L)
>          tryCatchOne(expr, names, parentenv, handlers[[1L]])
>      else expr
> }
> Browse[2]>
>
>
> that is, tryCatch() is TRIGGERED !!!
> so, is it the problem of the implementation of rowApply()?
> is there any way around that I could prevent the triggering of tryCatch()?
>
> Many thanks,
> Thomas

-- 
Romain Francois
Professional R Enthusiast
+33(0) 6 28 91 30 30