R tips: Determine if function is called from specific package

I like the {multicore} library for a particular task. I can easily write a combination of if(require("multicore",...)) that means that my function will automatically use the parallel mclapply() instead of lapply() where it is available. Which is grand 99% of the time, except when my function is called from mclapply() (or one of the lower level functions) in which case much CPU trashing and grinding of teeth will result.

So, I needed a function to determine if my function was called from any function in the {multicore} library. Here it is.

First define a generally useful function:

is.in.namespace <-
function (ns) {
  for ( frame in seq(1, sys.nframe(), 1) ) {
    fun <- sys.function(frame);
    env <- environment(fun)
    n   <- environmentName(env)
    if ( n == ns ) return(TRUE);
  }
  return(FALSE);
}

Then we use it for our purpose:

is.in.multicore <- function (...) { return(is.in.namespace("multicore")) }
library("multicore")
stopifnot( mclapply(as.list(1), is.in.multicore)[[1]] == TRUE )
stopifnot(   lapply(as.list(1), is.in.multicore)[[1]] == FALSE )
stopifnot( local( {mclapply <- function(x) return(x); mclapply(is.in.multicore())} ) == FALSE )

Easy when you know how.