Merge branch 'release/0.6.0'

Author: HenrikBengtsson

.Rbuildignore

@@ -4,10 +4,15 @@
 ^.svn
 ^.git
 ^.make
-INSTALL[.]md
-OVERVIEW[.]md
-README[.]md
-CONDUCT[.]md
+^INSTALL[.]md$
+^OVERVIEW[.]md$
+^README[.]md$
+^CONDUCT[.]md$
+
+#----------------------------
+# devtools
+#----------------------------
+^revdep
 
 #----------------------------
 # Travis-CI et al.
@@ -42,6 +47,12 @@ Rplots.pdf$
 #----------------------------
 # Package specific
 #----------------------------
-^[.]batchtools[.]R$
+^[.]BatchJobs[.]R$
 [.]future
 
+#----------------------------
+# Miscellaneous
+#----------------------------
+^.ghi
+^.issues
+

DESCRIPTION

@@ -1,10 +1,10 @@
 Package: future.batchtools
-Version: 0.5.0
+Version: 0.6.0
 Depends:
     R (>= 3.2.0),
-    future (>= 1.5.0)
+    future (>= 1.6.1)
 Imports:
-    batchtools (>= 0.9.3)
+    batchtools (>= 0.9.6)
 Suggests:
     listenv,
     markdown,

NAMESPACE

@@ -44,6 +44,7 @@ importFrom(batchtools,makeClusterFunctionsTORQUE)
 importFrom(batchtools,makeRegistry)
 importFrom(batchtools,removeRegistry)
 importFrom(batchtools,saveRegistry)
+importFrom(batchtools,setJobNames)
 importFrom(batchtools,submitJobs)
 importFrom(batchtools,waitForJobs)
 importFrom(future,Future)
@@ -59,3 +60,4 @@ importFrom(utils,capture.output)
 importFrom(utils,file_test)
 importFrom(utils,sessionInfo)
 importFrom(utils,str)
+importFrom(utils,tail)

NEWS

@@ -1,6 +1,41 @@
 Package: future.batchtools
 ==========================
 
+Version: 0.6.0 [2017-09-10]
+
+NEW FEATURES:
+
+ o If the built-in attempts of batchtools for finding a default template file
+   fails, then system("templates", package = "future.batchtools") is searched
+   for template files as well.  Currently, there exists a `torque.tmpl` file.
+
+ o A job's name in the scheduler is now set as the future's label (requires
+   batchtools 0.9.4 or newer).  If no label is specified, the default job name
+   is controlled by batchtools.
+
+ o The period between each poll of the scheduler to check whether a future
+   (job) is finished or not now increases geometrically as a function of number
+   of polls.  This lowers the load on the scheduler for long running jobs.
+
+ o The error message for expired batchtools futures now include the last few
+   lines of the logged output, which sometimes includes clues on why the future
+   expired.  For instance, if a TORQUE / PBS job use more than the allocated
+   amount of memory it might be terminated by the scheduler leaving the message
+   "PBS: job killed: vmem 1234000 exceeded limit 1048576" in the output.
+   
+ o print() for BatchtoolsFuture returns the object invisibly.
+
+BUG FIXES:
+
+ o Calling future_lapply() with functions containing globals part of non-default
+   packages would when using batchtools futures give an error complaining that
+   the global is missing. This was due to updates in future (>= 1.4.0) that
+   broke this package.
+ 
+ o loggedOutput() for BatchtoolsFuture would always return NULL unless an error
+   had occurred.
+
+
 Version: 0.5.0 [2017-06-02]
 
  o First version submitted to CRAN.
@@ -68,5 +103,5 @@ GLOBALS:
 Version: 0.1.0 [2017-02-11]
 
  o Package created by porting the code of future.BatchJobs. This version passes
-   'R CMD check --as-cran' with all OK after a minimial amount of adjustments
+   'R CMD check --as-cran' with all OK after a minimal amount of adjustments
    to the ported code.

R/BatchtoolsFuture-class.R

@@ -42,8 +42,9 @@
 #' @importFrom batchtools submitJobs
 #' @keywords internal
 BatchtoolsFuture <- function(expr = NULL, envir = parent.frame(),
-                             substitute = TRUE, globals = TRUE,
-                             label = "batchtools", cluster.functions = NULL,
+                             substitute = TRUE,
+                             globals = TRUE, packages = NULL,
+                             label = NULL, cluster.functions = NULL,
                              resources = list(), workers = NULL,
                              finalize = getOption("future.finalize", TRUE),
                              ...) {
@@ -77,7 +78,7 @@ BatchtoolsFuture <- function(expr = NULL, envir = parent.frame(),
                    workers = workers, label = label, ...)
 
   future$globals <- gp$globals
-  future$packages <- gp$packages
+  future$packages <- unique(c(packages, gp$packages))
 
   ## Create batchtools registry
   reg <- temp_registry(label = future$label)
@@ -131,6 +132,8 @@ print.BatchtoolsFuture <- function(x, ...) {
     printf("batchtools Registry:\n  ")
     print(reg)
   }
+
+  invisible(x)
 }
 
 
@@ -237,8 +240,6 @@ loggedOutput.BatchtoolsFuture <- function(future, ...) {
     stop(BatchtoolsFutureError(msg, future = future))
   }
 
-  if (!"error" %in% stat) return(NULL)
-
   config <- future$config
   reg <- config$reg
   jobid <- config$jobid
@@ -305,7 +306,7 @@ value.BatchtoolsFuture <- function(future, signal = TRUE,
 run <- function(...) UseMethod("run")
 
 #' @importFrom future getExpression
-#' @importFrom batchtools batchExport batchMap saveRegistry
+#' @importFrom batchtools batchExport batchMap saveRegistry setJobNames
 run.BatchtoolsFuture <- function(future, ...) {
   if (future$state != "created") {
     label <- future$label
@@ -372,6 +373,12 @@ run.BatchtoolsFuture <- function(future, ...) {
   jobid <- batchMap(fun = geval, list(expr),
                     more.args = list(substitute = TRUE), reg = reg)
 
+  ## 1b. Set job name, if specified
+  label <- future$label
+  if (!is.null(label)) {
+    setJobNames(ids = jobid, names = label, reg = reg)
+  }
+  
   ## 2. Update
   future$config$jobid <- jobid
   mdebug("Created %s future #%d", class(future)[1], jobid$job.id)
@@ -420,6 +427,8 @@ await <- function(...) UseMethod("await")
 #' success, otherwise not.
 #' @param timeout Total time (in seconds) waiting before generating an error.
 #' @param delta The number of seconds to wait between each poll.
+#' @param alpha A factor to scale up the waiting time in each iteration such
+#' that the waiting time in the k:th iteration is \code{alpha ^ k * delta}.
 #' @param \ldots Not used.
 #'
 #' @return The value of the evaluated expression.
@@ -433,16 +442,19 @@ await <- function(...) UseMethod("await")
 #'
 #' @export
 #' @importFrom batchtools getErrorMessages loadResult waitForJobs
+#' @importFrom utils tail
 #' @keywords internal
 await.BatchtoolsFuture <- function(future, cleanup = TRUE,
                                    timeout = getOption("future.wait.timeout",
                                                        30 * 24 * 60 * 60),
                                    delta = getOption("future.wait.interval",
                                                      1.0),
+                                   alpha = getOption("future.wait.alpha", 1.01),
                                    ...) {
   mdebug <- import_future("mdebug")
   stopifnot(is.finite(timeout), timeout >= 0)
-
+  stopifnot(is.finite(alpha), alpha > 0)
+  
   debug <- getOption("future.debug", FALSE)
 
   expr <- future$expr
@@ -456,7 +468,10 @@ await.BatchtoolsFuture <- function(future, cleanup = TRUE,
   oopts <- options(batchtools.verbose = debug)
   on.exit(options(oopts))
 
-  res <- waitForJobs(ids = jobid, timeout = timeout, sleep = delta,
+  ## Sleep function - increases geometrically as a function of iterations
+  sleep_fcn <- function(i) delta * alpha ^ (i - 1)
+ 
+  res <- waitForJobs(ids = jobid, timeout = timeout, sleep = sleep_fcn,
                      stop.on.error = FALSE, reg = reg)
   mdebug("- batchtools::waitForJobs(): %s", res)
   stat <- status(future)
@@ -480,10 +495,19 @@ await.BatchtoolsFuture <- function(future, cleanup = TRUE,
                                  output = loggedOutput(future)))
     } else if ("expired" %in% stat) {
       cleanup <- FALSE
-      msg <- sprintf("BatchtoolsExpiration: Future ('%s') expired: %s",
-                     label, reg$file.dir)
-      stop(BatchtoolsFutureError(msg, future = future,
-                                 output = loggedOutput(future)))
+      msg <- sprintf("BatchtoolsExpiration: Future ('%s') expired (registry path %s).", label, reg$file.dir)
+      output <- loggedOutput(future)
+      hint <- unlist(strsplit(output, split = "\n", fixed = TRUE))
+      hint <- hint[nzchar(hint)]
+      hint <- tail(hint, n = 6L)
+      if (length(hint) > 0) {
+        hint <- paste(hint, collapse = "\n")
+        msg <- sprintf("%s. The last few lines of the logged output:\n%s",
+                       msg, hint)
+      } else {
+        msg <- sprintf("%s. No logged output exist.", msg)
+      }
+      stop(BatchtoolsFutureError(msg, future = future, output = output))
     } else if (is_na(stat)) {
       msg <- sprintf("BatchtoolsDeleted: Cannot retrieve value. Future ('%s') deleted: %s", label, reg$file.dir) #nolint
       stop(BatchtoolsFutureError(msg, future = future))

R/batchtoolsFutureError.R R/BatchtoolsFutureError.RR/batchtoolsFutureError.R renamed to R/BatchtoolsFutureError.R

@@ -16,7 +16,7 @@
 #' @export
 #' @importFrom utils file_test
 batchtools_custom <- function(expr, envir = parent.frame(), substitute = TRUE,
-                              globals = TRUE, label = "batchtools",
+                              globals = TRUE, label = NULL,
                               cluster.functions,
                               resources = list(), workers = NULL, ...) {
   if (substitute) expr <- substitute(expr)

R/batchtools_custom.R

@@ -4,7 +4,7 @@
 #' @export
 batchtools_interactive <- function(expr, envir = parent.frame(),
                                    substitute = TRUE, globals = TRUE,
-                                   label = "batchtools", workers = 1L, ...) {
+                                   label = NULL, workers = 1L, ...) {
   if (substitute) expr <- substitute(expr)
 
   cf <- makeClusterFunctionsInteractive(external = FALSE)

R/batchtools_interactive.R

@@ -36,7 +36,7 @@
 #' @aliases batchtools_interactive
 #' @export
 batchtools_local <- function(expr, envir = parent.frame(), substitute = TRUE,
-                             globals = TRUE, label = "batchtools",
+                             globals = TRUE, label = NULL,
                              workers = 1L, ...) {
   if (substitute) expr <- substitute(expr)
 

R/batchtools_local.R

@@ -27,7 +27,7 @@
 #' @keywords internal
 batchtools_multicore <- function(expr, envir = parent.frame(),
                             substitute = TRUE, globals = TRUE,
-                            label = "batchtools",
+                            label = NULL,
                             workers = availableCores(constraints = "multicore"),
                             ...) {
   if (substitute) expr <- substitute(expr)