https://github.com/cran/multicore
Raw File
Tip revision: a37f1e7f79de8cf9f3cac3b63c814d7e631eda2e authored by Simon Urbanek on 08 August 1977, 00:00:00 UTC
version 0.1-1
Tip revision: a37f1e7
parallel.R
parallel <- function(expr, name, mc.set.seed=FALSE) {
  f <- fork()
  env <- parent.frame()
  if (inherits(f, "masterProcess")) {
    on.exit(exit(1, structure("fatal error in wrapper code",class="try-error")))
    if (isTRUE(mc.set.seed)) set.seed(Sys.getpid())
    sendMaster(try(eval(expr, env), silent=TRUE))
    exit(0)
  }
  if (!missing(name)) f$name <- as.character(name)[1]
  class(f) <- c("parallelJob", class(f))
  f
}

collect <- function(jobs, wait=TRUE, timeout=0, intermediate=FALSE) {
  if (missing(jobs)) jobs <- children()
  if (isTRUE(intermediate)) intermediate <- str
  if (!wait) {
    s <- selectChildren(jobs, timeout)
    if (is.logical(s) || !length(s)) return(NULL)
    lapply(s, function(x) { r <- readChild(x); if (is.raw(r)) unserialize(r) else NULL })
  } else {
    pids <- if (inherits(jobs, "process") || is.list(jobs)) processID(jobs) else jobs
    if (!length(pids)) return(NULL)
    if (!is.numeric(pids)) stop("invalid jobs argument")
    pids <- as.integer(pids)
    pnames <- as.character(pids)
    if (!inherits(jobs, "process") && is.list(jobs))
      for(i in seq(jobs)) if (!is.null(jobs[[i]]$name)) pnames[i] <- as.character(jobs[[i]]$name)
    res <- lapply(pids, function(x) NULL)
    names(res) <- pnames
    fin <- rep(FALSE, length(jobs))
    while (!all(fin)) {
      s <- selectChildren(pids, 0.5)
      if (is.integer(s)) {
        for (pid in s) {
          r <- readChild(pid)
          if (is.integer(r) || is.null(r)) fin[pid==pids] <- TRUE
          if (is.raw(r)) res[[which(pid==pids)]] <- unserialize(r)
        }
        if (is.function(intermediate)) intermediate(res)
      } else if (all(is.na(match(pids, processID(children()))))) break
    }
    res
  }
}
back to top