[Bioc-devel] BiocParallel

Here are two alternative implementations of pvec. pvec2 is just a simple rewrite
of pvec to use mclapply. pvec3 then extends pvec2 to accept a specified chunk
size or a specified number of chunks. If the number of chunks exceeds the number
of cores, then multiple chunks will get run sequentially on each core. pvec3
also exposes the "mc.prescheule" argument of mclapply, since that is relevant
when there are more chunks than cores. Lastly, I provide a "pvectorize" function
which can be called on a regular vectorized function to make it into a pvec'd
version of itself. Usage is like: sqrt.parallel <- pvectorize(sqrt);
sqrt.parallel(1:1000).

pvec2 <- function(v, FUN, ..., mc.set.seed = TRUE, mc.silent = FALSE,
                   mc.cores = getOption("mc.cores", 2L), mc.cleanup = TRUE)
{
   env <- parent.frame()
   cores <- as.integer(mc.cores)
   if(cores < 1L) stop("'mc.cores' must be >= 1")
   if(cores == 1L) return(FUN(v, ...))

   if(mc.set.seed) mc.reset.stream()

   n <- length(v)
   si <- splitIndices(n, cores)
   res <- do.call(c,
                  mclapply(si, function(i) FUN(v[i], ...),
                           mc.set.seed=mc.set.seed,
                           mc.silent=mc.silent,
                           mc.cores=mc.cores,
                           mc.cleanup=mc.cleanup))
   if (length(res) != n)
     warning("some results may be missing, folded or caused an error")
   res
}
pvec3 <- function(v, FUN, ..., mc.set.seed = TRUE, mc.silent = FALSE,
                   mc.cores = getOption("mc.cores", 2L), mc.cleanup = TRUE,
                   mc.preschedule=FALSE, num.chunks, chunk.size)
{
   env <- parent.frame()
   cores <- as.integer(mc.cores)
   if(cores < 1L) stop("'mc.cores' must be >= 1")
   if(cores == 1L) return(FUN(v, ...))

   if(mc.set.seed) mc.reset.stream()

   n <- length(v)
   if (missing(num.chunks)) {
     if (missing(chunk.size)) {
       num.chunks <- cores
     } else {
       num.chunks <- ceiling(n/chunk.size)
     }
   }
   si <- splitIndices(n, num.chunks)
   res <- do.call(c,
                  mclapply(si, function(i) FUN(v[i], ...),
                           mc.set.seed=mc.set.seed,
                           mc.silent=mc.silent,
                           mc.cores=mc.cores,
                           mc.cleanup=mc.cleanup,
                           mc.preschedule=mc.preschedule))
   if (length(res) != n)
     warning("some results may be missing, folded or caused an error")
   res
}

pvectorize <- function(FUN) {
   function(...) pvec3(FUN=FUN, ...)
}

[Bioc-devel] BiocParallel

Thread (33 messages)