Merge branch 'release/0.3.0'

Author: HenrikBengtsson

.travis.yml

@@ -29,7 +29,8 @@ matrix:
         - _R_CHECK_CONNECTIONS_LEFT_OPEN_=true
         - _R_CHECK_LENGTH_1_CONDITION_=true
         - _R_CHECK_LENGTH_1_LOGIC2_=true
-    - os: osx
+        - _R_CLASS_MATRIX_ARRAY_=true
+     - os: osx
       r: oldrel
     - os: osx
       r: release

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: progressr
-Version: 0.2.1
+Version: 0.3.0
 Title: A Unifying API for Progress Updates
-Description: A minimal API for reporting progress updates upstream.  The design is to separate the representation of progress updates from how they are presented.  What type of progress to signal is controlled by the developer.  How these progress updates are rendered is controlled by the end user.  For instance, some users may prefer visual feedback such as a horizontal progress bar in the terminal, whereas others may prefer auditory feedback.
+Description: A minimal, unifying API for scripts and packages to report progress updates. By design, it allows the developer to focus on what progress that should be reported on, without having to worry about how to present it. The end user has full control on how, where, and when to render these progress updates, e.g. in the terminal using 'utils::txtProgressBar()' or 'progress::progress_bar()', in a graphical user interface using 'utils::winProgressBar()', 'tcltk::tkProgressBar()' or 'shiny::withProgress()', via the speakers using 'beep::beepr()', or on a file system via the size of a file. Anyone can add additional, customized, progression handlers. The 'progressr' package uses R's condition framework for signaling progress updated. Because of this, progress can be reported from almost anywhere in R, e.g. from classical for and while loops, from map-reduce APIs like the 'lapply()' family of functions, 'purrr', 'plyr', and 'foreach'. It will also work with parallel processing via the 'future' framework, e.g. 'future.apply::future_lapply()', 'furrr::map()', and 'foreach' with 'doFuture'.
 Authors@R: c(
   person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"),
          email = "[email protected]"))
@@ -14,18 +14,15 @@ Suggests:
     tcltk,
     beepr,
     pbmcapply,
-    plyr,
     progress,
-    foreach,
     purrr,
-    future (>= 1.15.1),
+    foreach,
+    plyr,
     doFuture,
+    future (>= 1.16.0),
     future.apply,
     furrr,
-    shiny,
-    notifier
-Remotes:
-  gaborcsardi/notifier@d92b1b6
+    shiny
 URL: https://github.com/HenrikBengtsson/progressr
 BugReports: https://github.com/HenrikBengtsson/progressr/issues
 RoxygenNote: 7.0.2

NEWS

@@ -1,6 +1,20 @@
 Package: progressr
 ==================
 
+Version: 0.3.0 [2020-01-20]
+
+NEW FEATURES:
+
+ * progressor() gained offset and slope arguments 'a' and 'b', and functional
+   argument 'transform'.
+
+ * handlers() gained argument 'append' to make it easier to append handlers.
+ 
+BUG FIXES:
+
+ * A progression condition with amount = 0 would not update the message.
+
+ 
 Version: 0.2.1 [2020-01-04]
 
 BUG FIXES:

OVERVIEW.md

@@ -12,11 +12,11 @@ Design motto:
 
 ## Two Minimal APIs
 
- | Developer's API       | End-user's API              |
- |-----------------------|-----------------------------|
- | `p <- progressor(n)`  | `with_progress(expr)`       |
- | `p(msg, ...)`         | `handlers(...)`             |
- |                       | `options(progressr.*=...)`  |
+ | Developer's API               | End-user's API              |
+ |-------------------------------|-----------------------------|
+ | `p <- progressor(n)`          | `with_progress(expr)`       |
+ | `p <- progressor(along = x)`  | `handlers(...)`             |
+ | `p(msg, ...)`                 |                             |
 
 
 
@@ -26,12 +26,12 @@ Assume that we have a function `slow_sum()` for adding up the values in a vector
 
 ```r
 slow_sum <- function(x) {
-  progress <- progressr::progressor(along = x)
+  p <- progressr::progressor(along = x)
   sum <- 0
   for (kk in seq_along(x)) {
     Sys.sleep(0.1)
     sum <- sum + x[kk]
-    progress(message = sprintf("Added %g", x[kk]))
+    p(message = sprintf("Added %g", x[kk]))
   }
   sum
 }
@@ -75,7 +75,7 @@ This progress handler will present itself as:
 [==================>---------------------------]  40% Added 4
 ```
 
-To set the default progress handler(s) in all your R sessions, call `progressr::handlers(...)` in your <code>~/.Rprofile</code> file.  An alternative, which avoids loading the **progressr** package if never used, is to set `options(progressr.handlers = progress_handler)`.
+To set the default progress handler(s) in all your R sessions, call `progressr::handlers(...)` in your <code>~/.Rprofile</code> file.
 
 
 

R/ascii_alert_handler.R

@@ -0,0 +1,27 @@
+#' Auditory Progression Feedback
+#'
+#' A progression handler based on `cat("\a", file=stderr())`.
+#'
+#' @inheritParams make_progression_handler
+#'
+#' @param symbol (character string) The character symbol to be outputted,
+#' which by default is the ASCII BEL character (`'\a'` = `'\007'`) character.
+#'
+#' @param file (connection) A [base::connection] to where output should be sent.
+#'
+#' @param \ldots Additional arguments passed to [make_progression_handler()].
+#'
+#' @example incl/ascii_alert_handler.R
+#'
+#' @export
+ascii_alert_handler <- function(symbol = "\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), target = c("terminal", "audio"), ...) {
+  reporter <- local({
+    list(
+      update = function(config, state, progression, ...) {
+        if (state$enabled && progression$amount != 0) cat(file = file, symbol)
+      }
+    )
+  })
+
+  make_progression_handler("ascii_alert", reporter, intrusiveness = intrusiveness, ...)
+}

R/beepr_handler.R

@@ -0,0 +1,54 @@
+#' Auditory Progression Feedback
+#'
+#' A progression handler for [beepr::beep()].
+#'
+#' @inheritParams make_progression_handler
+#'
+#' @param initiate,update,finish (integer) Indices of [beepr::beep()] sounds to
+#'  play when progress starts, is updated, and completes.  For silence, use `NA_integer_`.
+#'
+#' @param \ldots Additional arguments passed to [make_progression_handler()].
+#'
+#' @example incl/beepr_handler.R
+#'
+#' @section Requirements:
+#' This progression handler requires the \pkg{beepr} package.
+#'
+#' @export
+beepr_handler <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), target = "audio", ...) {
+  ## 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")) {
+    beepr_beep <- beepr::beep
+  } else {
+    beepr_beep <- function(sound, expr) NULL
+  }
+
+  beep <- function(sound) {
+    ## Silence?
+    if (is.na(sound)) return()
+    beepr_beep(sound)
+  }
+
+  ## Reporter state
+  reporter <- local({
+    list(
+      initiate = function(config, state, progression, ...) {
+        if (!state$enabled || config$times == 1L) return()
+	beep(initiate)
+      },
+        
+      update = function(config, state, progression, ...) {
+        if (!state$enabled || progression$amount == 0 || config$times <= 2L) return()
+        beep(update)
+      },
+        
+      finish = function(config, state, progression, ...) {
+        if (!state$enabled) return()
+        beep(finish)
+      }
+    )
+  })
+  
+  make_progression_handler("beepr", reporter, intrusiveness = intrusiveness, ...)
+}

R/debug_handler.R

@@ -0,0 +1,45 @@
+#' Textual Progression Feedback for Debug Purposes
+#'
+#' @inheritParams make_progression_handler
+#'
+#' @param \ldots Additional arguments passed to [make_progression_handler()].
+#'
+#' @example incl/debug_handler.R
+#'
+#' @export
+debug_handler <- function(interval = getOption("progressr.interval", 0), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", ...) {
+  reporter <- local({
+    t_init <- NULL
+    
+    add_to_log <- function(config, state, progression, ...) {
+      t <- Sys.time()
+      if (is.null(t_init)) t_init <<- t
+      dt <- difftime(t, t_init, units = "secs")
+      delay <- difftime(t, progression$time, units = "secs")
+      message <- paste(c(state$message, ""), collapse = "")
+      entry <- list(now(t), dt, delay, progression$type, state$step, config$max_steps, state$delta, message, config$clear, state$enabled, paste0(progression$status, ""))
+      msg <- do.call(sprintf, args = c(list("%s(%.3fs => +%.3fs) %s: %d/%d (%+d) '%s' {clear=%s, enabled=%s, status=%s}"), entry))
+      message(msg)
+    }
+
+    list(
+      reset = function(...) {
+        t_init <<- NULL
+      },
+      
+      initiate = function(...) {
+        add_to_log("initiate", ...)
+      },
+        
+      update = function(...) {
+        add_to_log("update", ...)
+      },
+        
+      finish = function(...) {
+        add_to_log("finish", ...)
+      }
+    )
+  })
+  
+  make_progression_handler("debug", reporter, intrusiveness = intrusiveness, ...)
+}

R/filesize_handler.R

@@ -0,0 +1,65 @@
+#' Progression Updates Reflected as the Size of a File
+#'
+#' @inheritParams make_progression_handler
+#'
+#' @param file (character) A filename.
+#'
+#' @param \ldots Additional arguments passed to [make_progression_handler()].
+#'
+#' @examples
+#' \donttest{\dontrun{
+#' handlers(filesize_handler(file = "myscript.progress"))
+#' with_progress(y <- slow_sum(1:100))
+#' }}
+#'
+#' @importFrom utils file_test
+#' @export
+filesize_handler <- function(file = "default.progress", intrusiveness = getOption("progressr.intrusiveness.file", 5), target = "file", ...) {
+  reporter <- local({
+    set_file_size <- function(config, state, progression) {
+      ratio <- state$step / config$max_steps
+      size <- round(100 * ratio)
+      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)
+      tail <- sprintf(" [%d%%]", round(100 * ratio))
+      ntail <- nchar(tail)
+      mid <- paste0(state$message, "")
+      nmid <- nchar(mid)
+      padding <- size - (nhead + nmid + ntail)
+      if (padding <= 0) {
+        msg <- paste(head, mid, tail, sep = "")
+        if (padding < 0) msg <- substring(msg, first = 1L, last = size)
+      } else if (padding > 0) {
+        mid <- paste(c(mid, " ", rep(".", times = padding - 1L)), collapse = "")
+        msg <- paste(head, mid, tail, sep = "")
+      }
+      
+      cat(file = file, append = FALSE, msg)
+    }
+    
+    list(
+      initiate = function(config, state, progression, ...) {
+        set_file_size(config = config, state = state, progression = progression)
+      },
+      
+      update = function(config, state, progression, ...) {
+        set_file_size(config = config, state = state, progression = progression)
+      },
+      
+      finish = function(config, state, progression, ...) {
+        if (config$clear) {
+	  if (file_test("-f", file)) file.remove(file)
+	} else {
+          set_file_size(config = config, state = state, progression = progression)
+	}
+      }
+    )
+  })
+  
+  make_progression_handler("filesize", reporter, intrusiveness = intrusiveness, ...)
+}

R/handlers.R

@@ -5,6 +5,9 @@
 #' If this vector is empty, then an empty set of progression handlers will
 #' be set.
 #'
+#' @param append (logical) If FALSE, the specified progression handlers
+#' replace the current ones, otherwise appended to them.
+#'
 #' @param on_missing (character) If `"error"`, an error is thrown if one of
 #' the progression handlers does not exists.  If `"warning"`, a warning
 #' is produces and the missing handlers is ignored.  If `"ignore"`, the
@@ -24,12 +27,12 @@
 #' @example incl/handlers.R
 #'
 #' @export
-handlers <- function(..., on_missing = c("error", "warning", "ignore"), default = txtprogressbar_handler) {
+handlers <- function(..., append = FALSE, on_missing = c("error", "warning", "ignore"), default = txtprogressbar_handler) {
   args <- list(...)
 
   ## Get the current set of progression handlers?
   if (length(args) == 0L) {
-    if (!is.list(default)) default <- list(default)
+    if (!is.list(default) && !is.null(default)) default <- list(default)
     return(getOption("progressr.handlers", default))
   }
 
@@ -82,5 +85,10 @@ handlers <- function(..., on_missing = c("error", "warning", "ignore"), default
   keep <- vapply(handlers, FUN = is.function, FUN.VALUE = FALSE)
   handlers <- handlers[keep]
 
+  if (append) {
+    current <- getOption("progressr.handlers", list())
+    if (length(current) > 0L) handlers <- c(current, handlers)
+  }
+
   options(progressr.handlers = handlers)[[1]]
 }

R/newline_handler.R

@@ -0,0 +1,23 @@
+#' Textual Progression Feedback that outputs a Newline
+#'
+#' @inheritParams make_progression_handler
+#'
+#' @param symbol (character string) The character symbol to be outputted,
+#' which by default is the ASCII NL character (`'\n'` = `'\013'`) character.
+#'
+#' @param file (connection) A [base::connection] to where output should be sent.
+#'
+#' @param \ldots Additional arguments passed to [make_progression_handler()].
+#'
+#' @export
+newline_handler <- function(symbol = "\n", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", ...) {
+  reporter <- local({
+    list(
+      initiate = function(...) cat(file = file, symbol),
+      update   = function(...) cat(file = file, symbol),
+      finish   = function(...) cat(file = file, symbol)
+    )
+  })
+  
+  make_progression_handler("newline", reporter, intrusiveness = intrusiveness, ...)
+}