Skip to content

Instantly share code, notes, and snippets.

@malcook
Created September 20, 2012 19:32
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save malcook/3757873 to your computer and use it in GitHub Desktop.
Save malcook/3757873 to your computer and use it in GitHub Desktop.
a retake on parallel:pvec
pvec2<-function(v, FUN, ..., mc.set.seed = TRUE, mc.silent = FALSE,
mc.cores = getOption("mc.cores", 2L), mc.cleanup = TRUE
,combineFUN = `c`
) {
### AUTHOR: malcolm_cook@stowers.org
### PURPOSE: an improvement(?) on parallel:pvec which
### (1) does not require v to be a vector, rather, v must
### implement `[`, `length`. Thus, i.e. BioConductor List (including
### GRangesList) is supported.
### (2) uses `parallel:splitIndices` to compute indices into v
### (3) takes an optional <combineFUN>, defaulting to `c`, which
### combines list of results from each job.
### (4) is backwards compatible (thus I've not renamed v as, e.g., X)
###
### Offered in reply to:
### http://thread.gmane.org/gmane.science.biology.informatics.conductor/43660
###
### TODO: > offer as contrib to parallel package (and removing "parallel:::")
### > let each job compute its own indices based on job sequence
### number instead of using splitIndices, thus spreading this work
### around and esp. removing need to serialize long vectors of
### indices between processes.
cores <- as.integer(mc.cores)
n<-length(v)
cores<-min(cores,n)
if (cores < 1L)
stop("'mc.cores' must be >= 1")
if (cores == 1L)
return(FUN(v, ...))
if (mc.set.seed)
mc.reset.stream()
si<-splitIndices(n,cores)
jobs <- NULL
cleanup <- function() {
if (length(jobs) && mc.cleanup) {
mccollect(parallel:::children(jobs), FALSE)
parallel:::mckill(parallel:::children(jobs), if (is.integer(mc.cleanup))
mc.cleanup
else 15L)
mccollect(parallel:::children(jobs))
}
if (length(jobs)) {
mccollect(parallel:::children(jobs), FALSE)
}
}
on.exit(cleanup())
FUN <- match.fun(FUN)
jobs <- Map(function(si) {mcparallel(
FUN(v[si],... )
,mc.set.seed = mc.set.seed
,silent = mc.silent)}
,si
)
res <- mccollect(jobs)
names(res) <- NULL
if(!missing(combineFUN)) {
combineFUN <- match.fun(combineFUN)
res <- do.call(combineFUN, res)
}
if (length(res) != n)
warning("some results may be missing, folded or caused an error")
res
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment