Add argument 'background' to nbrOfFreeWorkers() [#264] [ci skip]

NAMESPACE

@@ -21,6 +21,7 @@ S3method(mandelbrot,numeric)
 S3method(nbrOfFreeWorkers,"NULL")
 S3method(nbrOfFreeWorkers,cluster)
 S3method(nbrOfFreeWorkers,future)
+S3method(nbrOfFreeWorkers,logical)
 S3method(nbrOfFreeWorkers,multicore)
 S3method(nbrOfFreeWorkers,multiprocess)
 S3method(nbrOfFreeWorkers,uniprocess)

R/nbrOfWorkers.R

@@ -88,6 +88,10 @@ nbrOfWorkers.NULL <- function(evaluator) {
 
 
 
+#' @param background If TRUE, only workers that can be process a future in the
+#' background are considered.  If FALSE, also workers running in the main \R
+#' process are considered, e.g. when using the 'sequential' backend.
+#'
 #' @param \dots Not used; reserved for future use.
 #'
 #' @return
@@ -96,13 +100,13 @@ nbrOfWorkers.NULL <- function(evaluator) {
 #'
 #' @rdname nbrOfWorkers
 #' @export
-nbrOfFreeWorkers <- function(evaluator = NULL, ...) {
+nbrOfFreeWorkers <- function(evaluator = NULL, background = FALSE, ...) {
   UseMethod("nbrOfFreeWorkers")
 }
 
 
 #' @export
-nbrOfFreeWorkers.cluster <- function(evaluator, ...) {
+nbrOfFreeWorkers.cluster <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
 
   workers <- nbrOfWorkers(evaluator)
@@ -123,14 +127,14 @@ nbrOfFreeWorkers.cluster <- function(evaluator, ...) {
 
 
 #' @export
-nbrOfFreeWorkers.uniprocess <- function(evaluator, ...) {
+nbrOfFreeWorkers.uniprocess <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
-  
-  1L
+
+  if (isTRUE(background)) 0L else 1L
 }
 
 #' @export
-nbrOfFreeWorkers.multicore <- function(evaluator, ...) {
+nbrOfFreeWorkers.multicore <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
 
   workers <- nbrOfWorkers(evaluator)
@@ -142,12 +146,12 @@ nbrOfFreeWorkers.multicore <- function(evaluator, ...) {
 }
 
 #' @export
-nbrOfFreeWorkers.multiprocess <- function(evaluator, ...) {
+nbrOfFreeWorkers.multiprocess <- function(evaluator, background = FALSE, ...) {
   stop("nbrOfFreeWorkers() is not implemented for this type of future backend (please contacts the maintainer of that backend): ", paste(sQuote(class(evaluator)), collapse = ", "))
 }
 
 #' @export
-nbrOfFreeWorkers.future <- function(evaluator, ...) {
+nbrOfFreeWorkers.future <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
 
   workers <- nbrOfWorkers(evaluator)
@@ -158,8 +162,18 @@ nbrOfFreeWorkers.future <- function(evaluator, ...) {
 
 
 #' @export
-nbrOfFreeWorkers.NULL <- function(evaluator, ...) {
+nbrOfFreeWorkers.NULL <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
 
-  nbrOfFreeWorkers(plan("next"))
+  nbrOfFreeWorkers(plan("next"), background = background, ...)
+}
+
+
+#' @export
+nbrOfFreeWorkers.logical <- function(evaluator, background = FALSE, ...) {
+  assert_no_positional_args_but_first()
+  if (missing(background)) {
+    stop("Arguments 'background' of nbrOfFreeWorkers() must be named, if used")
+  }
+  nbrOfFreeWorkers(NULL, background = force(background), ...)
 }

R/utils.R

@@ -9,8 +9,12 @@ isNA <- function(x) {
 assert_no_positional_args_but_first <- function(call = sys.call(sys.parent())) {
   ast <- as.list(call)
   if (length(ast) <= 2L) return()
-  names <- names(ast[-(1:2)])
-  if (is.null(names) || any(names == "")) {
+  ast <- ast[-(1:2)]
+  dots <- vapply(ast, FUN = identical, as.symbol("..."), FUN.VALUE = FALSE)
+  ast <- ast[!dots]
+  if (length(ast) == 0L) return()
+  names <- names(ast)
+  if (is.null(names) || any(names == "")) {    
     stop(sprintf("Function %s() requires that all arguments beyond the first one are passed by name and not by position: %s", as.character(call[[1L]]), deparse(call, width.cutoff = 100L)))
   }
 }