R/zzz.R

In bamonroe/ctools: Unified Syntax for Parallel Operations in R

cluster <- new.env(parent = emptyenv())

# Stuff for Rcpp code

#' @useDynLib ctools
#' @importFrom Rcpp sourceCpp

.onLoad <- function(libname, pkgname) {

	is.unix <- ifelse(.Platform$OS.type == "unix", T, F)
	assign("is.unix", is.unix, envir = cluster)

	if (is.unix) {
		mpi.check <- ifelse(system2("pgrep", "mpirun", stdout = F) == 0, T, F)
		mpi.check <- requireNamespace("Rhpc", quietly = TRUE) & mpi.check
	} else{
		mpi.check <- F
	}
	assign("mpi.check", mpi.check, envir = cluster)

	# Check if the current process is actually a cluster node
	mpi.rank <- getOption("Rhpc.mpi.rank", default = FALSE)
	mpi.node <- ifelse(is.numeric(mpi.rank), TRUE, FALSE)

	assign("mpi.node", mpi.node, envir = cluster)

	if ( !mpi.node ) {
	
		if (mpi.check == T) {
			use.MPI()
			assign("use.mpi", T, envir = cluster)
			assign("use.fork", F, envir = cluster)
		} else if (is.unix) {
			use.FORK()
			assign("use.mpi", F, envir = cluster)
			assign("use.fork", T, envir = cluster)
		} else {
			use.PSOCKS()
			assign("use.mpi", F, envir = cluster)
			assign("use.fork", F, envir = cluster)
		}

		reg.finalizer(
				e = parent.env(environment()),
				f = function(env) {
					use.cluster <- get("use.cluster", envir = cluster)
					if (use.cluster & get("use.mpi", envir = cluster)) {
						cluster$cluster.done()
					} else if (use.cluster) {
						cluster$cluster.done(get("cluster.object", envir = cluster))
					}
				},
			onexit = TRUE)
	}
}