1#' Get the number of workers available
2#'
3#' @param evaluator A future evaluator function.
4#' If NULL (default), the current evaluator as returned
5#' by [plan()] is used.
6#'
7#' @return
8#' `nbrOfWorkers()` returns a positive number in \eqn{{1, 2, 3, ...}}, which
9#' for some future backends may also be `+Inf`.
10#'
11#' @example incl/nbrOfWorkers.R
12#'
13#' @export
14nbrOfWorkers <- function(evaluator = NULL) {
15  UseMethod("nbrOfWorkers")
16}
17
18
19#' @export
20nbrOfWorkers.cluster <- function(evaluator) {
21  assert_no_positional_args_but_first()
22
23  expr <- formals(evaluator)$workers
24  workers <- eval(expr, enclos = baseenv())
25  if (is.function(workers)) workers <- workers()
26  if (is.character(workers)) {
27    stop_if_not(!anyNA(workers))
28    workers <- length(workers)
29  } else if (is.numeric(workers)) {
30  } else if (inherits(workers, "cluster")) {
31    workers <- length(workers)
32  } else {
33    stopf("Unsupported type of 'workers' for evaluator of class %s: %s", paste(sQuote(class(evaluator)), collapse = ", "), class(workers)[1])
34  }
35  stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 1L, is.finite(workers))
36
37  workers
38}
39
40#' @export
41nbrOfWorkers.uniprocess <- function(evaluator) {
42  assert_no_positional_args_but_first()
43
44  1L
45}
46
47
48#' @export
49nbrOfWorkers.multiprocess <- function(evaluator) {
50  assert_no_positional_args_but_first()
51
52  expr <- formals(evaluator)$workers
53  workers <- eval(expr, enclos = baseenv())
54  if (is.function(workers)) workers <- workers()
55  if (is.numeric(workers)) {
56  } else {
57    stopf("Unsupported type of 'workers' for evaluator of class %s: %s", paste(sQuote(class(evaluator)), collapse = ", "), class(workers)[1])
58  }
59  stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 1L, is.finite(workers))
60
61  workers
62}
63
64#' @export
65nbrOfWorkers.future <- function(evaluator) {
66  assert_no_positional_args_but_first()
67
68  expr <- formals(evaluator)$workers
69  workers <- eval(expr, enclos = baseenv())
70  if (is.function(workers)) workers <- workers()
71  if (is.numeric(workers)) {
72  } else if (is.null(workers)) {
73    workers <- Inf
74  } else {
75    stopf("Unsupported type of 'workers' for evaluator of class %s: %s", paste(sQuote(class(evaluator)), collapse = ", "), class(workers)[1])
76  }
77  stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 1L)
78
79  workers
80}
81
82#' @export
83nbrOfWorkers.NULL <- function(evaluator) {
84  assert_no_positional_args_but_first()
85
86  nbrOfWorkers(plan("next"))
87}
88
89
90
91#' @param background If TRUE, only workers that can process a future in the
92#' background are considered.  If FALSE, also workers running in the main \R
93#' process are considered, e.g. when using the 'sequential' backend.
94#'
95#' @param \dots Not used; reserved for future use.
96#'
97#' @return
98#' `nbrOfFreeWorkers()` returns a non-negative number in
99#' \eqn{{0, 1, 2, 3, ...}} which is less than or equal to `nbrOfWorkers()`.
100#'
101#' @rdname nbrOfWorkers
102#' @export
103nbrOfFreeWorkers <- function(evaluator = NULL, background = FALSE, ...) {
104  UseMethod("nbrOfFreeWorkers")
105}
106
107
108#' @export
109nbrOfFreeWorkers.cluster <- function(evaluator, background = FALSE, ...) {
110  assert_no_positional_args_but_first()
111
112  workers <- nbrOfWorkers(evaluator)
113
114  ## Create a dummy, lazy future based on the future strategy ("evaluator")
115  f <- evaluator(NULL, lazy = TRUE)
116  name <- attr(f$workers, "name", exact = TRUE)
117  stop_if_not(is.character(name), length(name) == 1L)
118  reg <- sprintf("workers-%s", name)
119  ## Number of unresolved cluster futures
120  usedNodes <- length(FutureRegistry(reg, action = "list", earlySignal = FALSE))
121
122  workers <- workers - usedNodes
123  stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 0L, is.finite(workers))
124
125  workers
126}
127
128
129#' @export
130nbrOfFreeWorkers.uniprocess <- function(evaluator, background = FALSE, ...) {
131  assert_no_positional_args_but_first()
132
133  if (isTRUE(background)) 0L else 1L
134}
135
136#' @export
137nbrOfFreeWorkers.multicore <- function(evaluator, background = FALSE, ...) {
138  assert_no_positional_args_but_first()
139
140  workers <- nbrOfWorkers(evaluator)
141
142  workers <- workers - usedCores()
143  stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 0L, is.finite(workers))
144
145  workers
146}
147
148#' @export
149nbrOfFreeWorkers.multiprocess <- function(evaluator, background = FALSE, ...) {
150  stopf("nbrOfFreeWorkers() is not implemented for this type of future backend (please contacts the maintainer of that backend): %s", paste(sQuote(class(evaluator)), collapse = ", "))
151}
152
153#' @export
154nbrOfFreeWorkers.future <- function(evaluator, background = FALSE, ...) {
155  assert_no_positional_args_but_first()
156
157  workers <- nbrOfWorkers(evaluator)
158  if (is.infinite(workers)) return(workers)
159
160  stopf("nbrOfFreeWorkers() is not implemented for this type of future backend (please contacts the maintainer of that backend): %s", paste(sQuote(class(evaluator)), collapse = ", "))
161}
162
163
164#' @export
165nbrOfFreeWorkers.NULL <- function(evaluator, background = FALSE, ...) {
166  assert_no_positional_args_but_first()
167
168  nbrOfFreeWorkers(plan("next"), background = background, ...)
169}
170
171
172#' @export
173nbrOfFreeWorkers.logical <- function(evaluator, background = FALSE, ...) {
174  assert_no_positional_args_but_first()
175  if (missing(background)) {
176    stop("Arguments 'background' of nbrOfFreeWorkers() must be named, if used")
177  }
178  nbrOfFreeWorkers(NULL, background = force(background), ...)
179}
180