Implement BatchtoolsInteractiveFutureBackend

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future.batchtools
-Version: 0.12.1-9102
+Version: 0.12.1-9103
 Depends:
     R (>= 3.2.0),
     parallelly,

NAMESPACE

@@ -35,6 +35,7 @@ export(BatchtoolsFuture)
 export(BatchtoolsFutureBackend)
 export(BatchtoolsFutureError)
 export(BatchtoolsInteractiveFuture)
+export(BatchtoolsInteractiveFutureBackend)
 export(BatchtoolsLocalFuture)
 export(BatchtoolsLocalFutureBackend)
 export(BatchtoolsLsfFuture)

R/backend_api-BatchtoolsInteractiveFutureBackend.R

@@ -0,0 +1,31 @@
+#' @rdname BatchtoolsFutureBackend
+#' @importFrom batchtools makeClusterFunctionsInteractive
+#' @export
+BatchtoolsInteractiveFutureBackend <- function(..., cluster.functions = NULL) {
+  cluster.functions <- makeClusterFunctionsInteractive(external = FALSE)
+  core <- BatchtoolsFutureBackend(
+    ...,
+    cluster.functions = cluster.functions
+  )
+  
+  core[["futureClasses"]] <- c("BatchtoolsInteractiveFuture", core[["futureClasses"]])
+  core <- structure(core, class = c("BatchtoolsInteractiveFutureBackend", "BatchtoolsSequentialFutureBackend", setdiff(class(core), "MultiprocessFutureBackend")))
+  core
+}
+
+
+#' @inheritParams BatchtoolsUniprocessFuture
+#'
+#' @importFrom batchtools makeClusterFunctionsInteractive
+#' @export
+batchtools_interactive <- function(..., envir = parent.frame()) {
+  stop("INTERNAL ERROR: The future.batchtools::batchtools_sequential() function implements the FutureBackend and should never be called directly")
+}
+class(batchtools_interactive) <- c(
+  "batchtools_interactive", "batchtools_uniprocess", "batchtools",
+  "uniprocess", "future", "function"
+)
+attr(batchtools_interactive, "tweakable") <- c("finalize")
+attr(batchtools_interactive, "untweakable") <- c("workers")
+attr(batchtools_interactive, "factory") <- BatchtoolsInteractiveFutureBackend
+

R/batchtools_interactive.R

@@ -1,11 +1,13 @@
 library(future.batchtools)
 library(listenv)
 
-message("*** batchtools_interactive() ...")
+message("*** 'batchtools_interactive' ...")
 
-message("*** batchtools_interactive() without globals")
+plan(batchtools_interactive)
 
-f <- batchtools_interactive({
+message("*** 'batchtools_interactive' without globals")
+
+f <- future({
   42L
 })
 stopifnot(inherits(f, "BatchtoolsFuture"))
@@ -20,10 +22,10 @@ print(y)
 stopifnot(y == 42L)
 
 
-message("*** batchtools_interactive() with globals")
+message("*** 'batchtools_interactive' with globals")
 ## A global variable
 a <- 0
-f <- batchtools_interactive({
+f <- future({
   b <- 3
   c <- 2
   a * b * c
@@ -42,15 +44,15 @@ print(v)
 stopifnot(v == 0)
 
 
-message("*** batchtools_interactive() with globals (tricky)")
+message("*** 'batchtools_interactive' with globals (tricky)")
 x <- listenv()
-for (ii in 1:2) x[[ii]] <- batchtools_interactive({ ii }, globals = TRUE)
+for (ii in 1:2) x[[ii]] <- future({ ii }, globals = TRUE)
 v <- unlist(value(x))
 stopifnot(all(v == 1:2))  ## Make sure globals are frozen
 
 
-message("*** batchtools_interactive() and errors")
-f <- batchtools_interactive({
+message("*** 'batchtools_interactive' and errors")
+f <- future({
   stop("Whoops!")
   1
 })
@@ -67,5 +69,5 @@ res <- try(value(f), silent = TRUE)
 print(res)
 stopifnot(inherits(res, "try-error"))
 
-message("*** batchtools_interactive() ... DONE")
+message("*** 'batchtools_interactive' ... DONE")