1# Author: Matteo Mattiuzzi and Robert J. Hijmans
2# Date : November 2010
3# Version 1.0
4# Licence GPL v3
5
6
7
8.recvOneData <- eval(parse(text="parallel:::recvOneData"))
9
10beginCluster <- function(n, type='SOCK', nice, exclude=NULL) {
11	if (! requireNamespace("parallel") ) {
12		stop('you need to install the "parallel" package')
13	}
14
15	if (exists('raster_Cluster_raster_Cluster', envir=.GlobalEnv)) {
16		endCluster()
17	}
18
19	if (missing(n)) {
20		n <- parallel::detectCores()
21		message(n, ' cores detected, using ', n-1)
22		n <- n-1
23	}
24
25#	if (missing(type)) {
26#		type <- getClusterOption("type")
27#		message('cluster type:', type)
28#	}
29
30	cl <- parallel::makeCluster(n, type)
31	cl <- .addPackages(cl, exclude=exclude)
32	options(rasterClusterObject = cl)
33	options(rasterClusterCores = length(cl))
34	options(rasterCluster = TRUE)
35	options(rasterClusterExclude = exclude)
36
37
38	if (!missing(nice)){
39        if (.Platform$OS.type == 'unix') {
40            cmd <- paste("renice",nice,"-p")
41            foo <- function() system(paste(cmd, Sys.getpid()))
42            parallel::clusterCall(cl,foo)
43        } else {
44            warning("argument 'nice' only supported on UNIX like operating systems")
45        }
46    }
47
48}
49
50
51endCluster <- function() {
52	options(rasterCluster = FALSE)
53	cl <- options('rasterClusterObject')[[1]]
54	if (! is.null(cl)) {
55		parallel::stopCluster( cl )
56		options(rasterClusterObject = NULL)
57	}
58}
59
60
61.doCluster <- function() {
62	if ( isTRUE( getOption('rasterCluster')) ) {
63		return(TRUE)
64	}
65	return(FALSE)
66}
67
68
69getCluster <- function() {
70	cl <- getOption('rasterClusterObject')
71	if (is.null(cl)) { stop('no cluster available, first use "beginCluster"') }
72	cl <- .addPackages(cl, exclude=c('raster', 'sp', getOption('rasterClusterExclude')))
73	options( rasterClusterObject = cl )
74	options( rasterCluster = FALSE )
75	return(cl)
76}
77
78
79returnCluster <- function() {
80	cl <- getOption('rasterClusterObject')
81	if (is.null(cl)) { stop('no cluster available') }
82	options( rasterCluster = TRUE )
83}
84
85
86.addPackages <- function(cl, exclude=NULL) {
87	pkgs <- .packages()
88	i <- which( pkgs %in% c(exclude, "stats", "graphics", "grDevices", "utils", "datasets", "methods", "base") )
89	pkgs <- rev( pkgs[-i] )
90	for ( pk in pkgs ) {
91		parallel::clusterCall(cl, library, pk, character.only=TRUE )
92	}
93	return(cl)
94}
95
96