nbrOfFreeWorkers(): Start migrating to FutureBackend

Author: HenrikBengtsson

NAMESPACE

@@ -29,20 +29,18 @@ S3method(mandelbrot,matrix)
 S3method(mandelbrot,numeric)
 S3method(nbrOfFreeWorkers,"NULL")
 S3method(nbrOfFreeWorkers,ClusterFutureBackend)
+S3method(nbrOfFreeWorkers,MulticoreFutureBackend)
+S3method(nbrOfFreeWorkers,MultiprocessFutureBackend)
 S3method(nbrOfFreeWorkers,SequentialFutureBackend)
-S3method(nbrOfFreeWorkers,cluster)
 S3method(nbrOfFreeWorkers,future)
 S3method(nbrOfFreeWorkers,logical)
-S3method(nbrOfFreeWorkers,multicore)
 S3method(nbrOfFreeWorkers,multiprocess)
-S3method(nbrOfFreeWorkers,uniprocess)
 S3method(nbrOfWorkers,"NULL")
 S3method(nbrOfWorkers,ClusterFutureBackend)
+S3method(nbrOfWorkers,MulticoreFutureBackend)
 S3method(nbrOfWorkers,SequentialFutureBackend)
-S3method(nbrOfWorkers,cluster)
 S3method(nbrOfWorkers,future)
 S3method(nbrOfWorkers,multiprocess)
-S3method(nbrOfWorkers,uniprocess)
 S3method(plot,Mandelbrot)
 S3method(print,Future)
 S3method(print,FutureCondition)

R/utils_api-nbrOfWorkers.R

@@ -27,28 +27,27 @@ nbrOfWorkers.ClusterFutureBackend <- function(evaluator) {
 }
 
 #' @export
-nbrOfWorkers.SequentialFutureBackend <- function(evaluator) {
-  1L
-}
-
-#' @export
-nbrOfWorkers.cluster <- function(evaluator) {
+nbrOfWorkers.MulticoreFutureBackend <- function(evaluator) {
   assert_no_positional_args_but_first()
-  backend <- makeFutureBackend(evaluator)
-  nbrOfWorkers(backend)
+  backend <- evaluator
+  workers <- backend[["workers"]]
+  stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 1L, is.finite(workers))
+  workers
 }
 
 #' @export
-nbrOfWorkers.uniprocess <- function(evaluator) {
-  assert_no_positional_args_but_first()
-  backend <- makeFutureBackend(evaluator)
-  nbrOfWorkers(backend)
+nbrOfWorkers.SequentialFutureBackend <- function(evaluator) {
+  1L
 }
 
 
 #' @export
 nbrOfWorkers.multiprocess <- function(evaluator) {
   assert_no_positional_args_but_first()
+  backend <- makeFutureBackend(evaluator)
+  if (inherits(backend, "FutureBackend")) {
+    return(nbrOfWorkers(backend))
+  }  
 
   expr <- formals(evaluator)$workers
   workers <- eval(expr, enclos = baseenv())
@@ -62,6 +61,7 @@ nbrOfWorkers.multiprocess <- function(evaluator) {
   workers
 }
 
+
 #' @export
 nbrOfWorkers.future <- function(evaluator) {
   assert_no_positional_args_but_first()
@@ -130,48 +130,49 @@ nbrOfFreeWorkers.ClusterFutureBackend <- function(evaluator, ...) {
 }
 
 #' @export
-nbrOfFreeWorkers.SequentialFutureBackend <- function(evaluator, background = FALSE, ...) {
+nbrOfFreeWorkers.MulticoreFutureBackend <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
-  if (isTRUE(background)) 0L else 1L
+  backend <- evaluator
+  workers <- backend[["workers"]]
+  workers <- workers - usedCores()
+  stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 0L, is.finite(workers))
+  workers
 }
 
-
 #' @export
-nbrOfFreeWorkers.cluster <- function(evaluator, background = FALSE, ...) {
+nbrOfFreeWorkers.MultiprocessFutureBackend <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
-  backend <- makeFutureBackend(evaluator)
-  nbrOfFreeWorkers(backend, background = background, ...)
+  backend <- evaluator
+  stopf("nbrOfFreeWorkers() is not implemented for this type of future backend (please contacts the maintainer of that backend): %s", commaq(class(evaluator)))
 }
 
-
 #' @export
-nbrOfFreeWorkers.uniprocess <- function(evaluator, background = FALSE, ...) {
+nbrOfFreeWorkers.SequentialFutureBackend <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
-
   if (isTRUE(background)) 0L else 1L
 }
 
-#' @export
-nbrOfFreeWorkers.multicore <- function(evaluator, background = FALSE, ...) {
-  assert_no_positional_args_but_first()
-  
-  workers <- nbrOfWorkers(evaluator)
-  
-  workers <- workers - usedCores()
-  stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 0L, is.finite(workers))
-
-  workers
-}
 
 #' @export
 nbrOfFreeWorkers.multiprocess <- function(evaluator, background = FALSE, ...) {
+  assert_no_positional_args_but_first()
+  backend <- makeFutureBackend(evaluator)
+  if (inherits(backend, "FutureBackend")) {
+    return(nbrOfFreeWorkers(backend, background = background, ...))
+  }  
   stopf("nbrOfFreeWorkers() is not implemented for this type of future backend (please contacts the maintainer of that backend): %s", commaq(class(evaluator)))
 }
 
+
 #' @export
 nbrOfFreeWorkers.future <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
 
+  backend <- makeFutureBackend(evaluator)
+  if (inherits(backend, "FutureBackend")) {
+    return(nbrOfFreeWorkers(backend, background = background, ...))
+  }  
+
   workers <- nbrOfWorkers(evaluator)
   if (is.infinite(workers)) return(workers)
 

man/FutureBackend.Rd

@@ -100,11 +100,6 @@ n <- nbrOfWorkers()
 message(sprintf("nbrOfWorkers: %d", n))
 stopifnot(n == max(1L, nworkers - 1L))
 
-message("Type of future: constant")
-n <- nbrOfWorkers(constant)
-message(sprintf("nbrOfWorkers: %d", n))
-stopifnot(n == 1)
-
 message("Type of future: <future>")
 foo <- structure(function(...) NULL, class = c("future"))
 n <- nbrOfWorkers(foo)