1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
#' @importFrom parallel stopCluster
ClusterRegistry <- local({
last <- NULL
cluster <- NULL
function(action = c("get", "start", "stop"), workers = NULL, makeCluster = .makeCluster, ...) {
action <- match.arg(action, choices = c("get", "start", "stop"))
if (is.null(workers)) {
} else if (is.numeric(workers)) {
workers <- as.integer(workers)
stop_if_not(length(workers) == 1, is.finite(workers))
} else if (is.character(workers)) {
stop_if_not(length(workers) >= 1, !anyNA(workers))
workers <- sort(workers)
} else {
stop("Unknown mode of argument 'workers': ", mode(workers))
}
if (length(cluster) == 0L && action != "stop") {
cluster <<- makeCluster(workers, ...)
last <<- workers
}
if (action == "get") {
return(cluster)
} else if (action == "start") {
## Already setup?
if (!identical(workers, last)) {
ClusterRegistry(action = "stop")
cluster <<- makeCluster(workers, ...)
last <<- workers
}
} else if (action == "stop") {
if (length(cluster) > 0L) try(stopCluster(cluster), silent = TRUE)
cluster <<- NULL
last <<- NULL
}
invisible(cluster)
}
}) ## ClusterRegistry()
.makeCluster <- function(workers, ...) {
if (length(workers) == 0L) return(NULL)
makeClusterPSOCK(workers, ...)
} ## .makeCluster()
|
