slow_sum() now signals zero-amount progression conditions

Author: HenrikBengtsson

NEWS

@@ -1,7 +1,7 @@
 Package: progressr
 ==================
 
-Version: 0.1.2-9000 [2019-06-26]
+Version: 0.1.2-9000 [2019-06-27]
 
 NEW FEATURES:
 
@@ -11,6 +11,9 @@ NEW FEATURES:
 
  * Add utility function handlers() for controlling option 'progressr.handlers'.
 
+ * Progression handlers' internal state now has a sticky 'message' field,
+   which hold the most recent, non-empty progression 'message' received.
+
 
 Version: 0.1.2 [2019-06-14]
 

R/options.R

@@ -28,7 +28,7 @@
 #'  \item{\option{progressr.intrusiveness}:}{(numeric) A non-negative scalar on how intrusive (disruptive) the reporter to the user. This multiplicative scalar applies to the _interval_ and _times_ parameters. (Default: `1.0`)\cr
 #'   
 #'   \describe{
-#'     \item{\option{progressr.intrusiveness.auditory}:}{(numeric) intrusiveness for auditory progress handlers (Default: `10.0`)}
+#'     \item{\option{progressr.intrusiveness.auditory}:}{(numeric) intrusiveness for auditory progress handlers (Default: `5.0`)}
 #'     \item{\option{progressr.intrusiveness.file}:}{(numeric) intrusiveness for file-based progress handlers (Default: `5.0`)}
 #'     \item{\option{progressr.intrusiveness.gui}:}{(numeric) intrusiveness for graphical-user-interface progress handlers (Default: `1.0`)}
 #'     \item{\option{progressr.intrusiveness.notifier}:}{(numeric) intrusiveness for progress handlers that creates notifications (Default: `10.0`)}
@@ -57,7 +57,7 @@
 #' @section Options for progressr examples and demos:
 #'
 #' \describe{
-#'  \item{\option{delay}:}{(numeric) Delay (in seconds) between each iteration of [slow_sum()]. (Default: `0.05`)}
+#'  \item{\option{progressr.delay}:}{(numeric) Delay (in seconds) between each iteration of [slow_sum()]. (Default: `1.0`)}
 #' }
 #'
 #'

R/progression_handlers.R

@@ -14,11 +14,11 @@
 #' @example incl/ascii_alert_handler.R
 #'
 #' @export
-ascii_alert_handler <- function(symbol = "\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.auditory", 10), ...) {
+ascii_alert_handler <- function(symbol = "\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), ...) {
   reporter <- local({
     list(
       update = function(config, state, progression, ...) {
-        if (state$enabled) cat(file = file, symbol)
+        if (state$enabled && progression$amount != 0) cat(file = file, symbol)
       }
     )
   })
@@ -79,7 +79,7 @@ txtprogressbar_handler <- function(style = 3L, file = stderr(), intrusiveness =
       },
 
       update = function(config, state, progression, ...) {
-        if (!state$enabled || config$times == 1L) return()
+        if (!state$enabled || progression$amount == 0 || config$times == 1L) return()
 	make_pb(max = config$max_steps, style = style, file = file)
         setTxtProgressBar(pb, value = state$step)
       },
@@ -158,7 +158,7 @@ tkprogressbar_handler <- function(intrusiveness = getOption("progressr.intrusive
       },
 
       update = function(config, state, progression, ...) {
-        if (!state$enabled || config$times <= 2L) return()
+        if (!state$enabled || progression$amount == 0 || config$times <= 2L) return()
         make_pb(max = config$max_steps, label = state$message)
         setTkProgressBar(pb, value = state$step, label = state$message)
       },
@@ -226,7 +226,7 @@ winprogressbar_handler <- function(intrusiveness = getOption("progressr.intrusiv
       },
 
       update = function(config, state, progression, ...) {
-        if (!state$enabled || config$times <= 2L) return()
+        if (!state$enabled || progression$amount == 0 || config$times <= 2L) return()
         make_pb(max = config$max_steps, label = state$message)
         setWinProgressBar(pb, value = state$step, label = state$message)
       },
@@ -317,7 +317,7 @@ pbmcapply_handler <- function(substyle = 3L, style = "ETA", file = stderr(), int
       },
 
       update = function(config, state, progression, ...) {
-        if (!state$enabled || config$times <= 2L) return()
+        if (!state$enabled || progression$amount == 0 || config$times <= 2L) return()
         make_pb(max = config$max_steps, style = style, substyle = substyle, file = file)
         setTxtProgressBar(pb, value = state$step)
       },
@@ -440,7 +440,7 @@ progress_handler <- function(format = "[:bar] :percent :message", show_after = 0
 #' @example incl/beepr_handler.R
 #'
 #' @export
-beepr_handler <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiveness = getOption("progressr.intrusiveness.auditory", 10), ...) {
+beepr_handler <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), ...) {
   ## Used for package testing purposes only when we want to perform
   ## everything except the last part where the backend is called
   if (!is_fake("beepr_handler")) {
@@ -464,7 +464,7 @@ beepr_handler <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiven
       },
 
       update = function(config, state, progression, ...) {
-        if (!state$enabled || config$times <= 2L) return()
+        if (!state$enabled || progression$amount == 0 || config$times <= 2L) return()
         beep(update)
       },
 
@@ -520,7 +520,7 @@ notifier_handler <- function(intrusiveness = getOption("progressr.intrusiveness.
       },
 
       update = function(config, state, progression, ...) {
-        if (!state$enabled || config$times <= 2L) return()
+        if (!state$enabled || progression$amount == 0 || config$times <= 2L) return()
         notify(step = state$step, max_steps = config$max_steps, message = state$message)
       },
 
@@ -638,6 +638,7 @@ filesize_handler <- function(file = "default.progress", intrusiveness = getOptio
       current_size <- file.size(file)
       if (is.na(current_size)) file.create(file, showWarnings = FALSE)
       if (size == 0L) return()
+      if (progression$amount == 0) return()          
 
       head <- sprintf("%g/%g: ", state$step, config$max_steps)
       nhead <- nchar(head)

R/slow_sum.R

@@ -15,17 +15,27 @@
 #' This function signals [progression] conditions as it progresses.
 #'
 #' @export
-slow_sum <- function(x, delay = getOption("delay", 0.05), stdout = FALSE, message = FALSE) {
+slow_sum <- function(x, delay = getOption("progressr.delay", 1.0), stdout = FALSE, message = TRUE) {
   progress <- progressor(length(x))
 
   sum <- 0
   for (kk in seq_along(x)) {
+    progress(amount = 0)   ## "I'm alive" progression update
+    Sys.sleep(0.2*delay)
     if (stdout) cat(sprintf("O: Element #%d\n", kk))
-    Sys.sleep(delay)
+    progress(amount = 0)
+    Sys.sleep(0.2*delay)
+    progress(amount = 0)
+    Sys.sleep(0.2*delay)
     sum <- sum + x[kk]
     progress(message = sprintf("P: Adding %g", kk))
+    Sys.sleep(0.2*delay)
     if (message) message(sprintf("M: Added value %g", x[kk]))
+    progress(amount = 0)
+    Sys.sleep(0.2*delay)
   }
 
+  progress(amount = 0)
+
   sum
 }

R/utils.R

@@ -111,3 +111,46 @@ known_progression_handlers <- function() {
 `%||%` <- function(lhs, rhs) {
   if (is.null(lhs)) rhs else lhs
 }
+
+
+## From R.utils 2.7.0 (2018-08-26)
+query_r_cmd_check <- function(...) {
+  evidences <- list()
+
+  # Command line arguments
+  args <- commandArgs()
+  evidences[["vanilla"]] <- is.element("--vanilla", args)
+
+  # Check the working directory
+  pwd <- getwd()
+  dirname <- basename(pwd)
+  parent <- basename(dirname(pwd))
+  pattern <- ".+[.]Rcheck$"
+
+  # Is 'R CMD check' checking tests?
+  evidences[["tests"]] <- (
+    (regexpr(pattern, parent) != -1) && 
+    (regexpr("^tests(|_.*)$", dirname) != -1)
+  )
+
+  # Is the current working directory as expected?
+  evidences[["pwd"]] <- (evidences[["tests"]] || (regexpr(pattern, dirname) != -1))
+
+  # Is 'R CMD check' checking examples?
+  evidences[["examples"]] <- is.element("CheckExEnv", search())
+
+
+  if (!evidences$vanilla || !evidences$pwd) {
+    res <- "notRunning"
+  } else if (evidences$tests) {
+    res <- "checkingTests"
+  } else if (evidences$examples) {
+    res <- "checkingExamples"
+  } else {
+    res <- "notRunning"
+  }
+
+  res
+}
+
+in_r_cmd_check <- function() { query_r_cmd_check() != "notRunning" }

incl/progress_handler.R

@@ -1,5 +1,5 @@
 if (requireNamespace("progress", quietly = TRUE)) {
-  handlers("progress")
+  handlers(progress_handler(format = ":spin [:bar] :percent :message"))
   with_progress({ y <- slow_sum(1:10) })
   print(y)
 }