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

[Thomas Tse]

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:

> 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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.r-forge.r-project.org/pipermail/rcpp-devel/attachments/20131003/f5c6941e/attachment.html>