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