R/run_parallel.R

In kenkellner/jagsUI2: A Wrapper Around 'rjags' to Streamline 'JAGS' Analyses

run_parallel <- function(run_dat){

  #Output object
  out <- list()

  if( run_dat$n_cores > parallel::detectCores() ){ 
    stop('You have specified too many cores') 
  }

  #Set up cluster
  #Use FORK if on linux
  ctype <- 'PSOCK'
  if(.Platform$OS.type=='unix') ctype <- 'FORK'

  if(!run_dat$quiet){ 
    cat('Initializing cluster\n')
    cl <- parallel::makeCluster(run_dat$n_cores,outfile="",mc.silent=T,
                                type=ctype)
  } else {
    cl <- parallel::makeCluster(run_dat$n_cores,mc.silent=T, type=ctype)
  }
  on.exit(parallel::stopCluster(cl))

  if(ctype == 'PSOCK'){
    parallel::clusterExport(cl = cl, ls(), envir = environment())
    parallel::clusterEvalQ(cl, .libPaths(.libPaths()))
  }

  #Function to run 1 chain in each core
  jags_par <- function(x){
    run_dat$n_chains <- 1
    run_dat$this_chain <- x
    run_dat$model_object <- run_dat$model_object[[x]]
    run_dat$inits <- run_dat$inits[[x]]
    run_model(run_dat)
  }

  #Distribute chains among cores
  out_raw <- parallel::clusterApply(cl=cl, x=1:run_dat$n_chains, fun=jags_par)

  #Format output
  out$samples <- lapply(lapply(out_raw,`[[`,1),`[[`,1)
  class(out$samples) <- 'mcmc.list'
  out$model <- lapply(out_raw,`[[`,2)
  
  return(out)

}