Improve and standardize handling of the 'workers' argument

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future.batchtools
-Version: 0.12.2-9943
+Version: 0.12.2-9944
 Depends:
     R (>= 3.2.0),
     parallelly,

R/BatchtoolsFutureBackend-class.R

@@ -4,12 +4,10 @@
 #'
 #' @param workers (optional) The maximum number of workers the batchtools
 #' backend may use at any time.   Interactive and "local" backends can only
-#' process one future at the time (`workers = 1L`), whereas HPC backends,
+#' process one future at the time (`workers = 1`), whereas HPC backends,
 #' where futures are resolved via separate jobs on a scheduler, can have
-#' multiple workers.  In the latter, the default is `workers = NULL`, which
-#' will resolve to
-#' \code{getOption("\link{future.batchtools.workers}")}.
-#' If neither are specified, then the default is `100`.
+#' multiple workers. In the latter, the default is `workers = NULL`, which
+#' will resolve to \code{getOption("\link{future.batchtools.workers}", 100)}.
 #'
 #' @param finalize If TRUE, a future's \pkg{batchtools}
 #' \link[batchtools:makeRegistry]{Registry} is automatically deleted when
@@ -42,7 +40,7 @@
 #' @keywords internal
 #' @export
 BatchtoolsFutureBackend <- function(
-                             workers = NULL, resources = list(),
+                             workers = 1L, resources = list(),
                              finalize = getOption("future.finalize", TRUE),
                              cluster.functions = NULL,
                              registry = list(),
@@ -52,23 +50,12 @@ BatchtoolsFutureBackend <- function(
   assert_no_positional_args_but_first()
 
   if (is.function(workers)) workers <- workers()
-  if (is.null(workers)) {
-    workers <- getOption("future.batchtools.workers", default = 100)
-    stop_if_not(
-      is.numeric(workers),
-      length(workers) == 1L,
-      !is.na(workers), workers >= 1
-    )
+  if (is.numeric(workers)) {
+    stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 1)
+  } else if (is.character(workers)) {
+    stop_if_not(length(workers) >= 1L, !anyNA(workers), all(nzchar(workers)))
   } else {
-    stop_if_not(length(workers) >= 1L)
-    if (is.numeric(workers)) {
-      stop_if_not(length(workers) == 1L, !is.na(workers), workers >= 1)
-    } else if (is.character(workers)) {
-      stop_if_not(length(workers) >= 0L, !anyNA(workers))
-    } else {
-      stop("Argument 'workers' should be either a numeric or a function: ",
-           mode(workers))
-    }
+    stop("Argument 'workers' should be either a numeric, a character vector, or a function: ", mode(workers))
   }
 
   if (!is.null(cluster.functions)) {

R/BatchtoolsTemplateFutureBackend-class.R

@@ -40,10 +40,18 @@
 #' @importFrom batchtools makeClusterFunctionsSlurm
 #' @importFrom batchtools makeClusterFunctionsTORQUE
 #' @export
-BatchtoolsTemplateFutureBackend <- function(type = c("lsf", "openlava", "sge", "slurm", "torque"), scheduler.latency = 1.0, fs.latency = 65.0, template = NULL, ...) {
+BatchtoolsTemplateFutureBackend <- function(type = c("lsf", "openlava", "sge", "slurm", "torque"), scheduler.latency = 1.0, fs.latency = 65.0, template = NULL, workers = getOption("future.batchtools.workers", default = 100L), ...) {
   assert_no_positional_args_but_first()
   type <- match.arg(type)
 
+  if (is.function(workers)) workers <- workers()
+  stop_if_not(
+    is.numeric(workers),
+    length(workers) == 1L,
+    !is.na(workers),
+    is.finite(workers),
+    workers >= 1
+  )
 
   dotdotdot <- list(...)
 
@@ -77,6 +85,7 @@ BatchtoolsTemplateFutureBackend <- function(type = c("lsf", "openlava", "sge", "
 
   args <- dotdotdot
   args[["cluster.functions"]] <- cluster.functions
+  args[["workers"]] <- workers
 
   core <- do.call(BatchtoolsMultiprocessFutureBackend, args = args)
 

R/batchtools_bash.R

@@ -11,7 +11,12 @@ BatchtoolsBashFutureBackend <- function(...,
     template = "bash") {
   assert_no_positional_args_but_first()
 
-  core <- BatchtoolsMultiprocessFutureBackend(
+  args <- list(...)
+  if ("workers" %in% names(args)) {
+    stop("Unknown argument 'workers'")
+  }
+  
+  core <- BatchtoolsUniprocessFutureBackend(
     ...,
     cluster.functions = cluster.functions,
     template = template
@@ -112,7 +117,7 @@ makeClusterFunctionsBash <- function(template = "bash", fs.latency = 0.0) {
     stop_if_not(inherits(jc, "JobCollection"))
 
     script <- cfBrewTemplate(reg, text = template_text, jc = jc)
-    output <- system2(bin, args = c(script), stdout = TRUE, stderr = TRUE)
+    output <- system2(bin, args = c(script), stdout = TRUE, stderr = TRUE, wait = TRUE)
     debug <- isTRUE(getOption("future.debug"))
     if (debug) {
       mdebug_push("makeClusterFunctionsBash() ...")

R/batchtools_interactive.R

@@ -6,6 +6,11 @@
 BatchtoolsInteractiveFutureBackend <- function(fs.latency = 0.0, ...) {
   assert_no_positional_args_but_first()
 
+  args <- list(...)
+  if ("workers" %in% names(args)) {
+    stop("Unknown argument 'workers'")
+  }
+
   core <- BatchtoolsUniprocessFutureBackend(
     cluster.functions = makeClusterFunctionsInteractive(fs.latency = fs.latency, external = FALSE),
     ...

R/batchtools_local.R

@@ -38,6 +38,11 @@
 BatchtoolsLocalFutureBackend <- function(fs.latency = 0.0, ...) {
   assert_no_positional_args_but_first()
 
+  args <- list(...)
+  if ("workers" %in% names(args)) {
+    stop("Unknown argument 'workers'")
+  }
+
   core <- BatchtoolsUniprocessFutureBackend(
     cluster.functions = makeClusterFunctionsInteractive(fs.latency = fs.latency, external = TRUE),
     ...

R/batchtools_lsf.R

@@ -48,7 +48,7 @@ BatchtoolsLsfFutureBackend <- function(...) {
 #' * <https://en.wikipedia.org/wiki/IBM_Spectrum_LSF>
 #'
 #' @export
-batchtools_lsf <- function(..., template = "lsf", scheduler.latency = 1.0, fs.latency = 65.0, resources = list()) {
+batchtools_lsf <- function(..., template = "lsf", scheduler.latency = 1.0, fs.latency = 65.0, resources = list(), workers = getOption("future.batchtools.workers", default = 100L)) {
  stop("INTERNAL ERROR: The future.batchtools::batchtools_lsf() must never be called directly")
 }
 class(batchtools_lsf) <- c(

R/batchtools_multicore.R

@@ -36,13 +36,12 @@ BatchtoolsMulticoreFutureBackend <- function(workers = availableCores(constraint
   assert_no_positional_args_but_first()
 
   if (is.function(workers)) workers <- workers()
-  if (is.null(workers)) {
-    workers <- getOption("future.batchtools.workers", default = 100L)
-  }
   stop_if_not(
     is.numeric(workers),
     length(workers) == 1,
-    !is.na(workers), workers >= 1
+    !is.na(workers),
+    is.finite(workers),
+    workers >= 1
   )
 
   ## Fall back to batchtools_local if multicore processing is not supported

R/batchtools_openlava.R

@@ -48,7 +48,7 @@ BatchtoolsOpenLavaFutureBackend <- function(...) {
 #' * <https://en.wikipedia.org/wiki/OpenLava>
 #'
 #' @export
-batchtools_openlava <- function(..., template = "openlava", scheduler.latency = 1.0, fs.latency = 65.0, resources = list()) {
+batchtools_openlava <- function(..., template = "openlava", scheduler.latency = 1.0, fs.latency = 65.0, resources = list(), workers = getOption("future.batchtools.workers", default = 100L)) {
  stop("INTERNAL ERROR: The future.batchtools::batchtools_openlava() must never be called directly")
 }
 class(batchtools_openlava) <- c(

R/batchtools_sge.R

@@ -52,7 +52,7 @@ BatchtoolsSGEFutureBackend <- function(...) {
 #' * <https://en.wikipedia.org/wiki/Oracle_Grid_Engine>
 #'
 #' @export
-batchtools_sge <- function(..., template = "sge", scheduler.latency = 1.0, fs.latency = 65.0, resources = list()) {
+batchtools_sge <- function(..., template = "sge", scheduler.latency = 1.0, fs.latency = 65.0, resources = list(), workers = getOption("future.batchtools.workers", default = 100L)) {
  stop("INTERNAL ERROR: The future.batchtools::batchtools_sge() must never be called directly")
 }
 class(batchtools_sge) <- c(