From 8994fe32dd76715f723da7e972a17aa1afd4eb08 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 18 May 2020 23:31:16 -0700 Subject: [PATCH 01/94] Bump develop version --- DESCRIPTION | 2 +- NEWS | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3fe9215..0f6e53b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: progressr -Version: 0.6.0 +Version: 0.6.0-9000 Title: A Inclusive, Unifying API for Progress Updates Description: A minimal, unifying API for scripts and packages to report progress updates from anywhere including when using parallel processing. The package is designed such that the developer can to focus on what progress should be reported on without having to worry about how to present it. The end user has full control of 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::future_map(), and 'foreach' with 'doFuture'. The package is compatible with Shiny applications. Authors@R: c( diff --git a/NEWS b/NEWS index 32b4290..6ed174f 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,11 @@ Package: progressr ================== +Version: 0.6.0-9000 [2020-05-18] + + * ... + + Version: 0.6.0 [2020-05-18] SIGNIFICANT CHANGES: From 3a38266a1e178a2747c662f20c562338264fe1db Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 18 May 2020 23:43:26 -0700 Subject: [PATCH 02/94] GA: can't test incoming; fails due to warning when recently published --- .github/workflows/R-CMD-check.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index e6c399c..2e323db 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -78,6 +78,8 @@ jobs: shell: Rscript {0} - name: Check + env: + _R_CHECK_CRAN_INCOMING_: false run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") shell: Rscript {0} From 21275287adc5f50f6f744cbe69f67f62be1ace53 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Tue, 19 May 2020 14:23:51 -0700 Subject: [PATCH 03/94] duplicate word [ci skip] --- NEWS | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 6ed174f..7789d1b 100644 --- a/NEWS +++ b/NEWS @@ -13,9 +13,9 @@ SIGNIFICANT CHANGES: * Now with_progress() makes sure that any output produced while reporting on progress will not interfer with the progress output and vice versa, which otherwise is a common problem with progress frameworks that output to the - terminal, e.g. progress-bar output output is interweaved with printed - objects. In contrast, when using 'progressr' we can use message() and - print() as usual regardless of progress being reported or not. + terminal, e.g. progress-bar output is interweaved with printed objects. + In contrast, when using 'progressr' we can use message() and print() as + usual regardless of progress being reported or not. NEW FEATURES: From 0af7cb25c9b205e07726ab0668dda1d959bfb60c Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 6 Jul 2020 17:20:30 -0700 Subject: [PATCH 04/94] stopifnot() -> stop_if_not() --- R/make_progression_handler.R | 2 +- R/progress.R | 2 +- R/progress_aggregator.R | 2 +- R/progression.R | 4 ++-- R/with_progress.R | 5 +++-- 5 files changed, 8 insertions(+), 7 deletions(-) diff --git a/R/make_progression_handler.R b/R/make_progression_handler.R index 7e79048..4f82010 100644 --- a/R/make_progression_handler.R +++ b/R/make_progression_handler.R @@ -252,7 +252,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en if (is.null(handler)) { handler <- function(p) { - stopifnot(inherits(p, "progression")) + stop_if_not(inherits(p, "progression")) if (inherits(p, "control_progression")) { type <- p$type diff --git a/R/progress.R b/R/progress.R index a70eca0..af87025 100644 --- a/R/progress.R +++ b/R/progress.R @@ -16,7 +16,7 @@ progress <- function(..., call = sys.call()) { args <- list(...) if (length(args) == 1L && inherits(args[[1L]], "condition")) { cond <- args[[1L]] - stopifnot(inherits(cond, "progression")) + stop_if_not(inherits(cond, "progression")) } else { cond <- progression(..., call = call) } diff --git a/R/progress_aggregator.R b/R/progress_aggregator.R index f5c210e..fa177bc 100644 --- a/R/progress_aggregator.R +++ b/R/progress_aggregator.R @@ -15,7 +15,7 @@ progress_aggregator <- function(progress) { max_steps <- environment(progress)$steps handler <- function(p) { - stopifnot(inherits(p, "progression")) + stop_if_not(inherits(p, "progression")) type <- p$type debug <- getOption("progressr.debug", FALSE) if (debug) { diff --git a/R/progression.R b/R/progression.R index 2d94329..4591b86 100644 --- a/R/progression.R +++ b/R/progression.R @@ -52,8 +52,8 @@ progression <- function(message = character(0L), amount = 1.0, step = NULL, time nargs <- length(args) if (nargs > 0L) { names <- names(args) - stopifnot(!is.null(names), all(nzchar(names)), - length(unique(names)) == nargs) + stop_if_not(!is.null(names), all(nzchar(names)), + length(unique(names)) == nargs) } structure( diff --git a/R/with_progress.R b/R/with_progress.R index 36284e8..855a574 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -131,10 +131,11 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE for (kk in seq_along(handlers)) { handler <- handlers[[kk]] - stopifnot(is.function(handler)) + stop_if_not(is.function(handler)) if (!inherits(handler, "progression_handler")) { handler <- handler() - stopifnot(is.function(handler), inherits(handler, "progression_handler")) + stop_if_not(is.function(handler), + inherits(handler, "progression_handler")) handlers[[kk]] <- handler } } From b1f26a4fd9429792194e91afa7c111d24f08bbc2 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 6 Jul 2020 17:21:21 -0700 Subject: [PATCH 05/94] reroxygenize --- DESCRIPTION | 2 +- man/handler_ascii_alert.Rd | 2 +- man/handler_newline.Rd | 2 +- man/handler_pbmcapply.Rd | 2 +- man/handler_txtprogressbar.Rd | 2 +- man/make_progression_handler.Rd | 6 +++--- man/progress.Rd | 4 ++-- man/progression.Rd | 4 ++-- man/progressr.options.Rd | 2 +- man/with_progress.Rd | 4 ++-- 10 files changed, 15 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0f6e53b..fd7c71b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,5 +29,5 @@ Suggests: VignetteBuilder: progressr URL: https://github.com/HenrikBengtsson/progressr BugReports: https://github.com/HenrikBengtsson/progressr/issues -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.1 Roxygen: list(markdown = TRUE) diff --git a/man/handler_ascii_alert.Rd b/man/handler_ascii_alert.Rd index ba61629..982e0c6 100644 --- a/man/handler_ascii_alert.Rd +++ b/man/handler_ascii_alert.Rd @@ -16,7 +16,7 @@ handler_ascii_alert( \item{symbol}{(character string) The character symbol to be outputted, which by default is the ASCII BEL character (\code{'\\a'} = \code{'\\007'}) character.} -\item{file}{(connection) A \link[base:connection]{base::connection} to where output should be sent.} +\item{file}{(connection) A \link[base:connections]{base::connection} to where output should be sent.} \item{intrusiveness}{(numeric) A non-negative scalar on how intrusive (disruptive) the reporter to the user.} diff --git a/man/handler_newline.Rd b/man/handler_newline.Rd index 28475bc..a478d34 100644 --- a/man/handler_newline.Rd +++ b/man/handler_newline.Rd @@ -16,7 +16,7 @@ handler_newline( \item{symbol}{(character string) The character symbol to be outputted, which by default is the ASCII NL character (\code{'\\n'} = \code{'\\013'}) character.} -\item{file}{(connection) A \link[base:connection]{base::connection} to where output should be sent.} +\item{file}{(connection) A \link[base:connections]{base::connection} to where output should be sent.} \item{intrusiveness}{(numeric) A non-negative scalar on how intrusive (disruptive) the reporter to the user.} diff --git a/man/handler_pbmcapply.Rd b/man/handler_pbmcapply.Rd index 5c953b9..6a6d769 100644 --- a/man/handler_pbmcapply.Rd +++ b/man/handler_pbmcapply.Rd @@ -18,7 +18,7 @@ handler_pbmcapply( \item{style}{(character) The progress-bar style according to \code{\link[pbmcapply:progressBar]{pbmcapply::progressBar()}}.} -\item{file}{(connection) A \link[base:connection]{base::connection} to where output should be sent.} +\item{file}{(connection) A \link[base:connections]{base::connection} to where output should be sent.} \item{intrusiveness}{(numeric) A non-negative scalar on how intrusive (disruptive) the reporter to the user.} diff --git a/man/handler_txtprogressbar.Rd b/man/handler_txtprogressbar.Rd index 6a3b272..e627645 100644 --- a/man/handler_txtprogressbar.Rd +++ b/man/handler_txtprogressbar.Rd @@ -16,7 +16,7 @@ handler_txtprogressbar( \item{style}{(integer) The progress-bar style according to \code{\link[utils:txtProgressBar]{utils::txtProgressBar()}}.} -\item{file}{(connection) A \link[base:connection]{base::connection} to where output should be sent.} +\item{file}{(connection) A \link[base:connections]{base::connection} to where output should be sent.} \item{intrusiveness}{(numeric) A non-negative scalar on how intrusive (disruptive) the reporter to the user.} diff --git a/man/make_progression_handler.Rd b/man/make_progression_handler.Rd index 24bb6fe..0572c8d 100644 --- a/man/make_progression_handler.Rd +++ b/man/make_progression_handler.Rd @@ -57,9 +57,9 @@ A function of class \code{progression_handler} that takes a \link{progression} condition as its first and only argument. } \description{ -A progression calling handler is a function that takes a \link[base:condition]{base::condition} +A progression calling handler is a function that takes a \link[base:conditions]{base::condition} as its first argument and that can be use together with -\code{\link[base:withCallingHandlers]{base::withCallingHandlers()}}. This function helps creating such +\code{\link[base:conditions]{base::withCallingHandlers()}}. This function helps creating such progression calling handler functions. } \details{ @@ -69,6 +69,6 @@ handlers for how it is used, e.g. \code{progressr::handler_txtprogressbar}. Please use with care as things might change. } \seealso{ -\code{\link[base:withCallingHandlers]{base::withCallingHandlers()}}. +\code{\link[base:conditions]{base::withCallingHandlers()}}. } \keyword{internal} diff --git a/man/progress.Rd b/man/progress.Rd index 07150b7..5f1e564 100644 --- a/man/progress.Rd +++ b/man/progress.Rd @@ -12,13 +12,13 @@ progress(..., call = sys.call()) \item{\ldots}{Arguments pass to \code{\link[=progression]{progression()}}.} } \value{ -A \link[base:condition]{base::condition} of class \code{progression}. +A \link[base:conditions]{base::condition} of class \code{progression}. } \description{ Creates and Signals a Progression Condition } \seealso{ -To signal a progression condition, use \code{\link[base:signalCondition]{base::signalCondition()}}. +To signal a progression condition, use \code{\link[base:conditions]{base::signalCondition()}}. To create and signal a progression condition at once, use \code{\link[=progress]{progress()}}. } \keyword{internal} diff --git a/man/progression.Rd b/man/progression.Rd index 68bf7b7..198ff26 100644 --- a/man/progression.Rd +++ b/man/progression.Rd @@ -49,13 +49,13 @@ unique for the \R session where the progressor was created.} \item{\ldots}{Additional named elements.} } \value{ -A \link[base:condition]{base::condition} of class \code{progression}. +A \link[base:conditions]{base::condition} of class \code{progression}. } \description{ A progression condition represents a progress in an \R program. } \seealso{ -To signal a progression condition, use \code{\link[base:signalCondition]{base::signalCondition()}}. +To signal a progression condition, use \code{\link[base:conditions]{base::signalCondition()}}. To create and signal a progression condition at once, use \code{\link[=progress]{progress()}}. } \keyword{internal} diff --git a/man/progressr.options.Rd b/man/progressr.options.Rd index e393774..68a7af0 100644 --- a/man/progressr.options.Rd +++ b/man/progressr.options.Rd @@ -33,7 +33,7 @@ Below are all \R options that are currently used by the \pkg{progressr} package. \describe{ \item{\option{progressr.handlers}:}{ (function or list of functions) -Zero or more progression handlers that will report on any progression updates. If empty list, progress updates are ignored. If NULL, the default (\code{handler_txtprogressbar}) progression handlers is used. The recommended way to set this option is via \code{\link[progressr:handlers]{progressr::handlers()}}. (Default: NULL) +Zero or more progression handlers that will report on any progression updates. If empty list, progress updates are ignored. If NULL, the default (\code{handler_txtprogressbar}) progression handlers is used. The recommended way to set this option is via \code{\link[=handlers]{handlers()}}. (Default: NULL) } } } diff --git a/man/with_progress.Rd b/man/with_progress.Rd index c14566e..18ae942 100644 --- a/man/with_progress.Rd +++ b/man/with_progress.Rd @@ -33,7 +33,7 @@ the terminal will delayed.} \item{delay_stdout}{If TRUE, standard output is captured and relayed at the end just before any captured conditions are relayed.} -\item{delay_conditions}{A character vector specifying \link[base:condition]{base::condition} +\item{delay_conditions}{A character vector specifying \link[base:conditions]{base::condition} classes to be captured and relayed at the end after any captured standard output is relayed.} @@ -136,5 +136,5 @@ with_progress({ }) } \seealso{ -\code{\link[base:withCallingHandlers]{base::withCallingHandlers()}} +\code{\link[base:conditions]{base::withCallingHandlers()}} } From 470b94b5760c78a9ec7973eb0fb69c850f18477e Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 6 Jul 2020 17:37:02 -0700 Subject: [PATCH 06/94] Some x$a => x[["a"]] updates --- R/make_progression_handler.R | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/R/make_progression_handler.R b/R/make_progression_handler.R index 4f82010..da25556 100644 --- a/R/make_progression_handler.R +++ b/R/make_progression_handler.R @@ -230,22 +230,22 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en } is_owner <- function(p) { - progressor_uuid <- p$progressor_uuid + progressor_uuid <- p[["progressor_uuid"]] if (is.null(owner)) owner <<- progressor_uuid (owner == progressor_uuid) } is_duplicated <- function(p) { - progressor_uuid <- p$progressor_uuid - session_uuid <- p$session_uuid - progression_index <- p$progression_index - progression_time <- p$progression_time + progressor_uuid <- p[["progressor_uuid"]] + session_uuid <- p[["session_uuid"]] + progression_index <- p[["progression_index"]] + progression_time <- p[["progression_time"]] progression_id <- sprintf("%s-%d-%s", session_uuid, progression_index, progression_time) - db <- done[[progressor_uuid]] + db <- done[["progressor_uuid"]] res <- is.element(progression_id, db) if (!res) { db <- c(db, progression_id) - done[[progressor_uuid]] <<- db + done[["progressor_uuid"]] <<- db } res } @@ -255,7 +255,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en stop_if_not(inherits(p, "progression")) if (inherits(p, "control_progression")) { - type <- p$type + type <- p[["type"]] if (type == "reset") { max_steps <<- NULL step <<- NULL @@ -292,14 +292,14 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en duplicated <- is_duplicated(p) - type <- p$type + type <- p[["type"]] debug <- getOption("progressr.debug", FALSE) if (debug) { mprintf("Progression calling handler %s ...", sQuote(type)) mprintf("- progression:") mstr(p) - mprintf("- progressor_uuid: %s", p$progressor_uuid) - mprintf("- progression_index: %s", p$progression_index) + mprintf("- progressor_uuid: %s", p[["progressor_uuid"]]) + mprintf("- progression_index: %s", p[["progression_index"]]) mprintf("- duplicated: %s", duplicated) } @@ -312,10 +312,10 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en } if (type == "initiate") { - max_steps <<- p$steps + max_steps <<- p[["steps"]] if (debug) mstr(list(max_steps=max_steps)) stop_if_not(!is.null(max_steps), is.numeric(max_steps), length(max_steps) == 1L, max_steps >= 1) - auto_finish <<- p$auto_finish + auto_finish <<- p[["auto_finish"]] times <- min(times, max_steps) if (debug) mstr(list(auto_finish = auto_finish, times = times, interval = interval, intrusiveness = intrusiveness)) @@ -352,8 +352,8 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en prev_milestone <<- max_steps .validate_internal_state() } else if (type == "update") { - if (debug) mstr(list(step=step, "p$amount"=p$amount, max_steps=max_steps)) - step <<- min(max(step + p$amount, 0L), max_steps) + if (debug) mstr(list(step=step, "p$amount"=p[["amount"]], max_steps=max_steps)) + step <<- min(max(step + p[["amount"]], 0L), max_steps) stop_if_not(step >= 0L) msg <- conditionMessage(p) if (length(msg) > 0) message <<- msg From 2b6762266d07f3b1c1881f8c9db3d9008eea0658 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Tue, 11 Aug 2020 09:19:12 -0400 Subject: [PATCH 07/94] Return the value of `expr` from `with_progress()` --- NEWS | 5 ++- R/with_progress.R | 88 +++++++++++++++++++++------------------- R/without_progress.R | 16 +++++--- tests/with_progress.R | 14 +++++++ tests/without_progress.R | 15 +++++++ 5 files changed, 90 insertions(+), 48 deletions(-) diff --git a/NEWS b/NEWS index 7789d1b..619874c 100644 --- a/NEWS +++ b/NEWS @@ -3,8 +3,9 @@ Package: progressr Version: 0.6.0-9000 [2020-05-18] - * ... - + * with_progress() and without_progress() now return the result of evaluating + 'expr'. + Version: 0.6.0 [2020-05-18] diff --git a/R/with_progress.R b/R/with_progress.R index 855a574..d56a350 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -232,55 +232,61 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE ## Evaluate expression capture_conditions <- TRUE - withCallingHandlers( - expr, - progression = function(p) { - ## Don't capture conditions that are produced by progression handlers - capture_conditions <<- FALSE - on.exit(capture_conditions <<- TRUE) + res <- withVisible( + withCallingHandlers( + expr, + progression = function(p) { + ## Don't capture conditions that are produced by progression handlers + capture_conditions <<- FALSE + on.exit(capture_conditions <<- TRUE) - ## Any buffered output to flush? - if (flush_terminal) { - if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { - calling_handler(control_progression("hide")) - stdout_file <<- flush_stdout(stdout_file, close = FALSE) - conditions <<- flush_conditions(conditions) - calling_handler(control_progression("unhide")) + ## Any buffered output to flush? + if (flush_terminal) { + if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { + calling_handler(control_progression("hide")) + stdout_file <<- flush_stdout(stdout_file, close = FALSE) + conditions <<- flush_conditions(conditions) + calling_handler(control_progression("unhide")) + } } - } - - calling_handler(p) - }, - condition = function(c) { - if (!capture_conditions || inherits(c, c("progression", "error"))) return() - if (inherits(c, delay_conditions)) { - ## Record - conditions[[length(conditions) + 1L]] <<- c - ## Muffle - if (inherits(c, "message")) { - invokeRestart("muffleMessage") - } else if (inherits(c, "warning")) { - invokeRestart("muffleWarning") - } else if (inherits(c, "condition")) { - ## If there is a "muffle" restart for this condition, - ## then invoke that restart, i.e. "muffle" the condition - restarts <- computeRestarts(c) - for (restart in restarts) { - name <- restart$name - if (is.null(name)) next - if (!grepl("^muffle", name)) next - invokeRestart(restart) - break + + calling_handler(p) + }, + condition = function(c) { + if (!capture_conditions || inherits(c, c("progression", "error"))) return() + if (inherits(c, delay_conditions)) { + ## Record + conditions[[length(conditions) + 1L]] <<- c + ## Muffle + if (inherits(c, "message")) { + invokeRestart("muffleMessage") + } else if (inherits(c, "warning")) { + invokeRestart("muffleWarning") + } else if (inherits(c, "condition")) { + ## If there is a "muffle" restart for this condition, + ## then invoke that restart, i.e. "muffle" the condition + restarts <- computeRestarts(c) + for (restart in restarts) { + name <- restart$name + if (is.null(name)) next + if (!grepl("^muffle", name)) next + invokeRestart(restart) + break + } } } } - } + ) ) - + ## Success status <- "ok" - - invisible(NULL) + + if (res$visible) { + res$value + } else { + invisible(res$value) + } } diff --git a/R/without_progress.R b/R/without_progress.R index 1f17e20..1ed0aca 100644 --- a/R/without_progress.R +++ b/R/without_progress.R @@ -5,9 +5,15 @@ #' @rdname with_progress #' @export without_progress <- function(expr) { - withCallingHandlers(expr, progression = function(p) { - invokeRestart("muffleProgression") - }) - - invisible(NULL) + res <- withVisible( + withCallingHandlers(expr, progression = function(p) { + invokeRestart("muffleProgression") + }) + ) + + if (res$visible) { + res$value + } else { + invisible(res$value) + } } diff --git a/tests/with_progress.R b/tests/with_progress.R index b2e6cde..7195620 100644 --- a/tests/with_progress.R +++ b/tests/with_progress.R @@ -167,6 +167,20 @@ if (requireNamespace("utils", quietly = TRUE)) { message("with_progress() - multiple handlers ... done") +message("with_progress() - return value and visibility ...") + +res <- with_progress(x) +stopifnot(identical(x, res)) + +res <- withVisible(with_progress(x)) +stopifnot(identical(res$visible, TRUE)) + +res <- withVisible(with_progress(y <- x)) +stopifnot(identical(res$visible, FALSE)) + +message("with_progress() - return value and visibility ... done") + + message("with_progress() ... done") source("incl/end.R") diff --git a/tests/without_progress.R b/tests/without_progress.R index e8dc94e..c39ea98 100644 --- a/tests/without_progress.R +++ b/tests/without_progress.R @@ -13,4 +13,19 @@ with_progress(without_progress(y <- slow_sum(x))) message("without_progress() ... done") + +message("without_progress() - return value and visibility ...") + +res <- without_progress(x) +stopifnot(identical(x, res)) + +res <- withVisible(without_progress(x)) +stopifnot(identical(res$visible, TRUE)) + +res <- withVisible(without_progress(y <- x)) +stopifnot(identical(res$visible, FALSE)) + +message("without_progress() - return value and visibility ... done") + + source("incl/end.R") From a09f082198e8aee09fdc3f265d01be2b8faa64e5 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Tue, 11 Aug 2020 09:25:31 -0400 Subject: [PATCH 08/94] Push visibility handling inside `withCallingHandlers()` --- R/with_progress.R | 76 +++++++++++++++++++++----------------------- R/without_progress.R | 7 ++-- 2 files changed, 41 insertions(+), 42 deletions(-) diff --git a/R/with_progress.R b/R/with_progress.R index d56a350..5567531 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -232,51 +232,49 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE ## Evaluate expression capture_conditions <- TRUE - res <- withVisible( - withCallingHandlers( - expr, - progression = function(p) { - ## Don't capture conditions that are produced by progression handlers - capture_conditions <<- FALSE - on.exit(capture_conditions <<- TRUE) + res <- withCallingHandlers( + withVisible(expr), + progression = function(p) { + ## Don't capture conditions that are produced by progression handlers + capture_conditions <<- FALSE + on.exit(capture_conditions <<- TRUE) - ## Any buffered output to flush? - if (flush_terminal) { - if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { - calling_handler(control_progression("hide")) - stdout_file <<- flush_stdout(stdout_file, close = FALSE) - conditions <<- flush_conditions(conditions) - calling_handler(control_progression("unhide")) - } + ## Any buffered output to flush? + if (flush_terminal) { + if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { + calling_handler(control_progression("hide")) + stdout_file <<- flush_stdout(stdout_file, close = FALSE) + conditions <<- flush_conditions(conditions) + calling_handler(control_progression("unhide")) } + } - calling_handler(p) - }, - condition = function(c) { - if (!capture_conditions || inherits(c, c("progression", "error"))) return() - if (inherits(c, delay_conditions)) { - ## Record - conditions[[length(conditions) + 1L]] <<- c - ## Muffle - if (inherits(c, "message")) { - invokeRestart("muffleMessage") - } else if (inherits(c, "warning")) { - invokeRestart("muffleWarning") - } else if (inherits(c, "condition")) { - ## If there is a "muffle" restart for this condition, - ## then invoke that restart, i.e. "muffle" the condition - restarts <- computeRestarts(c) - for (restart in restarts) { - name <- restart$name - if (is.null(name)) next - if (!grepl("^muffle", name)) next - invokeRestart(restart) - break - } + calling_handler(p) + }, + condition = function(c) { + if (!capture_conditions || inherits(c, c("progression", "error"))) return() + if (inherits(c, delay_conditions)) { + ## Record + conditions[[length(conditions) + 1L]] <<- c + ## Muffle + if (inherits(c, "message")) { + invokeRestart("muffleMessage") + } else if (inherits(c, "warning")) { + invokeRestart("muffleWarning") + } else if (inherits(c, "condition")) { + ## If there is a "muffle" restart for this condition, + ## then invoke that restart, i.e. "muffle" the condition + restarts <- computeRestarts(c) + for (restart in restarts) { + name <- restart$name + if (is.null(name)) next + if (!grepl("^muffle", name)) next + invokeRestart(restart) + break } } } - ) + } ) ## Success diff --git a/R/without_progress.R b/R/without_progress.R index 1ed0aca..b88c76e 100644 --- a/R/without_progress.R +++ b/R/without_progress.R @@ -5,10 +5,11 @@ #' @rdname with_progress #' @export without_progress <- function(expr) { - res <- withVisible( - withCallingHandlers(expr, progression = function(p) { + res <- withCallingHandlers( + withVisible(expr), + progression = function(p) { invokeRestart("muffleProgression") - }) + } ) if (res$visible) { From 818c3562550a2a3d91125f23c73492285180488b Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Tue, 11 Aug 2020 09:33:48 -0400 Subject: [PATCH 09/94] Update documentation of `with_progress()` --- R/with_progress.R | 2 +- man/with_progress.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/with_progress.R b/R/with_progress.R index 5567531..3cdfe40 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -25,7 +25,7 @@ #' default is to report progress in interactive mode but not batch mode. #' See below for more details. #' -#' @return Return nothing (reserved for future usage). +#' @return The value of evaluating `expr`. #' #' @example incl/with_progress.R #' diff --git a/man/with_progress.Rd b/man/with_progress.Rd index 18ae942..4d468f0 100644 --- a/man/with_progress.Rd +++ b/man/with_progress.Rd @@ -45,7 +45,7 @@ default is to report progress in interactive mode but not batch mode. See below for more details.} } \value{ -Return nothing (reserved for future usage). +The value of evaluating \code{expr}. } \description{ Report on Progress while Evaluating an R Expression From a173b872a9c5614b12d192bf46332fd2ecd71767 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 21 Aug 2020 15:42:51 -0700 Subject: [PATCH 10/94] Grammar correction of package title [ci skip] --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index fd7c71b..5d67337 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: progressr Version: 0.6.0-9000 -Title: A Inclusive, Unifying API for Progress Updates +Title: An Inclusive, Unifying API for Progress Updates Description: A minimal, unifying API for scripts and packages to report progress updates from anywhere including when using parallel processing. The package is designed such that the developer can to focus on what progress should be reported on without having to worry about how to present it. The end user has full control of 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::future_map(), and 'foreach' with 'doFuture'. The package is compatible with Shiny applications. Authors@R: c( person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"), From 18d5654eec8cc8afb6d73621724ba8fc77aff2ce Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 23 Sep 2020 13:45:17 -0700 Subject: [PATCH 11/94] README and vignette: Clarify that the 'multicore' future backend does not yet support near-live progress updates [#88] --- OVERVIEW.md | 3 +-- README.md | 5 ++--- vignettes/progressr-intro.md | 3 +-- 3 files changed, 4 insertions(+), 7 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index d3676a6..9faeaf5 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -416,8 +416,7 @@ As of May 2020, there are three types of **future** backends that are known(*) t Here "near-live" means that the progress handlers will report on progress almost immediately when the progress is signaled on the worker. For all other future backends, the progress updates are only relayed back to the main machine and reported together with the results of the futures. For instance, if `future_lapply(X, FUN)` chunks up the processing of, say, 100 elements in `X` into eight futures, we will see progress from each of the 100 elements as they are done when using a future backend supporting "near-live" updates, whereas we will only see those updated to be flushed eight times when using any other types of future backends. - -(*) Other future backends may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. +(*) Other future backends, including [`multicore`](https://github.com/HenrikBengtsson/future/issues/419), may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. diff --git a/README.md b/README.md index 1c78674..69c81cc 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# progressr: A Inclusive, Unifying API for Progress Updates +# progressr: An Inclusive, Unifying API for Progress Updates ![Life cycle: experimental](vignettes/imgs/lifecycle-experimental-orange.svg) @@ -418,8 +418,7 @@ As of May 2020, there are three types of **future** backends that are known(*) t Here "near-live" means that the progress handlers will report on progress almost immediately when the progress is signaled on the worker. For all other future backends, the progress updates are only relayed back to the main machine and reported together with the results of the futures. For instance, if `future_lapply(X, FUN)` chunks up the processing of, say, 100 elements in `X` into eight futures, we will see progress from each of the 100 elements as they are done when using a future backend supporting "near-live" updates, whereas we will only see those updated to be flushed eight times when using any other types of future backends. - -(*) Other future backends may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. +(*) Other future backends, including [`multicore`](https://github.com/HenrikBengtsson/future/issues/419), may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index 6b0c277..b0517d3 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -425,8 +425,7 @@ As of May 2020, there are three types of **future** backends that are known(*) t Here "near-live" means that the progress handlers will report on progress almost immediately when the progress is signaled on the worker. For all other future backends, the progress updates are only relayed back to the main machine and reported together with the results of the futures. For instance, if `future_lapply(X, FUN)` chunks up the processing of, say, 100 elements in `X` into eight futures, we will see progress from each of the 100 elements as they are done when using a future backend supporting "near-live" updates, whereas we will only see those updated to be flushed eight times when using any other types of future backends. - -(*) Other future backends may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. +(*) Other future backends, including [`multicore`](https://github.com/HenrikBengtsson/future/issues/419), may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. From a66d80255144dddd7a5131c87c94453b52bfd45c Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 23 Sep 2020 18:56:32 -0700 Subject: [PATCH 12/94] BUG FIX: Argument 'enable' for with_progress() had no effect. (fixes #88) --- NEWS | 6 ++++-- R/with_progress.R | 10 +++++----- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/NEWS b/NEWS index 7789d1b..433ccf3 100644 --- a/NEWS +++ b/NEWS @@ -1,9 +1,11 @@ Package: progressr ================== -Version: 0.6.0-9000 [2020-05-18] +Version: 0.6.0-9000 [2020-09-23] - * ... +BUG FIXES: + + * Argument 'enable' for with_progress() had no effect. Version: 0.6.0 [2020-05-18] diff --git a/R/with_progress.R b/R/with_progress.R index 855a574..7ffff17 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -112,11 +112,6 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE options[["progressr.interval"]] <- interval } - if (length(options) > 0L) { - oopts <- options(options) - on.exit(options(oopts)) - } - ## Enabled or not? if (!is.null(enable)) { stop_if_not(is.logical(enable), length(enable) == 1L, !is.na(enable)) @@ -127,6 +122,11 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE options[["progressr.enable"]] <- enable } + if (length(options) > 0L) { + oopts <- options(options) + on.exit(options(oopts)) + } + if (!is.list(handlers)) handlers <- list(handlers) for (kk in seq_along(handlers)) { From 7b50280820ec3783335a245f73668e5418596c78 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 23 Sep 2020 18:58:39 -0700 Subject: [PATCH 13/94] Update README and CoC --- CONDUCT.md | 147 ++++++++++++++++++++++++++++++++++++----------------- README.md | 12 +++-- 2 files changed, 109 insertions(+), 50 deletions(-) diff --git a/CONDUCT.md b/CONDUCT.md index aac608d..2b3225e 100644 --- a/CONDUCT.md +++ b/CONDUCT.md @@ -1,74 +1,129 @@ + # Contributor Covenant Code of Conduct ## Our Pledge -In the interest of fostering an open and welcoming environment, we as -contributors and maintainers pledge to making participation in our project and -our community a harassment-free experience for everyone, regardless of age, body -size, disability, ethnicity, gender identity and expression, level of experience, -nationality, personal appearance, race, religion, or sexual identity and -orientation. +We as members, contributors, and leaders pledge to make participation in our +community a harassment-free experience for everyone, regardless of age, body +size, visible or invisible disability, ethnicity, sex characteristics, gender +identity and expression, level of experience, education, socio-economic status, +nationality, personal appearance, race, religion, or sexual identity +and orientation. + +We pledge to act and interact in ways that contribute to an open, welcoming, +diverse, inclusive, and healthy community. ## Our Standards -Examples of behavior that contributes to creating a positive environment -include: +Examples of behavior that contributes to a positive environment for our +community include: -* Using welcoming and inclusive language -* Being respectful of differing viewpoints and experiences -* Gracefully accepting constructive criticism -* Focusing on what is best for the community -* Showing empathy towards other community members +* Demonstrating empathy and kindness toward other people +* Being respectful of differing opinions, viewpoints, and experiences +* Giving and gracefully accepting constructive feedback +* Accepting responsibility and apologizing to those affected by our mistakes, + and learning from the experience +* Focusing on what is best not just for us as individuals, but for the + overall community -Examples of unacceptable behavior by participants include: +Examples of unacceptable behavior include: -* The use of sexualized language or imagery and unwelcome sexual attention or -advances -* Trolling, insulting/derogatory comments, and personal or political attacks +* The use of sexualized language or imagery, and sexual attention or + advances of any kind +* Trolling, insulting or derogatory comments, and personal or political attacks * Public or private harassment -* Publishing others' private information, such as a physical or electronic - address, without explicit permission +* Publishing others' private information, such as a physical or email + address, without their explicit permission * Other conduct which could reasonably be considered inappropriate in a professional setting -## Our Responsibilities +## Enforcement Responsibilities -Project maintainers are responsible for clarifying the standards of acceptable -behavior and are expected to take appropriate and fair corrective action in -response to any instances of unacceptable behavior. +Community leaders are responsible for clarifying and enforcing our standards of +acceptable behavior and will take appropriate and fair corrective action in +response to any behavior that they deem inappropriate, threatening, offensive, +or harmful. -Project maintainers have the right and responsibility to remove, edit, or -reject comments, commits, code, wiki edits, issues, and other contributions -that are not aligned to this Code of Conduct, or to ban temporarily or -permanently any contributor for other behaviors that they deem inappropriate, -threatening, offensive, or harmful. +Community leaders have the right and responsibility to remove, edit, or reject +comments, commits, code, wiki edits, issues, and other contributions that are +not aligned to this Code of Conduct, and will communicate reasons for moderation +decisions when appropriate. ## Scope -This Code of Conduct applies both within project spaces and in public spaces -when an individual is representing the project or its community. Examples of -representing a project or community include using an official project e-mail -address, posting via an official social media account, or acting as an appointed -representative at an online or offline event. Representation of a project may be -further defined and clarified by project maintainers. +This Code of Conduct applies within all community spaces, and also applies when +an individual is officially representing the community in public spaces. +Examples of representing our community include using an official e-mail address, +posting via an official social media account, or acting as an appointed +representative at an online or offline event. ## Enforcement Instances of abusive, harassing, or otherwise unacceptable behavior may be -reported by contacting the project team. All -complaints will be reviewed and investigated and will result in a response that -is deemed necessary and appropriate to the circumstances. The project team is -obligated to maintain confidentiality with regard to the reporter of an incident. -Further details of specific enforcement policies may be posted separately. +reported to the project lead. +All complaints will be reviewed and investigated promptly and fairly. + +All community leaders are obligated to respect the privacy and security of the +reporter of any incident. + +## Enforcement Guidelines + +Community leaders will follow these Community Impact Guidelines in determining +the consequences for any action they deem in violation of this Code of Conduct: + +### 1. Correction + +**Community Impact**: Use of inappropriate language or other behavior deemed +unprofessional or unwelcome in the community. + +**Consequence**: A private, written warning from community leaders, providing +clarity around the nature of the violation and an explanation of why the +behavior was inappropriate. A public apology may be requested. + +### 2. Warning + +**Community Impact**: A violation through a single incident or series +of actions. -Project maintainers who do not follow or enforce the Code of Conduct in good -faith may face temporary or permanent repercussions as determined by other -members of the project's leadership. +**Consequence**: A warning with consequences for continued behavior. No +interaction with the people involved, including unsolicited interaction with +those enforcing the Code of Conduct, for a specified period of time. This +includes avoiding interactions in community spaces as well as external channels +like social media. Violating these terms may lead to a temporary or +permanent ban. + +### 3. Temporary Ban + +**Community Impact**: A serious violation of community standards, including +sustained inappropriate behavior. + +**Consequence**: A temporary ban from any sort of interaction or public +communication with the community for a specified period of time. No public or +private interaction with the people involved, including unsolicited interaction +with those enforcing the Code of Conduct, is allowed during this period. +Violating these terms may lead to a permanent ban. + +### 4. Permanent Ban + +**Community Impact**: Demonstrating a pattern of violation of community +standards, including sustained inappropriate behavior, harassment of an +individual, or aggression toward or disparagement of classes of individuals. + +**Consequence**: A permanent ban from any sort of public interaction within +the community. ## Attribution -This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, -available at [https://contributor-covenant.org/version/1/4][version] +This Code of Conduct is adapted from the [Contributor Covenant][homepage], +version 2.0, available at +https://www.contributor-covenant.org/version/2/0/code_of_conduct.html. + +Community Impact Guidelines were inspired by [Mozilla's code of conduct +enforcement ladder](https://github.com/mozilla/diversity). + +[homepage]: https://www.contributor-covenant.org + +For answers to common questions about this code of conduct, see the FAQ at +https://www.contributor-covenant.org/faq. Translations are available at +https://www.contributor-covenant.org/translations. -[homepage]: https://contributor-covenant.org -[version]: https://contributor-covenant.org/version/1/4/ diff --git a/README.md b/README.md index 69c81cc..27e1241 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,6 @@ + + + # progressr: An Inclusive, Unifying API for Progress Updates ![Life cycle: experimental](vignettes/imgs/lifecycle-experimental-orange.svg) @@ -534,22 +537,23 @@ R package progressr is available on [CRAN](https://cran.r-project.org/package=pr install.packages("progressr") ``` + ### Pre-release version To install the pre-release version that is available in Git branch `develop` on GitHub, use: ```r -remotes::install_github("HenrikBengtsson/progressr@develop") +remotes::install_github("HenrikBengtsson/progressr", ref="develop") ``` This will install the package from source. - - ## Contributions -This Git repository uses the [Git Flow](http://nvie.com/posts/a-successful-git-branching-model/) branching model (the [`git flow`](https://github.com/petervanderdoes/gitflow-avh) extension is useful for this). The [`develop`](https://github.com/HenrikBengtsson/progressr/tree/develop) branch contains the latest contributions and other code that will appear in the next release, and the [`master`](https://github.com/HenrikBengtsson/progressr) branch contains the code of the latest release, which is exactly what is currently on [CRAN](https://cran.r-project.org/package=progressr). +This Git repository uses the [Git Flow](https://nvie.com/posts/a-successful-git-branching-model/) branching model (the [`git flow`](https://github.com/petervanderdoes/gitflow-avh) extension is useful for this). The [`develop`](https://github.com/HenrikBengtsson/progressr/tree/develop) branch contains the latest contributions and other code that will appear in the next release, and the [`master`](https://github.com/HenrikBengtsson/progressr) branch contains the code of the latest release, which is exactly what is currently on [CRAN](https://cran.r-project.org/package=progressr). Contributing to this package is easy. Just send a [pull request](https://help.github.com/articles/using-pull-requests/). When you send your PR, make sure `develop` is the destination branch on the [progressr repository](https://github.com/HenrikBengtsson/progressr). Your PR should pass `R CMD check --as-cran`, which will also be checked by Travis CI and AppVeyor CI when the PR is submitted. +We abide to the [Code of Conduct](https://www.contributor-covenant.org/version/2/0/code_of_conduct/) of Contributor Covenant. + ## Software status From df7ae12a4990497f8b8aeaa1fe8a2901254b80ac Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 23 Oct 2020 14:30:35 -0700 Subject: [PATCH 14/94] fixes #89 [ci skip] --- tests/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/utils.R b/tests/utils.R index 1f4e05a..eb4f862 100644 --- a/tests/utils.R +++ b/tests/utils.R @@ -19,7 +19,7 @@ printf("x = %s.\n", hpaste(x)) printf("x = %s.\n", hpaste(x, maxHead = 2)) ## x = 1, 2, ..., 6. -printf("x = %s.\n", hpaste(x), maxHead = 3) # Default +printf("x = %s.\n", hpaste(x, maxHead = 3)) # Default ## x = 1, 2, 3, ..., 6. # It will never output 1, 2, 3, 4, ..., 6 From 9d419d2f37c78107d81bf51ad4756eee558d8a43 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 28 Oct 2020 14:56:39 -0700 Subject: [PATCH 15/94] NEWS: spelling [ci skip] --- Makefile | 4 ++++ NEWS | 14 +++++++------- inst/WORDLIST | 19 +++++++++++++++++++ 3 files changed, 30 insertions(+), 7 deletions(-) diff --git a/Makefile b/Makefile index 3b0b7f5..b5b9373 100644 --- a/Makefile +++ b/Makefile @@ -7,3 +7,7 @@ vignettes/progressr-intro.md: OVERVIEW.md vignettes/incl/clean.css sed -i 's/vignettes\///g' $@ vigs: vignettes/progressr-intro.md + +spelling: + $(R_SCRIPT) -e "spelling::spell_check_package()" + $(R_SCRIPT) -e "spelling::spell_check_files(c('NEWS', dir('vignettes', pattern='[.](md|rsp)$$', full.names=TRUE)), ignore=readLines('inst/WORDLIST', warn=FALSE))" diff --git a/NEWS b/NEWS index 433ccf3..571e164 100644 --- a/NEWS +++ b/NEWS @@ -13,7 +13,7 @@ Version: 0.6.0 [2020-05-18] SIGNIFICANT CHANGES: * Now with_progress() makes sure that any output produced while reporting on - progress will not interfer with the progress output and vice versa, which + progress will not interfere with the progress output and vice versa, which otherwise is a common problem with progress frameworks that output to the terminal, e.g. progress-bar output is interweaved with printed objects. In contrast, when using 'progressr' we can use message() and print() as @@ -43,7 +43,7 @@ NEW FEATURES: BUG FIXES: * Limiting the frequency of progress reporting via handler arguments 'times', - 'interval' or 'intrusivness' did not work and was effectively ignored. + 'interval' or 'intrusiveness' did not work and was effectively ignored. * The 'progress' handler, which uses progress::progress_bar(), did not support colorization of the 'format' string when done by the 'crayon' package. @@ -116,7 +116,7 @@ Version: 0.1.5 [2019-10-26] NEW FEATURES: - * Add withProgress2(), which is a plug-in backward compatibily replacement + * Add withProgress2(), which is a plug-in backward compatibility replacement for shiny::withProgress() wrapped in progressr::with_progress() where the the "shiny" progression handler is by default added to the list of progression handlers used. @@ -215,7 +215,7 @@ NEW FEATURES: * Add support for times = 1L for progression handlers which when used will cause the progression to only be presented upon completion (= last step). - * The 'shutdown' control_progression signalled by with_progress() on exit + * The 'shutdown' control_progression signaled by with_progress() on exit now contains the 'status' of the evaluation. If the evaluation was successful, then status = "ok", otherwise "incomplete". Examples of incomplete evaluations are errors and interrupts. @@ -309,7 +309,7 @@ NEW FEATURES: * Visual progression handler will now always render the complete update state when 'clear' is FALSE. - * Now progression handlers ignore a re-signalled progression condition if it + * Now progression handlers ignore a re-signaled progression condition if it has already been processed previously. * Now each progression condition holds unique identifiers for the R session @@ -358,7 +358,7 @@ NEW FEATURES: * Add 'intrusiveness' parameter that specifies how intrusive/disruptive a certain progress reporter is. For instance, an auditory reporter is - relatively more distruptive than a visual progress bar part of the + relatively more disruptive than a visual progress bar part of the status bar. * Simplified the API for creating new types of progress reporters. @@ -389,7 +389,7 @@ NEW FEATURES: updates are rendered. * Add 'progressr.interval' for controlling the minimum number of seconds - that needs to ellapse before reporting on the next update. + that needs to elapse before reporting on the next update. Version: 0.0.0-9000 [2019-04-11] diff --git a/inst/WORDLIST b/inst/WORDLIST index 7c4b54d..195e1cf 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -41,3 +41,22 @@ VignetteIndexEntry VignetteKeyword winProgressBar withProgress +autocompletion +Bengtsson +filesize +interweaved +mandelbrot +msg +muffleMessage +muffleProgression +muffleWarning +nnn +Precreated +progressBar +progressr +PROGRESSR +stdout +UUID +winprogressbar +withProgressShiny +withRestart From 8758a6668b086085fd1ef62e853e3b8722ad24c0 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 28 Oct 2020 14:57:49 -0700 Subject: [PATCH 16/94] REVDEP: modernize [ci skip] --- revdep/run.R | 257 +------------------------------------------------ revdep/run.sge | 3 + 2 files changed, 4 insertions(+), 256 deletions(-) diff --git a/revdep/run.R b/revdep/run.R index 57fcadf..2128b55 100755 --- a/revdep/run.R +++ b/revdep/run.R @@ -1,24 +1,4 @@ #!/usr/bin/env Rscript -if (!requireNamespace("revdepcheck", quietly = TRUE)) { - stop('Install revdepcheck: remotes::install_github("r-lib/revdepcheck")') -} -library("revdepcheck") -options(warn = 1L) - -available_cores <- function() { - getenv <- function(name) { - as.integer(Sys.getenv(name, NA_character_)) - } - getopt <- function(name) { - as.integer(getOption(name, NA_integer_)) - } - if (is.finite(n <- getopt("mc.cores") + 1L)) return(n) - if (is.finite(n <- getopt("Ncpus") + 1L)) return(n) - if (is.finite(n <- getenv("PBS_NUM_PPN"))) return(n) - if (is.finite(n <- getenv("SLURM_CPUS_PER_TASK"))) return(n) - if (is.finite(n <- getenv("NSLOTS"))) return(n) - 1L -} precheck <- function() { ## WORKAROUND: Remove checked pkgs that use file links, which otherwise @@ -26,239 +6,4 @@ precheck <- function() { unlink("revdep/checks/aroma.affymetrix", recursive = TRUE) } -check <- function() { - if (file_test("-f", p <- Sys.getenv("R_CHECK_ENVIRON", "~/.R/check.Renviron"))) { - cat(sprintf("R CMD check will use env vars from %s\n", sQuote(p))) - cat(sprintf("To disable, set 'R_CHECK_ENVIRON=false' (a fake pathname)\n")) - } - - envs <- Sys.getenv() - envs <- envs[grep("^_?R_CHECK_", names(envs))] - if (length(envs) > 0L) { - envs <- sprintf(" %02d. %s=%s", seq_along(envs), names(envs), envs) - envs <- paste(envs, collapse="\n") - cat(sprintf("Detected R-specific env vars that may affect R CMD check:\n%s\n", envs)) - } - - precheck() - revdep_check(bioc = TRUE, num_workers = available_cores(), - timeout = as.difftime(60, units = "mins"), quiet = FALSE) -} - - -todo <- function() { - pkgs <- tryCatch(revdep_todo(), error = function(ex) NA) - if (identical(pkgs, NA)) { - cat("Revdepcheck has not been initiated\n") - return() - } - pkgs <- subset(pkgs, status == "todo") - if (nrow(pkgs) == 0) { - cat("There are no packages on the revdepcheck todo list\n") - } else { - cat(sprintf("%d. %s\n", seq_len(nrow(pkgs)), pkgs$package)) - } -} - -parse_pkgs <- function(pkgs) { - pkgs <- unlist(strsplit(pkgs, split = ",", fixed = TRUE)) - pkgs <- gsub("[ \t'\"‘’]", "", pkgs) - sort(unique(pkgs)) -} - -revdep_init <- function() { - if (!revdepcheck:::db_exists(".")) revdepcheck:::db_setup(".") -} - -revdep_todo_reset <- function() { - revdep_init() - db <- revdepcheck:::db(".") - df <- data.frame(package = character(0L), stringsAsFactors = FALSE) - DBI::dbWriteTable(db, "todo", df, overwrite = TRUE, append = FALSE) -} - -revdep_this_package <- local({ - pkg <- NULL - function() { - if (is.null(pkg)) pkg <<- desc::desc(file = "DESCRIPTION")$get("Package") - pkg - } -}) - -revdep_children <- local({ - cache <- list() - function(pkg = NULL) { - if (is.null(pkg)) pkg <- revdep_this_package() - pkgs <- cache[[pkg]] - if (is.null(pkgs)) { - pkgs <- revdepcheck:::cran_revdeps(pkg) - pkgs <- setdiff(pkgs, pkg) ## WORKAROUND - cache[[pkg]] <- pkgs - } - pkgs - } -}) - -revdep_pkgs_with_status <- function(status = c("error", "failure")) { - status <- match.arg(status) - res <- revdepcheck::revdep_summary() - if (status == "failure") { - names(which(sapply(res, FUN = .subset2, "status") == "E")) - } else if (status == "error") { - field <- switch(status, error = "errors") - has_status <- vapply(res, FUN = function(x) { - z <- x[["new"]][[field]] - is.character(z) && any(nchar(z) > 0) - }, FUN.VALUE = NA, USE.NAMES = TRUE) - has_status <- !is.na(has_status) & has_status - names(has_status)[has_status] - } -} - -revdep_preinstall_libs <- function() { - lib_paths <- .libPaths() - lib_paths[1] <- sprintf("%s-revdepcheck", lib_paths[1]) - dir.create(lib_paths[1], recursive = TRUE, showWarnings = FALSE) - lib_paths -} - -revdep_preinstall <- function(pkgs) { - oopts <- options(Ncpus = available_cores()) - lib_paths_org <- .libPaths() - on.exit({ - .libPaths(lib_paths_org) - options(oopts) - }) - .libPaths(revdep_preinstall_libs()) - - pkgs <- unique(pkgs) - message(sprintf("Triggering crancache builds by pre-installing %d packages: %s", length(pkgs), paste(sQuote(pkgs), collapse = ", "))) - message(".libPaths():") - message(paste(paste0(" - ", .libPaths()), collapse = "\n")) - ## Install one-by-one to update cache sooner - for (kk in seq_along(pkgs)) { - pkg <- pkgs[kk] - message(sprintf("Pre-installing package %d of %d: %s (Ncpus = %d)", - kk, length(pkgs), pkg, getOption("Ncpus", 1L))) - crancache::install_packages(pkg, dependencies = c("Depends", "Imports", "LinkingTo", "Suggests")) - } -} - -revdep_preinstall_update <- function() { - oopts <- options(Ncpus = available_cores()) - lib_paths_org <- .libPaths() - on.exit({ - .libPaths(lib_paths_org) - options(oopts) - }) - .libPaths(revdep_preinstall_libs()) - - message("Update crancache for all pre-installing packages:") - message(".libPaths():") - message(paste(paste0(" - ", .libPaths()), collapse = "\n")) - message(sprintf("Ncpus=%d", getOption("Ncpus", 1L))) - crancache::update_packages(ask = FALSE) -} - - -args <- base::commandArgs(trailingOnly = TRUE) -if ("--reset" %in% args) { - revdep_reset() -} else if ("--todo-reset" %in% args) { - revdep_todo_reset() - todo() -} else if ("--todo" %in% args) { - todo() -} else if ("--add" %in% args) { - pos <- which("--add" == args) - if (pos == length(args)) stop("Missing value for option '--add'") - pkgs <- parse_pkgs(args[seq(from = pos + 1L, to = length(args))]) - revdep_add(packages = pkgs) - todo() -} else if ("--rm" %in% args) { - pos <- which("--rm" == args) - if (pos == length(args)) stop("Missing value for option '--rm'") - pkgs <- parse_pkgs(args[seq(from = pos + 1L, to = length(args))]) - revdep_rm(packages = pkgs) - todo() -} else if ("--add-broken" %in% args) { - revdep_add_broken() - todo() -} else if ("--add-error" %in% args) { -# res <- revepcheck::revdep_summary() - pkgs <- revdep_pkgs_with_status("error") - str(pkgs) - revdep_add(packages = pkgs) - todo() -} else if ("--add-all" %in% args) { - revdep_init() - pkgs <- revdep_children() - for (pkg in pkgs) { - pkgs <- c(pkgs, revdepcheck:::cran_revdeps(pkg)) - } - pkgs <- unique(pkgs) - revdep_add(packages = pkgs) - todo() -} else if ("--add-grandchildren" %in% args) { - revdep_init() - pkgs <- NULL - for (pkg in revdep_children()) { - pkgs <- c(pkgs, revdepcheck:::cran_revdeps(pkg)) - } - pkgs <- unique(pkgs) - revdep_add(packages = pkgs) - todo() -} else if ("--show-check" %in% args) { - pos <- which("--show-check" == args) - if (pos == length(args)) stop("Missing value for option '--show-check") - pkgs <- parse_pkgs(args[seq(from = pos + 1L, to = length(args))]) - for (pkg in pkgs) { - for (dir in c("old", "new")) { - path <- file.path("revdep", "checks", pkg, dir, sprintf("%s.Rcheck", pkg)) - if (!utils::file_test("-d", path)) next - pathname <- file.path(path, "00check.log") - cat("-----------------------------------------------\n") - cat(sprintf("%s (%s):\n", pkg, dir)) - cat("-----------------------------------------------\n") - bfr <- readLines(pathname, warn = FALSE) - tail <- tail(bfr, n = 20L) - writeLines(tail) - } - } -} else if ("--list-children" %in% args) { - pkg <- revdep_this_package() - pkgs <- revdepcheck:::cran_revdeps(pkg) - cat(sprintf("[n=%d] %s\n", length(pkgs), paste(pkgs, collapse = " "))) -} else if ("--list-error" %in% args) { - cat(paste(revdep_pkgs_with_status("error"), collapse = " "), "\n", sep="") -} else if ("--list-failure" %in% args) { - cat(paste(revdep_pkgs_with_status("failure"), collapse = " "), "\n", sep="") -} else if ("--add-error" %in% args) { - revdepcheck::revdep_add(packages = revdep_pkgs_with_status("error")) -} else if ("--add-failure" %in% args) { - revdepcheck::revdep_add(packages = revdep_pkgs_with_status("failure")) -} else if ("--preinstall-update" %in% args) { - revdep_preinstall_update() -} else if ("--preinstall-children" %in% args) { - pkg <- revdep_this_package() - pkgs <- revdepcheck:::cran_revdeps(pkg) - revdep_preinstall(pkgs) -} else if ("--preinstall-error" %in% args) { - res <- revdepcheck::revdep_summary() - revdep_preinstall(revdep_pkgs_with_status("error")) -} else if ("--preinstall-failure" %in% args) { - res <- revdepcheck::revdep_summary() - revdep_preinstall(revdep_pkgs_with_status("failure")) -} else if ("--preinstall-todo" %in% args) { - todo <- revdep_todo() - revdep_preinstall(todo$package) -} else if ("--preinstall" %in% args) { - pos <- which("--preinstall" == args) - if (pos == length(args)) stop("Missing value for option '--preinstall'") - pkgs <- parse_pkgs(args[seq(from = pos + 1L, to = length(args))]) - revdep_preinstall(pkgs) -} else { - stopifnot(length(args) == 0L) - check() - revdep_report(all = TRUE) -} +revdepcheck.extras::run() diff --git a/revdep/run.sge b/revdep/run.sge index 37f64ec..2f9bb7d 100755 --- a/revdep/run.sge +++ b/revdep/run.sge @@ -25,6 +25,9 @@ if [[ $SGE_CLUSTER_NAME == *wynton* ]]; then ## Some packages require non-default system libraries module load gdal geos gsl hdf5 jags + ## Report on what modules are in use + module list + ## Install all packages to toward $TMPDIR, if revdep/library doesn't already exist. ## This will avoid some of the slowness on the global file system #if [[ ! -d revdep/library ]]; then From 58a22ffaaa0992ef09a58ee639bb18a02a1d4361 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Thu, 29 Oct 2020 01:35:46 -0700 Subject: [PATCH 17/94] REVDEP: 19 CRAN pkgs [ci skip] --- revdep/README.md | 39 +++++--- revdep/cran.md | 7 ++ revdep/problems.md | 236 ++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 268 insertions(+), 14 deletions(-) create mode 100644 revdep/cran.md diff --git a/revdep/README.md b/revdep/README.md index 03ab154..9a81007 100644 --- a/revdep/README.md +++ b/revdep/README.md @@ -2,7 +2,7 @@ |field |value | |:--------|:----------------------------| -|version |R version 4.0.0 (2020-04-24) | +|version |R version 4.0.2 (2020-06-22) | |os |CentOS Linux 7 (Core) | |system |x86_64, linux-gnu | |ui |X11 | @@ -10,25 +10,38 @@ |collate |en_US.UTF-8 | |ctype |en_US.UTF-8 | |tz |America/Los_Angeles | -|date |2020-05-18 | +|date |2020-10-29 | # Dependencies |package |old |new |Δ | |:---------|:------|:----------|:--| -|progressr |0.5.0 |0.5.0-9000 |* | -|digest |0.6.25 |0.6.25 | | +|progressr |0.6.0 |0.6.0-9000 |* | +|digest |0.6.27 |0.6.27 | | # Revdeps -## All (6) +## All (19) -|package |version |error |warning |note | -|:--------|:-------|:-----|:-------|:----| -|dipsaus |0.0.7 | | | | -|funGp |0.1.0 | | | | -|lightr |1.1 | | | | -|mlr3 |0.2.0 | | | | -|pavo |2.4.0 | | | | -|rainette |0.1.1 | | | | +|package |version |error |warning |note | +|:---------------------------------------------------|:-------|:-----|:-------|:----| +|[cSEM](problems.md#csem) |0.3.0 | | |1 | +|dipsaus |0.1.1 | | | | +|[econet](problems.md#econet) |0.1.92 | |1 | | +|[EpiNow2](problems.md#epinow2) |1.2.1 | | |2 | +|epwshiftr |0.1.1 | | | | +|fabletools |0.2.1 | | | | +|funGp |0.1.0 | | | | +|furrr |0.2.1 | | | | +|gtfs2gps |1.3-0 | | | | +|lightr |1.3 | | | | +|[lmtp](problems.md#lmtp) |0.0.5 |1 | |2 | +|mlr3 |0.8.0 | | | | +|[modeltime](problems.md#modeltime) |0.3.0 |1 | | | +|[modeltime.ensemble](problems.md#modeltimeensemble) |0.2.0 | | |1 | +|nflfastR |3.1.1 | | | | +|[pavo](problems.md#pavo) |2.4.0 | |1 | | +|poppr |2.8.6 | | | | +|rainette |0.1.1 | | | | +|trundler |0.1.19 | | | | diff --git a/revdep/cran.md b/revdep/cran.md new file mode 100644 index 0000000..0cfa344 --- /dev/null +++ b/revdep/cran.md @@ -0,0 +1,7 @@ +## revdepcheck results + +We checked 19 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. + + * We saw 0 new problems + * We failed to check 0 packages + diff --git a/revdep/problems.md b/revdep/problems.md index 9a20736..50c5333 100644 --- a/revdep/problems.md +++ b/revdep/problems.md @@ -1 +1,235 @@ -*Wow, no problems at all. :)* \ No newline at end of file +# cSEM + +
+ +* Version: 0.3.0 +* GitHub: https://github.com/M-E-Rademaker/cSEM +* Source code: https://github.com/cran/cSEM +* Date/Publication: 2020-10-12 16:40:03 UTC +* Number of recursive dependencies: 116 + +Run `revdep_details(, "cSEM")` for more info + +
+ +## In both + +* checking dependencies in R code ... NOTE + ``` + Namespace in Imports field not imported from: ‘Rdpack’ + All declared Imports should be used. + ``` + +# econet + +
+ +* Version: 0.1.92 +* GitHub: NA +* Source code: https://github.com/cran/econet +* Date/Publication: 2020-09-02 11:20:02 UTC +* Number of recursive dependencies: 62 + +Run `revdep_details(, "econet")` for more info + +
+ +## In both + +* checking re-building of vignette outputs ... WARNING + ``` + ... + Error: processing vignette 'econet.tex' failed with diagnostics: + Running 'texi2dvi' on 'econet.tex' failed. + LaTeX errors: + ! LaTeX Error: File `xpatch.sty' not found. + + Type X to quit or to proceed, + or enter new name. (Default extension: sty) + + ! Emergency stop. + + + l.20 \makeatletter + ^^M + ! ==> Fatal error occurred, no output PDF file produced! + --- failed re-building ‘econet.tex’ + + SUMMARY: processing the following file failed: + ‘econet.tex’ + + Error: Vignette re-building failed. + Execution halted + ``` + +# EpiNow2 + +
+ +* Version: 1.2.1 +* GitHub: NA +* Source code: https://github.com/cran/EpiNow2 +* Date/Publication: 2020-10-20 14:50:09 UTC +* Number of recursive dependencies: 141 + +Run `revdep_details(, "EpiNow2")` for more info + +
+ +## In both + +* checking package dependencies ... NOTE + ``` + Package suggested but not available for checking: ‘EpiSoon’ + ``` + +* checking installed package size ... NOTE + ``` + installed size is 107.4Mb + sub-directories of 1Mb or more: + help 2.3Mb + libs 104.8Mb + ``` + +# lmtp + +
+ +* Version: 0.0.5 +* GitHub: NA +* Source code: https://github.com/cran/lmtp +* Date/Publication: 2020-07-18 09:10:02 UTC +* Number of recursive dependencies: 77 + +Run `revdep_details(, "lmtp")` for more info + +
+ +## In both + +* checking tests ... + ``` + ... + > + > test_check("lmtp") + -- 1. Error: contrast output is correct (@test-contrasts.R#29) ---------------- + unable to start device PNG + Backtrace: + 1. testthat::verify_output(...) + 2. grDevices::png(filename = tempfile()) + + -- 2. Error: create proper node lists, t > 1 (@test-node_list.R#5) ------------ + unable to start device PNG + Backtrace: + 1. testthat::verify_output(...) + 2. grDevices::png(filename = tempfile()) + + ══ testthat results ═══════════════════════════════════════════════════════════ + [ OK: 24 | SKIPPED: 0 | WARNINGS: 2 | FAILED: 2 ] + 1. Error: contrast output is correct (@test-contrasts.R#29) + 2. Error: create proper node lists, t > 1 (@test-node_list.R#5) + + Error: testthat unit tests failed + Execution halted + ``` + +* checking package dependencies ... NOTE + ``` + Package which this enhances but not available for checking: ‘sl3’ + ``` + +* checking dependencies in R code ... NOTE + ``` + Namespaces in Imports field not imported from: + ‘R6’ ‘nnls’ ‘utils’ + All declared Imports should be used. + ``` + +# modeltime + +
+ +* Version: 0.3.0 +* GitHub: https://github.com/business-science/modeltime +* Source code: https://github.com/cran/modeltime +* Date/Publication: 2020-10-28 14:00:07 UTC +* Number of recursive dependencies: 190 + +Run `revdep_details(, "modeltime")` for more info + +
+ +## In both + +* checking tests ... + ``` + ... + + The following object is masked from 'package:kernlab': + + error + + ── 1. Error: (unknown) (@test-results-forecast-plots.R#34) ──────────────────── + unable to start device PNG + Backtrace: + 1. base::suppressWarnings(...) + 2. dplyr::mutate_at(., vars(.value:.conf_hi), exp) + 10. modeltime::plot_modeltime_forecast(., .interactive = TRUE) + 13. plotly:::ggplotly.ggplot(g, dynamicTicks = TRUE) + 14. plotly::gg2list(...) + 15. grDevices:::dev_fun(...) + + ══ testthat results ═══════════════════════════════════════════════════════════ + [ OK: 465 | SKIPPED: 7 | WARNINGS: 0 | FAILED: 1 ] + 1. Error: (unknown) (@test-results-forecast-plots.R#34) + + Error: testthat unit tests failed + Execution halted + ``` + +# modeltime.ensemble + +
+ +* Version: 0.2.0 +* GitHub: https://github.com/business-science/modeltime.ensemble +* Source code: https://github.com/cran/modeltime.ensemble +* Date/Publication: 2020-10-09 10:20:02 UTC +* Number of recursive dependencies: 184 + +Run `revdep_details(, "modeltime.ensemble")` for more info + +
+ +## In both + +* checking dependencies in R code ... NOTE + ``` + Namespaces in Imports field not imported from: + ‘crayon’ ‘dials’ ‘glmnet’ ‘parsnip’ ‘timetk’ + All declared Imports should be used. + ``` + +# pavo + +
+ +* Version: 2.4.0 +* GitHub: https://github.com/rmaia/pavo +* Source code: https://github.com/cran/pavo +* Date/Publication: 2020-02-08 16:20:08 UTC +* Number of recursive dependencies: 90 + +Run `revdep_details(, "pavo")` for more info + +
+ +## In both + +* checking whether package ‘pavo’ can be installed ... WARNING + ``` + Found the following significant warnings: + Warning: no DISPLAY variable so Tk is not available + See ‘/c4/home/henrik/repositories/progressr/revdep/checks/pavo/new/pavo.Rcheck/00install.out’ for details. + ``` + From 15a968886b6efbcd22944e821edbe63b2b94e7fc Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Thu, 29 Oct 2020 01:41:44 -0700 Subject: [PATCH 18/94] progressor() gained argument 'on_exit = TRUE' Progression handlers now return invisibly whether or not they are finished --- NEWS | 8 +++++++- R/make_progression_handler.R | 9 +++++---- R/progressor.R | 18 ++++++++++++++++-- man/progressor.Rd | 8 +++++++- 4 files changed, 35 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index 571e164..94fedb5 100644 --- a/NEWS +++ b/NEWS @@ -1,8 +1,14 @@ Package: progressr ================== -Version: 0.6.0-9000 [2020-09-23] +Version: 0.6.0-9000 [2020-10-29] +NEW FEATURES: + + * progressor() gained argument 'on_exit = TRUE'. + + * Progression handlers now return invisibly whether or not they are finished. + BUG FIXES: * Argument 'enable' for with_progress() had no effect. diff --git a/R/make_progression_handler.R b/R/make_progression_handler.R index da25556..79978b0 100644 --- a/R/make_progression_handler.R +++ b/R/make_progression_handler.R @@ -283,12 +283,12 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en stop("Unknown control_progression type: ", sQuote(type)) } .validate_internal_state(sprintf("control_progression ... end", type)) - return(invisible()) + return(invisible(finished)) } ## Ignore stray progressions coming from other sources, e.g. ## a function of a package that started to report on progression. - if (!is_owner(p)) return(FALSE) + if (!is_owner(p)) return(invisible(finished)) duplicated <- is_duplicated(p) @@ -305,10 +305,10 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en if (duplicated) { if (debug) mprintf("Progression calling handler %s ... already done", sQuote(type)) - return(invisible()) + return(invisible(finished)) } else if (finished) { if (debug) mprintf("Progression calling handler %s ... already finished", sQuote(type)) - return(invisible()) + return(invisible(finished)) } if (type == "initiate") { @@ -388,6 +388,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en .validate_internal_state(sprintf("handler() ... end", type)) if (debug) mprintf("Progression calling handler %s ... done", sQuote(type)) + invisible(finished) } ## handler() } diff --git a/R/progressor.R b/R/progressor.R index c8b6e13..adc3be4 100644 --- a/R/progressor.R +++ b/R/progressor.R @@ -20,13 +20,17 @@ #' @param auto_finish (logical) If TRUE, then the progressor will signal a #' [progression] 'finish' condition as soon as the last step has been reached. #' +#' @param on_exit,envir (logical) If TRUE, then the created progressor will +#' signal a [progression] 'finish' condition when the calling frame exits. +#' This is ignored if the calling frame (`envir`) is the global environment. +#' #' @return A function of class `progressor`. #' #' @export progressor <- local({ progressor_count <- 0L - function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, label = NA_character_, initiate = TRUE, auto_finish = TRUE) { + function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = TRUE, envir = parent.frame()) { stop_if_not(!is.null(steps) || !is.null(along)) stop_if_not(length(steps) == 1L, is.numeric(steps), !is.na(steps), steps >= 0) @@ -41,6 +45,8 @@ progressor <- local({ stop_if_not(length(steps) == 1L, is.numeric(steps), !is.na(steps), steps >= 0) + stop_if_not(is.logical(on_exit), length(on_exit) == 1L, !is.na(on_exit)) + owner_session_uuid <- session_uuid(attributes = TRUE) progressor_count <<- progressor_count + 1L progressor_uuid <- progressor_uuid(progressor_count) @@ -57,7 +63,15 @@ progressor <- local({ class(fcn) <- c("progressor", class(fcn)) if (initiate) fcn(type = "initiate", steps = steps, auto_finish = auto_finish) - + + ## Add on.exit(...progressor(type = "finish")) + if (on_exit && !identical(envir, globalenv())) { + assign("...progressor", value = fcn, envir = envir) + lockBinding("...progressor", env = envir) + call <- call("...progressor", type = "finish") + do.call(base::on.exit, args = list(call, add = TRUE), envir = envir) + } + fcn } }) diff --git a/man/progressor.Rd b/man/progressor.Rd index 823aa64..91e8c19 100644 --- a/man/progressor.Rd +++ b/man/progressor.Rd @@ -12,7 +12,9 @@ progressor( transform = function(steps) scale * steps + offset, label = NA_character_, initiate = TRUE, - auto_finish = TRUE + auto_finish = TRUE, + on_exit = TRUE, + envir = parent.frame() ) } \arguments{ @@ -35,6 +37,10 @@ number of steps.} \item{auto_finish}{(logical) If TRUE, then the progressor will signal a \link{progression} 'finish' condition as soon as the last step has been reached.} + +\item{on_exit, envir}{(logical) If TRUE, then the created progressor will +signal a \link{progression} 'finish' condition when the calling frame exits. +This is ignored if the calling frame (\code{envir}) is the global environment.} } \value{ A function of class \code{progressor}. From 5ca1859cbbe529f8e08f34ba2eb57bbd8e0d0e86 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Thu, 29 Oct 2020 09:37:54 -0700 Subject: [PATCH 19/94] REVDEP: 19 CRAN pkgs [ci skip] --- revdep/README.md | 2 +- revdep/problems.md | 42 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 1 deletion(-) diff --git a/revdep/README.md b/revdep/README.md index 9a81007..8d27d08 100644 --- a/revdep/README.md +++ b/revdep/README.md @@ -33,7 +33,7 @@ |fabletools |0.2.1 | | | | |funGp |0.1.0 | | | | |furrr |0.2.1 | | | | -|gtfs2gps |1.3-0 | | | | +|[gtfs2gps](problems.md#gtfs2gps) |1.3-0 |1 | | | |lightr |1.3 | | | | |[lmtp](problems.md#lmtp) |0.0.5 |1 | |2 | |mlr3 |0.8.0 | | | | diff --git a/revdep/problems.md b/revdep/problems.md index 50c5333..f32f187 100644 --- a/revdep/problems.md +++ b/revdep/problems.md @@ -91,6 +91,48 @@ Run `revdep_details(, "EpiNow2")` for more info libs 104.8Mb ``` +# gtfs2gps + +
+ +* Version: 1.3-0 +* GitHub: https://github.com/ipeaGIT/gtfs2gps +* Source code: https://github.com/cran/gtfs2gps +* Date/Publication: 2020-09-15 19:50:02 UTC +* Number of recursive dependencies: 71 + +Run `revdep_details(, "gtfs2gps")` for more info + +
+ +## In both + +* checking tests ... + ``` + ... + > test_check("gtfs2gps") + ── 1. Error: gtfs2gps (@test_gtfs2gps.R#70) ─────────────────────────────────── + 'workers >= 1L' is not TRUE + Backtrace: + 1. gtfs2gps::read_gtfs(sp) + 1. gtfs2gps::filter_by_shape_id(., 52000:52200) + 1. gtfs2gps::filter_week_days(.) + 1. gtfs2gps::filter_single_trip(.) + 9. gtfs2gps::gtfs2gps(., parallel = TRUE, spatial_resolution = 15) + 10. future::plan(strategy, workers = cores) + 11. future:::plan_set(...) + 13. future:::nbrOfWorkers.NULL() + 15. future:::nbrOfWorkers.multiprocess(plan("next")) + 16. future:::stop_if_not(...) + + ══ testthat results ═══════════════════════════════════════════════════════════ + [ OK: 153 | SKIPPED: 0 | WARNINGS: 0 | FAILED: 1 ] + 1. Error: gtfs2gps (@test_gtfs2gps.R#70) + + Error: testthat unit tests failed + Execution halted + ``` + # lmtp
From 5fcd0842cbe11afb7c61ac969515152f48fe3fd5 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Thu, 29 Oct 2020 17:46:56 -0700 Subject: [PATCH 20/94] Signal progress after computation rather than before so that not all progress is signaled upfront in case there are more parallel workers than tasks --- OVERVIEW.md | 16 ++++++++-------- README.md | 16 ++++++++-------- incl/progressr-package.R | 2 +- incl/withProgressShiny.R | 2 +- man/progressr.Rd | 2 +- man/withProgressShiny.Rd | 2 +- vignettes/progressr-intro.md | 16 ++++++++-------- 7 files changed, 28 insertions(+), 28 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 9faeaf5..8182ee2 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -225,8 +225,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- lapply(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -244,8 +244,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- foreach(x = xs) %do% { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) } }) @@ -263,8 +263,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- map(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -283,8 +283,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- llply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -315,8 +315,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- future_lapply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -341,8 +341,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- foreach(x = xs) %dopar% { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) } }) @@ -366,8 +366,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- future_map(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -395,8 +395,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- llply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }, .parallel = TRUE) }) diff --git a/README.md b/README.md index 27e1241..dc7b167 100644 --- a/README.md +++ b/README.md @@ -230,8 +230,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- lapply(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -249,8 +249,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- foreach(x = xs) %do% { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) } }) @@ -268,8 +268,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- map(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -288,8 +288,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- llply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -320,8 +320,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- future_lapply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -346,8 +346,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- foreach(x = xs) %dopar% { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) } }) @@ -371,8 +371,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- future_map(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -400,8 +400,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- llply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }, .parallel = TRUE) }) diff --git a/incl/progressr-package.R b/incl/progressr-package.R index 54c2c3e..809bb1a 100644 --- a/incl/progressr-package.R +++ b/incl/progressr-package.R @@ -5,8 +5,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- lapply(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) diff --git a/incl/withProgressShiny.R b/incl/withProgressShiny.R index 64bbcbf..2c33f7d 100644 --- a/incl/withProgressShiny.R +++ b/incl/withProgressShiny.R @@ -13,8 +13,8 @@ app <- shinyApp( detail = "This may take a while ...", value = 0, { p <- progressor(along = X) y <- lapply(X, FUN=function(x) { - p() Sys.sleep(0.25) + p() }) }) diff --git a/man/progressr.Rd b/man/progressr.Rd index a9a5393..7b440a2 100644 --- a/man/progressr.Rd +++ b/man/progressr.Rd @@ -81,8 +81,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- lapply(xs, function(x) { - p(sprintf("x=\%g", x)) Sys.sleep(0.1) + p(sprintf("x=\%g", x)) sqrt(x) }) }) diff --git a/man/withProgressShiny.Rd b/man/withProgressShiny.Rd index 1c29fb3..3bc6d83 100644 --- a/man/withProgressShiny.Rd +++ b/man/withProgressShiny.Rd @@ -44,8 +44,8 @@ app <- shinyApp( detail = "This may take a while ...", value = 0, { p <- progressor(along = X) y <- lapply(X, FUN=function(x) { - p() Sys.sleep(0.25) + p() }) }) diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index b0517d3..387e5a7 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -234,8 +234,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- lapply(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -253,8 +253,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- foreach(x = xs) %do% { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) } }) @@ -272,8 +272,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- map(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -292,8 +292,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- llply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -324,8 +324,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- future_lapply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -350,8 +350,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- foreach(x = xs) %dopar% { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) } }) @@ -375,8 +375,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- future_map(xs, function(x) { - p(sprintf("x=%g", x)) Sys.sleep(6.0-x) + p(sprintf("x=%g", x)) sqrt(x) }) }) @@ -404,8 +404,8 @@ xs <- 1:5 with_progress({ p <- progressor(along = xs) y <- llply(xs, function(x, ...) { - p(sprintf("x=%g", x)) Sys.sleep(0.1) + p(sprintf("x=%g", x)) sqrt(x) }, .parallel = TRUE) }) From ab84f8268c1cfbb6c3d0475306b5a09a38fec913 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 30 Oct 2020 21:12:51 -0700 Subject: [PATCH 21/94] Add the 'pbcol' handler --- DESCRIPTION | 1 + NAMESPACE | 1 + NEWS | 5 +- R/handler_pbcol.R | 115 +++++++++++++++++++++++++++++++++++++++++++ man/handler_pbcol.Rd | 44 +++++++++++++++++ 5 files changed, 165 insertions(+), 1 deletion(-) create mode 100644 R/handler_pbcol.R create mode 100644 man/handler_pbcol.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 5d67337..5b2a51f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,6 +13,7 @@ Suggests: graphics, tcltk, beepr, + crayon, pbmcapply, progress, purrr, diff --git a/NAMESPACE b/NAMESPACE index 5769690..0c4c807 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ export(handler_debug) export(handler_filesize) export(handler_newline) export(handler_notifier) +export(handler_pbcol) export(handler_pbmcapply) export(handler_progress) export(handler_shiny) diff --git a/NEWS b/NEWS index 94fedb5..3314e69 100644 --- a/NEWS +++ b/NEWS @@ -1,12 +1,15 @@ Package: progressr ================== -Version: 0.6.0-9000 [2020-10-29] +Version: 0.6.0-9000 [2020-10-30] NEW FEATURES: * progressor() gained argument 'on_exit = TRUE'. + * Add the 'pbcol' handler, which renders the progress as a colored progress + bar in the terminal with any messages written in the front. + * Progression handlers now return invisibly whether or not they are finished. BUG FIXES: diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R new file mode 100644 index 0000000..ff193dd --- /dev/null +++ b/R/handler_pbcol.R @@ -0,0 +1,115 @@ +#' Progression Handler: Progress Reported as an ANSI Background Color in the Terminal +#' +#' @inheritParams make_progression_handler +#' +#' @param adjust (numeric) The adjustment of the progress update, +#' where `adjust = 0` positions the message to the very left, and +#' `adjust = 1` positions the message to the very right. +#' +#' @param pad (integer) Amount of padding on each side of the message, +#' where padding is done by spaces. +#' +#' @param done_col,todo_col (character string) The \pkg{crayon} background +#' colors used for the progress bar, where `done_col` is used for the part +#' of the progress bar that is already done and `todo_col` for what remains. +#' +#' @param \ldots Additional arguments passed to [make_progression_handler()]. +#' +#' @section Requirements: +#' This progression handler requires the \pkg{crayon} package. +#' +#' @export +handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = "cyan", intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) { + cat_ <- function(...) { + cat(..., sep = "", collapse = "", file = stderr()) + } + + erase_progress_bar <- function() { + cat_(c("\r", rep(" ", times = getOption("width") - 1L), "\r")) + } + + redraw_progress_bar <- function(ratio, message) { + stop_if_not(ratio >= 0, ratio <= 1) + pbstr <- pbcol( + fraction = ratio, + msg = message, + adjust = adjust, + pad = pad, + done_col = done_col, + todo_col = todo_col + ) + cat_("\r", pbstr) + } + + reporter <- local({ + list( + reset = function(...) { + erase_progress_bar() + }, + + finish = function(...) { + erase_progress_bar() + }, + + hide = function(...) { + erase_progress_bar() + }, + + unhide = function(config, state, ...) { + if (!state$enabled || config$times <= 2L) return() + redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) + }, + + update = function(config, state, progression, ...) { + if (!state$enabled || config$times <= 2L) return() + if (state$delta <= 0) return() + redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) + } + ) + }) + + make_progression_handler("pbcol", reporter, intrusiveness = intrusiveness, target = target, ...) +} + + + +pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOption("width"), done_col = "blue", todo_col = "cyan") { + bgColor <- function(s, col) { + bgFcn <- switch(col, + black = crayon::bgBlack, + blue = crayon::bgBlue, + cyan = crayon::bgCyan, + green = crayon::bgGreen, + magenta = crayon::bgMagenta, + red = crayon::bgRed, + yellow = crayon::bgYellow, + white = crayon::bgWhite, + stop("Unknown 'crayon' background color: ", sQuote(col)) + ) + bgFcn(s) + } + + fraction <- as.numeric(fraction) + stopifnot(length(fraction) == 1L, !is.na(fraction), + fraction >= 0, fraction <= 1) + width <- as.integer(width) + stopifnot(length(width) == 1L, !is.na(width), width > 0L) + + msgpad <- (width - 2 * pad) - nchar(msg) + if (msgpad < 0) { + msg <- substr(msg, start = pad, stop = nchar(msg) + msgpad - pad) + msg <- substr(msg, start = 1L, stop = nchar(msg) - 3L) + msg <- paste(msg, "...", sep = "") + msgpad <- (width - 2 * pad) - nchar(msg) + } + lpad <- floor(adjust * msgpad) + pad + rpad <- (msgpad - lpad) + pad + pmsg <- sprintf("%*s%s%*s", lpad, "", msg, rpad, "") + + len <- round(fraction * nchar(pmsg), digits = 0L) + lmsg <- substr(pmsg, start = 1L, stop = len) + rmsg <- substr(pmsg, start = len + 1L, stop = nchar(pmsg)) + lmsg <- bgColor(lmsg, done_col) + rmsg <- bgColor(rmsg, todo_col) + paste(lmsg, rmsg, sep = "") +} diff --git a/man/handler_pbcol.Rd b/man/handler_pbcol.Rd new file mode 100644 index 0000000..e810ef0 --- /dev/null +++ b/man/handler_pbcol.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/handler_pbcol.R +\name{handler_pbcol} +\alias{handler_pbcol} +\title{Progression Handler: Progress Reported as an ANSI Background Color in the Terminal} +\usage{ +handler_pbcol( + adjust = 0, + pad = 1L, + done_col = "blue", + todo_col = "cyan", + intrusiveness = getOption("progressr.intrusiveness.terminal", 1), + target = "terminal", + ... +) +} +\arguments{ +\item{adjust}{(numeric) The adjustment of the progress update, +where \code{adjust = 0} positions the message to the very left, and +\code{adjust = 1} positions the message to the very right.} + +\item{pad}{(integer) Amount of padding on each side of the message, +where padding is done by spaces.} + +\item{done_col, todo_col}{(character string) The \pkg{crayon} background +colors used for the progress bar, where \code{done_col} is used for the part +of the progress bar that is already done and \code{todo_col} for what remains.} + +\item{intrusiveness}{(numeric) A non-negative scalar on how intrusive +(disruptive) the reporter to the user.} + +\item{target}{(character vector) Specifies where progression updates are +rendered.} + +\item{\ldots}{Additional arguments passed to \code{\link[=make_progression_handler]{make_progression_handler()}}.} +} +\description{ +Progression Handler: Progress Reported as an ANSI Background Color in the Terminal +} +\section{Requirements}{ + +This progression handler requires the \pkg{crayon} package. +} + From d0cb6408c39ae07baeb8880f9d900ce7eab7ddd3 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 31 Oct 2020 10:18:07 -0700 Subject: [PATCH 22/94] pbcol handler did not handle empty messages --- R/handler_pbcol.R | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R index ff193dd..63a7b51 100644 --- a/R/handler_pbcol.R +++ b/R/handler_pbcol.R @@ -88,24 +88,33 @@ pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOpt ) bgFcn(s) } - + + if (length(msg) == 0L) msg <- "" + stop_if_not(length(msg) == 1L, is.character(msg)) + fraction <- as.numeric(fraction) - stopifnot(length(fraction) == 1L, !is.na(fraction), + stop_if_not(length(fraction) == 1L, !is.na(fraction), fraction >= 0, fraction <= 1) width <- as.integer(width) - stopifnot(length(width) == 1L, !is.na(width), width > 0L) - + stop_if_not(length(width) == 1L, !is.na(width), width > 0L) + + ## Pad 'msg' to align horizontally msgpad <- (width - 2 * pad) - nchar(msg) + + ## Truncate 'msg'? if (msgpad < 0) { msg <- substr(msg, start = pad, stop = nchar(msg) + msgpad - pad) msg <- substr(msg, start = 1L, stop = nchar(msg) - 3L) msg <- paste(msg, "...", sep = "") msgpad <- (width - 2 * pad) - nchar(msg) } + + ## Pad 'msg' lpad <- floor(adjust * msgpad) + pad rpad <- (msgpad - lpad) + pad pmsg <- sprintf("%*s%s%*s", lpad, "", msg, rpad, "") + ## Make progress bar len <- round(fraction * nchar(pmsg), digits = 0L) lmsg <- substr(pmsg, start = 1L, stop = len) rmsg <- substr(pmsg, start = len + 1L, stop = nchar(pmsg)) From 1cc54c1788f2ed0bf510ac859936b4cbfb8c6aac Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 31 Oct 2020 10:26:57 -0700 Subject: [PATCH 23/94] pbcol did not initate, i.e. it was only display after the first progression --- R/handler_pbcol.R | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R index 63a7b51..52b0fd0 100644 --- a/R/handler_pbcol.R +++ b/R/handler_pbcol.R @@ -43,11 +43,12 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = reporter <- local({ list( - reset = function(...) { - erase_progress_bar() + initiate = function(config, state, ...) { + if (!state$enabled || config$times <= 2L) return() + redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) }, - finish = function(...) { + reset = function(...) { erase_progress_bar() }, @@ -59,11 +60,15 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = if (!state$enabled || config$times <= 2L) return() redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) }, - + update = function(config, state, progression, ...) { if (!state$enabled || config$times <= 2L) return() if (state$delta <= 0) return() redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) + }, + + finish = function(...) { + erase_progress_bar() } ) }) From a262a0bd6370cc598643f9284843466b9965da25 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Tue, 3 Nov 2020 15:14:30 -0800 Subject: [PATCH 24/94] multicore futures now support near-live progress updates [ci skip] --- OVERVIEW.md | 9 +++++---- R/handler_pbcol.R | 6 +++++- README.md | 9 +++++---- inst/WORDLIST | 1 + vignettes/progressr-intro.md | 9 +++++---- 5 files changed, 21 insertions(+), 13 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 8182ee2..1829595 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -408,15 +408,16 @@ _Note:_ Although **progressr** implements support for using `.progress = "progre ### Near-live versus buffered progress updates with futures -As of May 2020, there are three types of **future** backends that are known(*) to provide near-live progress updates: +As of November 2020, there are four types of **future** backends that are known(*) to provide near-live progress updates: 1. `sequential`, - 2. `multisession`, and - 3. `cluster` (local and remote) + 2. `multicore`, + 3. `multisession`, and + 4. `cluster` (local and remote) Here "near-live" means that the progress handlers will report on progress almost immediately when the progress is signaled on the worker. For all other future backends, the progress updates are only relayed back to the main machine and reported together with the results of the futures. For instance, if `future_lapply(X, FUN)` chunks up the processing of, say, 100 elements in `X` into eight futures, we will see progress from each of the 100 elements as they are done when using a future backend supporting "near-live" updates, whereas we will only see those updated to be flushed eight times when using any other types of future backends. -(*) Other future backends, including [`multicore`](https://github.com/HenrikBengtsson/future/issues/419), may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. +(*) Other future backends may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R index 52b0fd0..c342135 100644 --- a/R/handler_pbcol.R +++ b/R/handler_pbcol.R @@ -63,7 +63,11 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = update = function(config, state, progression, ...) { if (!state$enabled || config$times <= 2L) return() - if (state$delta <= 0) return() + if (state$delta < 0) return() + if (state$delta == 0) { + cat_("\r.") + Sys.sleep(0.5) + } redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) }, diff --git a/README.md b/README.md index dc7b167..ab6a63f 100644 --- a/README.md +++ b/README.md @@ -413,15 +413,16 @@ _Note:_ Although **progressr** implements support for using `.progress = "progre ### Near-live versus buffered progress updates with futures -As of May 2020, there are three types of **future** backends that are known(*) to provide near-live progress updates: +As of November 2020, there are four types of **future** backends that are known(*) to provide near-live progress updates: 1. `sequential`, - 2. `multisession`, and - 3. `cluster` (local and remote) + 2. `multicore`, + 3. `multisession`, and + 4. `cluster` (local and remote) Here "near-live" means that the progress handlers will report on progress almost immediately when the progress is signaled on the worker. For all other future backends, the progress updates are only relayed back to the main machine and reported together with the results of the futures. For instance, if `future_lapply(X, FUN)` chunks up the processing of, say, 100 elements in `X` into eight futures, we will see progress from each of the 100 elements as they are done when using a future backend supporting "near-live" updates, whereas we will only see those updated to be flushed eight times when using any other types of future backends. -(*) Other future backends, including [`multicore`](https://github.com/HenrikBengtsson/future/issues/419), may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. +(*) Other future backends may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. diff --git a/inst/WORDLIST b/inst/WORDLIST index 195e1cf..fdd32f4 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -60,3 +60,4 @@ UUID winprogressbar withProgressShiny withRestart +pbcol diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index 387e5a7..1a4d302 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -417,15 +417,16 @@ _Note:_ Although **progressr** implements support for using `.progress = "progre ### Near-live versus buffered progress updates with futures -As of May 2020, there are three types of **future** backends that are known(*) to provide near-live progress updates: +As of November 2020, there are four types of **future** backends that are known(*) to provide near-live progress updates: 1. `sequential`, - 2. `multisession`, and - 3. `cluster` (local and remote) + 2. `multicore`, + 3. `multisession`, and + 4. `cluster` (local and remote) Here "near-live" means that the progress handlers will report on progress almost immediately when the progress is signaled on the worker. For all other future backends, the progress updates are only relayed back to the main machine and reported together with the results of the futures. For instance, if `future_lapply(X, FUN)` chunks up the processing of, say, 100 elements in `X` into eight futures, we will see progress from each of the 100 elements as they are done when using a future backend supporting "near-live" updates, whereas we will only see those updated to be flushed eight times when using any other types of future backends. -(*) Other future backends, including [`multicore`](https://github.com/HenrikBengtsson/future/issues/419), may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. +(*) Other future backends may gain support for "near-live" progress updating later. Adding support for those is independent of the **progressr** package. Feature requests for adding that support should go to those future-backend packages. From d3c33597a0b3be6a1419cab9e7cfcce317a7bf05 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Tue, 10 Nov 2020 18:47:30 -0800 Subject: [PATCH 25/94] CLEANUP: Drop unneeded code --- tests/zzz,purrr.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/zzz,purrr.R b/tests/zzz,purrr.R index af9c8c5..05b476a 100644 --- a/tests/zzz,purrr.R +++ b/tests/zzz,purrr.R @@ -1,7 +1,6 @@ source("incl/start.R") if (requireNamespace("purrr", quietly = TRUE)) { - future::plan("multiprocess") with_progress({ p <- progressor(4) y <- purrr::map(3:6, function(n) { From cd0d5b17e07999ab444d1e73f86d14eeaf2b42fe Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Tue, 10 Nov 2020 18:50:31 -0800 Subject: [PATCH 26/94] CLEANUP: Don't test with deprecated 'multiprocess' futures; instead test with 'sequential', 'multisession', and 'multicore' --- tests/zzz,doFuture.R | 21 +++++++++++++-------- tests/zzz,furrr.R | 18 +++++++++++------- tests/zzz,future.apply.R | 18 +++++++++++------- 3 files changed, 35 insertions(+), 22 deletions(-) diff --git a/tests/zzz,doFuture.R b/tests/zzz,doFuture.R index 3a6d5ed..7df5538 100644 --- a/tests/zzz,doFuture.R +++ b/tests/zzz,doFuture.R @@ -3,14 +3,19 @@ source("incl/start.R") if (requireNamespace("doFuture", quietly = TRUE)) { library("doFuture", character.only = TRUE) registerDoFuture() - future::plan("multiprocess") - with_progress({ - p <- progressor(4) - y <- foreach(n = 3:6) %dopar% { - p() - slow_sum(1:n, stdout=TRUE, message=TRUE) - } - }) + + for (strategy in c("sequential", "multisession", "multicore")) { + future::plan(strategy) + print(future::plan()) + + with_progress({ + p <- progressor(4) + y <- foreach(n = 3:6) %dopar% { + p() + slow_sum(1:n, stdout=TRUE, message=TRUE) + } + }) + } } source("incl/end.R") diff --git a/tests/zzz,furrr.R b/tests/zzz,furrr.R index f01b5ab..906c000 100644 --- a/tests/zzz,furrr.R +++ b/tests/zzz,furrr.R @@ -1,14 +1,18 @@ source("incl/start.R") if (requireNamespace("furrr", quietly = TRUE)) { - future::plan("multiprocess") - with_progress({ - p <- progressor(4) - y <- furrr::future_map(3:6, function(n) { - p() - slow_sum(1:n, stdout=TRUE, message=TRUE) + for (strategy in c("sequential", "multisession", "multicore")) { + future::plan(strategy) + print(future::plan()) + + with_progress({ + p <- progressor(4) + y <- furrr::future_map(3:6, function(n) { + p() + slow_sum(1:n, stdout=TRUE, message=TRUE) + }) }) - }) + } } source("incl/end.R") diff --git a/tests/zzz,future.apply.R b/tests/zzz,future.apply.R index a4bb54e..34ac7f3 100644 --- a/tests/zzz,future.apply.R +++ b/tests/zzz,future.apply.R @@ -1,14 +1,18 @@ source("incl/start.R") if (requireNamespace("future.apply", quietly = TRUE)) { - future::plan("multiprocess") - with_progress({ - p <- progressor(4) - y <- future.apply::future_lapply(3:6, function(n) { - p() - slow_sum(1:n, stdout=TRUE, message=TRUE) + for (strategy in c("sequential", "multisession", "multicore")) { + future::plan(strategy) + print(future::plan()) + + with_progress({ + p <- progressor(4) + y <- future.apply::future_lapply(3:6, function(n) { + p() + slow_sum(1:n, stdout=TRUE, message=TRUE) + }) }) - }) + } } source("incl/end.R") From 6107a7e1100aea98b3b61be4ddad2a354c54f1b0 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Thu, 12 Nov 2020 20:28:33 -0800 Subject: [PATCH 27/94] Add register_global_progression_handler(). Still requires lots of work --- NAMESPACE | 1 + NEWS | 4 +- R/global_progression_handler.R | 193 +++++++++++++++++++++ incl/register_global_progression_handler.R | 10 ++ man/global_progression_handler.Rd | 24 +++ man/register_global_progression_handler.Rd | 39 +++++ 6 files changed, 270 insertions(+), 1 deletion(-) create mode 100644 R/global_progression_handler.R create mode 100644 incl/register_global_progression_handler.R create mode 100644 man/global_progression_handler.Rd create mode 100644 man/register_global_progression_handler.Rd diff --git a/NAMESPACE b/NAMESPACE index 0c4c807..be3b4dd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,6 +24,7 @@ export(progress_aggregator) export(progress_progressr) export(progression) export(progressor) +export(register_global_progression_handler) export(slow_sum) export(withProgressShiny) export(with_progress) diff --git a/NEWS b/NEWS index 3314e69..acd5f05 100644 --- a/NEWS +++ b/NEWS @@ -1,10 +1,12 @@ Package: progressr ================== -Version: 0.6.0-9000 [2020-10-30] +Version: 0.6.0-9000 [2020-11-12] NEW FEATURES: + * Add register_global_progression_handler(). + * progressor() gained argument 'on_exit = TRUE'. * Add the 'pbcol' handler, which renders the progress as a colored progress diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R new file mode 100644 index 0000000..ed7ab5f --- /dev/null +++ b/R/global_progression_handler.R @@ -0,0 +1,193 @@ +#' Add or Remove a Global 'progression' Handler +#' +#' @param action (character string) +#' If `"add"`, a global handler is added. +#' If `"remove"`, it is removed, if it exists. +#' If `"query"`, checks whether a handler is registered or not. +#' +#' @return Returns TRUE if a handler is registered, otherwise FALSE. +#' If `action = "query"`, the value is visible, otherwise invisible. +#' +#' @section Requirements: +#' This function requires R (>= 4.0.0) - the version in which global calling +#' handlers where introduces. +#' +#' @example incl/register_global_progression_handler.R +#' +#' @export +register_global_progression_handler <- function(action = c("add", "remove", "query")) { + action <- match.arg(action) + + if (getRversion() < "4.0.0") { + warning("register_global_progression_handler() requires R (>= 4.0.0)") + return(invisible(FALSE)) + } + + ## All existing handlers + handlers <- globalCallingHandlers() + + exists <- vapply(handlers, FUN = identical, global_progression_handler, FUN.VALUE = FALSE) + if (sum(exists) > 1L) { + warning("Detected more than one registered 'global_progression_handler'. Did you register it manually?") + } + + if (action == "add") { + if (!any(exists)) { + globalCallingHandlers(progression = global_progression_handler) + } + invisible(TRUE) + } else if (action == "remove") { + handlers <- handlers[!exists] + ## Remove all + globalCallingHandlers(NULL) + ## Add back the ones we didn't drop + globalCallingHandlers(handlers) + invisible(FALSE) + } else if (action == "query") { + any(exists) + } +} + + +#' A Global Calling Handler For 'progression':s +#' +#' @param progression A [progression] conditions. +#' +#' @return Nothing. +#' +#' @section Requirements: +#' This function requires R (>= 4.0.0) - the version in which global calling +#' handlers where introduces. +#' +#' @keywords internal +global_progression_handler <- local({ + current_progressor_uuid <- NULL + calling_handler <- NULL + genv <- globalenv() + + update_calling_handler <- function() { + handlers <- handlers() + # Nothing to do? + if (length(handlers) == 0L) return(NULL) + + ## FIXME(?) + if (!is.list(handlers)) handlers <- list(handlers) + + for (kk in seq_along(handlers)) { + handler <- handlers[[kk]] + stop_if_not(is.function(handler)) + if (!inherits(handler, "progression_handler")) { + handler <- handler() + stop_if_not(is.function(handler), + inherits(handler, "progression_handler")) + handlers[[kk]] <- handler + } + } + + ## Keep only enabled handlers + enabled <- vapply(handlers, FUN = function(h) { + env <- environment(h) + value <- env$enable + isTRUE(value) || is.null(value) + }, FUN.VALUE = TRUE) + handlers <- handlers[enabled] + + # Nothing to do? + if (length(handlers) == 0L) return(NULL) + + if (length(handlers) > 1L) { + calling_handler <<- function(p) { + finished <- rep(NA, times = length(handlers)) + for (kk in seq_along(handlers)) { + handler <- handlers[[kk]] + finished[kk] <- handler(p) + } + stop_if_not(all(finished == finished[1])) + finished[1] + } + } else { + calling_handler <<- handlers[[1]] + } + } + + function(progression) { + ## To please R CMD check + calling_handler <- NULL; rm(list = "calling_handler") + + stop_if_not(inherits(progression, "progression")) + + assign(".Last.progression", value = progression, envir = genv, inherits = FALSE) + + debug <- getOption("progressr.global.debug", FALSE) + + if (debug) message(sprintf("*** Caught a %s condition:", sQuote(class(progression)[1]))) + progressor_uuid <- progression[["progressor_uuid"]] + if (debug) message(" - source: ", progressor_uuid) + + ## Listen to this progressor? + if (!is.null(current_progressor_uuid) && + !identical(progressor_uuid, current_progressor_uuid)) { + if (debug) message(" - action: ignoring, already listening to another") + return() + } + + type <- progression[["type"]] + if (debug) message(" - type: ", type) + + if (type == "initiate") { + if (identical(progressor_uuid, current_progressor_uuid)) { + stop(sprintf("INTERNAL ERROR: Already listening to this progressor which just sent another %s request", sQuote(type))) + } + if (debug) message(" - start listening") + current_progressor_uuid <<- progressor_uuid + if (debug) message(" - reset progression handlers") + update_calling_handler() + if (!is.null(calling_handler)) { + calling_handler(control_progression("reset")) + if (debug) message(" - initiate progression handlers") + finished <- calling_handler(progression) + if (debug) message(" - finished: ", finished) + } + } else if (type == "update") { + if (is.null(current_progressor_uuid)) { + ## We might receive zero-amount progress updates after the fact that the + ## progress has been completed + amount <- progression$amount + if (!is.numeric(amount) || amount > 0) { + stop(sprintf("INTERNAL ERROR: Received an %s request but is not listening to this progressor", sQuote(type))) + } + } + if (debug) message(" - update progression handlers") + if (!is.null(calling_handler)) { + finished <- calling_handler(progression) + if (debug) message(" - finished: ", finished) + if (finished) { + calling_handler(control_progression("shutdown")) + current_progressor_uuid <<- NULL + } + } + } else if (type == "finish") { + ## Already shutdown? Do nothing + if (!is.null(current_progressor_uuid)) { + if (debug) message(" - shutdown progression handlers") + if (!is.null(calling_handler)) { + finished <- calling_handler(progression) + if (debug) message(" - finished: ", finished) + } + current_progressor_uuid <<- NULL + calling_handler <<- NULL + } + } + if (debug) message(" - done") + + return() + } +}) ## global_progression_handler() + + + +if (getRversion() < "4.0.0") { + globalCallingHandlers <- function(...) { + stop("register_global_progression_handler() requires R (>= 4.0.0)") + } +} diff --git a/incl/register_global_progression_handler.R b/incl/register_global_progression_handler.R new file mode 100644 index 0000000..e39463c --- /dev/null +++ b/incl/register_global_progression_handler.R @@ -0,0 +1,10 @@ +\dontshow{if (getRversion() >= "4.0.0")} +register_global_progression_handler("add") + +## This renders progress updates for each of the three calls slow_sum() +for (ii in 1:3) { + xs <- seq_len(ii + 3) + message(sprintf("%d. slow_sum()", ii)) + y <- slow_sum(xs, message = FALSE) + print(y) +} diff --git a/man/global_progression_handler.Rd b/man/global_progression_handler.Rd new file mode 100644 index 0000000..f56d7e5 --- /dev/null +++ b/man/global_progression_handler.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/global_progression_handler.R +\name{global_progression_handler} +\alias{global_progression_handler} +\title{A Global Calling Handler For 'progression':s} +\usage{ +global_progression_handler(progression) +} +\arguments{ +\item{progression}{A \link{progression} conditions.} +} +\value{ +Nothing. +} +\description{ +A Global Calling Handler For 'progression':s +} +\section{Requirements}{ + +This function requires R (>= 4.0.0) - the version in which global calling +handlers where introduces. +} + +\keyword{internal} diff --git a/man/register_global_progression_handler.Rd b/man/register_global_progression_handler.Rd new file mode 100644 index 0000000..8f511fd --- /dev/null +++ b/man/register_global_progression_handler.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/global_progression_handler.R +\name{register_global_progression_handler} +\alias{register_global_progression_handler} +\title{Add or Remove a Global 'progression' Handler} +\usage{ +register_global_progression_handler(action = c("add", "remove", "query")) +} +\arguments{ +\item{action}{(character string) +If \code{"add"}, a global handler is added. +If \code{"remove"}, it is removed, if it exists. +If \code{"query"}, checks whether a handler is registered or not.} +} +\value{ +Returns TRUE if a handler is registered, otherwise FALSE. +If \code{action = "query"}, the value is visible, otherwise invisible. +} +\description{ +Add or Remove a Global 'progression' Handler +} +\section{Requirements}{ + +This function requires R (>= 4.0.0) - the version in which global calling +handlers where introduces. +} + +\examples{ +\dontshow{if (getRversion() >= "4.0.0")} +register_global_progression_handler("add") + +## This renders progress updates for each of the three calls slow_sum() +for (ii in 1:3) { + xs <- seq_len(ii + 3) + message(sprintf("\%d. slow_sum()", ii)) + y <- slow_sum(xs, message = FALSE) + print(y) +} +} From 421fdcf72fa3e138ffcaf4d2db50d5f513ec3841 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Thu, 12 Nov 2020 22:40:50 -0800 Subject: [PATCH 28/94] Restructuring/cleanup --- R/global_progression_handler.R | 155 ++++++++++++++++----- R/with_progress.R | 112 ++------------- incl/register_global_progression_handler.R | 3 + man/register_global_progression_handler.Rd | 3 + 4 files changed, 140 insertions(+), 133 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index ed7ab5f..08e4209 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -70,44 +70,15 @@ global_progression_handler <- local({ # Nothing to do? if (length(handlers) == 0L) return(NULL) - ## FIXME(?) - if (!is.list(handlers)) handlers <- list(handlers) - - for (kk in seq_along(handlers)) { - handler <- handlers[[kk]] - stop_if_not(is.function(handler)) - if (!inherits(handler, "progression_handler")) { - handler <- handler() - stop_if_not(is.function(handler), - inherits(handler, "progression_handler")) - handlers[[kk]] <- handler - } - } - - ## Keep only enabled handlers - enabled <- vapply(handlers, FUN = function(h) { - env <- environment(h) - value <- env$enable - isTRUE(value) || is.null(value) - }, FUN.VALUE = TRUE) - handlers <- handlers[enabled] + handlers <- as_progression_handler(handlers) # Nothing to do? if (length(handlers) == 0L) return(NULL) - if (length(handlers) > 1L) { - calling_handler <<- function(p) { - finished <- rep(NA, times = length(handlers)) - for (kk in seq_along(handlers)) { - handler <- handlers[[kk]] - finished[kk] <- handler(p) - } - stop_if_not(all(finished == finished[1])) - finished[1] - } - } else { - calling_handler <<- handlers[[1]] - } + ## Do we need to buffer? + delays <- use_delays(handlers) + + calling_handler <<- make_calling_handler(handlers) } function(progression) { @@ -191,3 +162,119 @@ if (getRversion() < "4.0.0") { stop("register_global_progression_handler() requires R (>= 4.0.0)") } } + + + +buffer_stdout <- function() { + stdout_file <- rawConnection(raw(0L), open = "w") + sink(stdout_file, type = "output", split = FALSE) + stdout_file +} ## buffer_stdout() + +flush_stdout <- function(stdout_file, close = TRUE) { + if (is.null(stdout_file)) return(NULL) + sink(type = "output", split = FALSE) + stdout <- rawToChar(rawConnectionValue(stdout_file)) + if (length(stdout) > 0) cat(stdout, file = stdout()) + close(stdout_file) + stdout_file <- NULL + if (!close) stdout_file <- buffer_stdout() + stdout_file +} ## flush_stdout() + +has_buffered_stdout <- function(stdout_file) { + !is.null(stdout_file) && (length(rawConnectionValue(stdout_file)) > 0L) +} + +flush_conditions <- function(conditions) { + for (c in conditions) { + if (inherits(c, "message")) { + message(c) + } else if (inherits(c, "warning")) { + warning(c) + } else if (inherits(c, "condition")) { + signalCondition(c) + } + } + list() +} ## flush_conditions() + + + +as_progression_handler <- function(handlers, drop = TRUE) { + ## FIXME(?) + if (!is.list(handlers)) handlers <- list(handlers) + + for (kk in seq_along(handlers)) { + handler <- handlers[[kk]] + stop_if_not(is.function(handler)) + if (!inherits(handler, "progression_handler")) { + handler <- handler() + stop_if_not(is.function(handler), + inherits(handler, "progression_handler")) + handlers[[kk]] <- handler + } + } + + ## Keep only enabled handlers? + if (drop) { + enabled <- vapply(handlers, FUN = function(h) { + env <- environment(h) + value <- env$enable + isTRUE(value) || is.null(value) + }, FUN.VALUE = TRUE) + handlers <- handlers[enabled] + } + + handlers +} + + + +use_delays <- function(handlers, terminal = NULL, stdout = NULL, conditions = NULL) { + ## Do we need to buffer terminal output? + if (is.null(terminal)) { + delay <- vapply(handlers, FUN = function(h) { + env <- environment(h) + any(env$target == "terminal") + }, FUN.VALUE = NA) + terminal <- any(delay, na.rm = TRUE) + + ## If buffering output, does all handlers support intermediate flushing? + if (terminal) { + flush <- vapply(handlers, FUN = function(h) { + env <- environment(h) + if (!any(env$target == "terminal")) return(TRUE) + !inherits(env$reporter$hide, "null_function") + }, FUN.VALUE = NA) + attr(terminal, "flush") <- all(flush, na.rm = TRUE) + } + } + + if (is.null(stdout)) { + stdout <- getOption("progressr.delay_stdout", terminal) + } + + if (is.null(conditions)) { + conditions <- getOption("progressr.delay_conditions", { + if (terminal) c("condition") else character(0L) + }) + } + + list(terminal = terminal, stdout = stdout, conditions = conditions) +} + + +make_calling_handler <- function(handlers) { + if (length(handlers) > 1L) { + calling_handler <- function(p) { + for (kk in seq_along(handlers)) { + handler <- handlers[[kk]] + handler(p) + } + } + } else { + calling_handler <- handlers[[1]] + } + calling_handler +} diff --git a/R/with_progress.R b/R/with_progress.R index 7ffff17..946823d 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -62,40 +62,6 @@ #' #' @export with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE, delay_terminal = NULL, delay_stdout = NULL, delay_conditions = NULL, interval = NULL, enable = NULL) { - buffer_stdout <- function() { - stdout_file <- rawConnection(raw(0L), open = "w") - sink(stdout_file, type = "output", split = FALSE) - stdout_file - } ## buffer_stdout() - - flush_stdout <- function(stdout_file, close = TRUE) { - if (is.null(stdout_file)) return(NULL) - sink(type = "output", split = FALSE) - stdout <- rawToChar(rawConnectionValue(stdout_file)) - if (length(stdout) > 0) cat(stdout, file = stdout()) - close(stdout_file) - stdout_file <- NULL - if (!close) stdout_file <- buffer_stdout() - stdout_file - } ## flush_stdout() - - has_buffered_stdout <- function(stdout_file) { - !is.null(stdout_file) && (length(rawConnectionValue(stdout_file)) > 0L) - } - - flush_conditions <- function(conditions) { - for (c in conditions) { - if (inherits(c, "message")) { - message(c) - } else if (inherits(c, "warning")) { - warning(c) - } else if (inherits(c, "condition")) { - signalCondition(c) - } - } - list() - } ## flush_conditions() - stop_if_not(is.logical(cleanup), length(cleanup) == 1L, !is.na(cleanup)) ## FIXME: With zero handlers, progression conditions will be @@ -127,72 +93,20 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE on.exit(options(oopts)) } - if (!is.list(handlers)) handlers <- list(handlers) + handlers <- as_progression_handler(handlers) - for (kk in seq_along(handlers)) { - handler <- handlers[[kk]] - stop_if_not(is.function(handler)) - if (!inherits(handler, "progression_handler")) { - handler <- handler() - stop_if_not(is.function(handler), - inherits(handler, "progression_handler")) - handlers[[kk]] <- handler - } - } - - ## Keep only enabled handlers - enabled <- vapply(handlers, FUN = function(h) { - env <- environment(h) - value <- env$enable - isTRUE(value) || is.null(value) - }, FUN.VALUE = TRUE) - handlers <- handlers[enabled] - ## Nothing to do? if (length(handlers) == 0L) return(expr) - - - ## Do we need to buffer terminal output? - if (is.null(delay_terminal)) { - delay_terminal <- vapply(handlers, FUN = function(h) { - env <- environment(h) - any(env$target == "terminal") - }, FUN.VALUE = NA) - delay_terminal <- any(delay_terminal, na.rm = TRUE) - } - if (is.null(delay_stdout)) { - delay_stdout <- getOption("progressr.delay_stdout", delay_terminal) - } - - if (is.null(delay_conditions)) { - delay_conditions <- getOption("progressr.delay_conditions", { - if (delay_terminal) c("condition") else character(0L) - }) - } - - ## If buffering output, does all handlers support intermediate flushing? - flush_terminal <- FALSE - if (delay_terminal) { - flush_terminal <- vapply(handlers, FUN = function(h) { - env <- environment(h) - if (!any(env$target == "terminal")) return(TRUE) - !inherits(env$reporter$hide, "null_function") - }, FUN.VALUE = NA) - flush_terminal <- all(flush_terminal, na.rm = TRUE) - } - - if (length(handlers) > 1L) { - calling_handler <- function(p) { - for (kk in seq_along(handlers)) { - handler <- handlers[[kk]] - handler(p) - } - } - } else { - calling_handler <- handlers[[1]] - } + ## Do we need to buffer? + delays <- use_delays(handlers, + terminal = delay_terminal, + stdout = delay_stdout, + conditions = delay_conditions + ) + calling_handler <- make_calling_handler(handlers) + ## Flag indicating whether with_progress() exited due to ## an error or not. status <- "incomplete" @@ -210,7 +124,7 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE } ## Delay standard output? - if (delay_stdout) { + if (delays$stdout) { stdout_file <- buffer_stdout() on.exit(flush_stdout(stdout_file), add = TRUE) } else { @@ -219,7 +133,7 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE ## Delay conditions? conditions <- list() - if (length(delay_conditions) > 0) { + if (length(delays$conditions) > 0) { on.exit(flush_conditions(conditions), add = TRUE) } @@ -240,7 +154,7 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE on.exit(capture_conditions <<- TRUE) ## Any buffered output to flush? - if (flush_terminal) { + if (isTRUE(attr(delays$terminal, "flush"))) { if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { calling_handler(control_progression("hide")) stdout_file <<- flush_stdout(stdout_file, close = FALSE) @@ -253,7 +167,7 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE }, condition = function(c) { if (!capture_conditions || inherits(c, c("progression", "error"))) return() - if (inherits(c, delay_conditions)) { + if (inherits(c, delays$conditions)) { ## Record conditions[[length(conditions) + 1L]] <<- c ## Muffle diff --git a/incl/register_global_progression_handler.R b/incl/register_global_progression_handler.R index e39463c..b6c6d2d 100644 --- a/incl/register_global_progression_handler.R +++ b/incl/register_global_progression_handler.R @@ -8,3 +8,6 @@ for (ii in 1:3) { y <- slow_sum(xs, message = FALSE) print(y) } + +\dontshow{if (getRversion() >= "4.0.0")} +register_global_progression_handler("remove") diff --git a/man/register_global_progression_handler.Rd b/man/register_global_progression_handler.Rd index 8f511fd..5c25a43 100644 --- a/man/register_global_progression_handler.Rd +++ b/man/register_global_progression_handler.Rd @@ -36,4 +36,7 @@ for (ii in 1:3) { y <- slow_sum(xs, message = FALSE) print(y) } + +\dontshow{if (getRversion() >= "4.0.0")} +register_global_progression_handler("remove") } From bfc848daf1b23979d771aab5d32db882afa667a9 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 13 Nov 2020 07:27:37 -0800 Subject: [PATCH 29/94] ROADMAP: Mention global calling handlers [ci skip] --- OVERVIEW.md | 8 +++++--- README.md | 8 +++++--- vignettes/progressr-intro.md | 8 +++++--- 3 files changed, 15 insertions(+), 9 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 1829595..00f614a 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -465,10 +465,12 @@ will. Because this project is under active development, the progressr API is currently kept at a very minimum. This will allow for the framework and the API to evolve while minimizing the risk for breaking code that depends on it. The roadmap for developing the API is roughly: 1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` - -2. Add support for nested progress updates -3. Add API to allow users and package developers to design additional progression handlers +2. Add support for global progress handlers removing the need user having to specify `with_progress()` + +3. Add support for nested progress updates + +4. Add API to allow users and package developers to design additional progression handlers For a more up-to-date view on what features might be added, see . diff --git a/README.md b/README.md index ab6a63f..120f667 100644 --- a/README.md +++ b/README.md @@ -470,10 +470,12 @@ will. Because this project is under active development, the progressr API is currently kept at a very minimum. This will allow for the framework and the API to evolve while minimizing the risk for breaking code that depends on it. The roadmap for developing the API is roughly: 1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` - -2. Add support for nested progress updates -3. Add API to allow users and package developers to design additional progression handlers +2. Add support for global progress handlers removing the need user having to specify `with_progress()` + +3. Add support for nested progress updates + +4. Add API to allow users and package developers to design additional progression handlers For a more up-to-date view on what features might be added, see . diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index 1a4d302..bcbf747 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -474,10 +474,12 @@ will. Because this project is under active development, the progressr API is currently kept at a very minimum. This will allow for the framework and the API to evolve while minimizing the risk for breaking code that depends on it. The roadmap for developing the API is roughly: 1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` - -2. Add support for nested progress updates -3. Add API to allow users and package developers to design additional progression handlers +2. Add support for global progress handlers removing the need user having to specify `with_progress()` + +3. Add support for nested progress updates + +4. Add API to allow users and package developers to design additional progression handlers For a more up-to-date view on what features might be added, see . From ec440c50d466d61c03bbcfb992f473c9ad767798 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 13 Nov 2020 07:28:57 -0800 Subject: [PATCH 30/94] typo [ci skip] --- OVERVIEW.md | 2 +- README.md | 2 +- vignettes/progressr-intro.md | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 00f614a..4cca32e 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -466,7 +466,7 @@ Because this project is under active development, the progressr API is currently 1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` -2. Add support for global progress handlers removing the need user having to specify `with_progress()` +2. Add support for global progress handlers removing the need for the user having to specify `with_progress()` 3. Add support for nested progress updates diff --git a/README.md b/README.md index 120f667..359d396 100644 --- a/README.md +++ b/README.md @@ -471,7 +471,7 @@ Because this project is under active development, the progressr API is currently 1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` -2. Add support for global progress handlers removing the need user having to specify `with_progress()` +2. Add support for global progress handlers removing the need for the user having to specify `with_progress()` 3. Add support for nested progress updates diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index bcbf747..8e02872 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -475,7 +475,7 @@ Because this project is under active development, the progressr API is currently 1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` -2. Add support for global progress handlers removing the need user having to specify `with_progress()` +2. Add support for global progress handlers removing the need for the user having to specify `with_progress()` 3. Add support for nested progress updates From eac0367d9d2574492541f3c064e5f159444523cc Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 13 Nov 2020 08:43:55 -0800 Subject: [PATCH 31/94] Global handlers: Now buffering/flushing stdout --- R/global_progression_handler.R | 34 ++++++++++++++++++++-- R/with_progress.R | 8 ++--- incl/register_global_progression_handler.R | 2 +- man/register_global_progression_handler.Rd | 2 +- 4 files changed, 35 insertions(+), 11 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 08e4209..dae809b 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -63,6 +63,8 @@ register_global_progression_handler <- function(action = c("add", "remove", "que global_progression_handler <- local({ current_progressor_uuid <- NULL calling_handler <- NULL + delays <- NULL + stdout_file <- NULL genv <- globalenv() update_calling_handler <- function() { @@ -76,7 +78,7 @@ global_progression_handler <- local({ if (length(handlers) == 0L) return(NULL) ## Do we need to buffer? - delays <- use_delays(handlers) + delays <<- use_delays(handlers) calling_handler <<- make_calling_handler(handlers) } @@ -101,7 +103,19 @@ global_progression_handler <- local({ if (debug) message(" - action: ignoring, already listening to another") return() } - + + + if (!is.null(calling_handler) && !is.null(delays)) { + ## Any buffered output to flush? + if (isTRUE(attr(delays$terminal, "flush"))) { + if (has_buffered_stdout(stdout_file)) { + calling_handler(control_progression("hide")) + stdout_file <<- flush_stdout(stdout_file, close = FALSE) + calling_handler(control_progression("unhide")) + } + } + } + type <- progression[["type"]] if (debug) message(" - type: ", type) @@ -113,7 +127,8 @@ global_progression_handler <- local({ current_progressor_uuid <<- progressor_uuid if (debug) message(" - reset progression handlers") update_calling_handler() - if (!is.null(calling_handler)) { + if (!is.null(calling_handler)) { + stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) calling_handler(control_progression("reset")) if (debug) message(" - initiate progression handlers") finished <- calling_handler(progression) @@ -130,6 +145,7 @@ global_progression_handler <- local({ } if (debug) message(" - update progression handlers") if (!is.null(calling_handler)) { + stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) finished <- calling_handler(progression) if (debug) message(" - finished: ", finished) if (finished) { @@ -142,11 +158,14 @@ global_progression_handler <- local({ if (!is.null(current_progressor_uuid)) { if (debug) message(" - shutdown progression handlers") if (!is.null(calling_handler)) { + stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) finished <- calling_handler(progression) + stdout_file <<- flush_stdout(stdout_file, close = TRUE) if (debug) message(" - finished: ", finished) } current_progressor_uuid <<- NULL calling_handler <<- NULL + stop_if_not(is.null(stdout_file)) } } if (debug) message(" - done") @@ -265,6 +284,15 @@ use_delays <- function(handlers, terminal = NULL, stdout = NULL, conditions = NU } +delay_stdout <- function(delays, stdout_file) { + ## Delay standard output? + if (is.null(stdout_file) && delays$stdout) { + stdout_file <- buffer_stdout() + } + stdout_file +} + + make_calling_handler <- function(handlers) { if (length(handlers) > 1L) { calling_handler <- function(p) { diff --git a/R/with_progress.R b/R/with_progress.R index 946823d..2ebd3cf 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -124,12 +124,8 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE } ## Delay standard output? - if (delays$stdout) { - stdout_file <- buffer_stdout() - on.exit(flush_stdout(stdout_file), add = TRUE) - } else { - stdout_file <- NULL - } + stdout_file <- delay_stdout(delays, stdout_file = NULL) + on.exit(flush_stdout(stdout_file), add = TRUE) ## Delay conditions? conditions <- list() diff --git a/incl/register_global_progression_handler.R b/incl/register_global_progression_handler.R index b6c6d2d..5c25b4b 100644 --- a/incl/register_global_progression_handler.R +++ b/incl/register_global_progression_handler.R @@ -5,7 +5,7 @@ register_global_progression_handler("add") for (ii in 1:3) { xs <- seq_len(ii + 3) message(sprintf("%d. slow_sum()", ii)) - y <- slow_sum(xs, message = FALSE) + y <- slow_sum(xs, stdout = TRUE, message = FALSE) print(y) } diff --git a/man/register_global_progression_handler.Rd b/man/register_global_progression_handler.Rd index 5c25a43..3f5f7bc 100644 --- a/man/register_global_progression_handler.Rd +++ b/man/register_global_progression_handler.Rd @@ -33,7 +33,7 @@ register_global_progression_handler("add") for (ii in 1:3) { xs <- seq_len(ii + 3) message(sprintf("\%d. slow_sum()", ii)) - y <- slow_sum(xs, message = FALSE) + y <- slow_sum(xs, stdout = TRUE, message = FALSE) print(y) } From ade37a9f790843b0316994b0b59bf29bd7a04d46 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 13 Nov 2020 10:45:04 -0800 Subject: [PATCH 32/94] cleanup example --- incl/register_global_progression_handler.R | 2 +- man/register_global_progression_handler.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/incl/register_global_progression_handler.R b/incl/register_global_progression_handler.R index 5c25b4b..27d769d 100644 --- a/incl/register_global_progression_handler.R +++ b/incl/register_global_progression_handler.R @@ -1,5 +1,5 @@ \dontshow{if (getRversion() >= "4.0.0")} -register_global_progression_handler("add") +register_global_progression_handler() ## This renders progress updates for each of the three calls slow_sum() for (ii in 1:3) { diff --git a/man/register_global_progression_handler.Rd b/man/register_global_progression_handler.Rd index 3f5f7bc..f1d56b3 100644 --- a/man/register_global_progression_handler.Rd +++ b/man/register_global_progression_handler.Rd @@ -27,7 +27,7 @@ handlers where introduces. \examples{ \dontshow{if (getRversion() >= "4.0.0")} -register_global_progression_handler("add") +register_global_progression_handler() ## This renders progress updates for each of the three calls slow_sum() for (ii in 1:3) { From dc2e56c2ad3686e3f08f254234027495ffa1b2cf Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 13 Nov 2020 11:11:21 -0800 Subject: [PATCH 33/94] Global handlers: Now buffering/flushing conditions, e.g. messages and warnings --- R/global_progression_handler.R | 53 ++++++++++++++++++++-- incl/register_global_progression_handler.R | 2 +- man/global_progression_handler.Rd | 2 +- man/register_global_progression_handler.Rd | 2 +- 4 files changed, 51 insertions(+), 8 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index dae809b..22b95e3 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -33,7 +33,7 @@ register_global_progression_handler <- function(action = c("add", "remove", "que if (action == "add") { if (!any(exists)) { - globalCallingHandlers(progression = global_progression_handler) + globalCallingHandlers(condition = global_progression_handler) } invisible(TRUE) } else if (action == "remove") { @@ -65,6 +65,8 @@ global_progression_handler <- local({ calling_handler <- NULL delays <- NULL stdout_file <- NULL + capture_conditions <- TRUE + conditions <- list() genv <- globalenv() update_calling_handler <- function() { @@ -83,10 +85,14 @@ global_progression_handler <- local({ calling_handler <<- make_calling_handler(handlers) } - function(progression) { + handle_progression <- function(progression) { ## To please R CMD check calling_handler <- NULL; rm(list = "calling_handler") - + + ## Don't capture conditions that are produced by progression handlers + capture_conditions <<- FALSE + on.exit(capture_conditions <<- TRUE) + stop_if_not(inherits(progression, "progression")) assign(".Last.progression", value = progression, envir = genv, inherits = FALSE) @@ -108,9 +114,10 @@ global_progression_handler <- local({ if (!is.null(calling_handler) && !is.null(delays)) { ## Any buffered output to flush? if (isTRUE(attr(delays$terminal, "flush"))) { - if (has_buffered_stdout(stdout_file)) { + if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { calling_handler(control_progression("hide")) stdout_file <<- flush_stdout(stdout_file, close = FALSE) + conditions <<- flush_conditions(conditions) calling_handler(control_progression("unhide")) } } @@ -161,16 +168,52 @@ global_progression_handler <- local({ stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) finished <- calling_handler(progression) stdout_file <<- flush_stdout(stdout_file, close = TRUE) + conditions <<- flush_conditions(conditions) if (debug) message(" - finished: ", finished) } current_progressor_uuid <<- NULL calling_handler <<- NULL - stop_if_not(is.null(stdout_file)) + stop_if_not(is.null(stdout_file), length(conditions) == 0L) } } if (debug) message(" - done") return() + } ## handle_progression() + + + function(condition) { + ## Nothing do to? + if (!capture_conditions || inherits(condition, "error")) return() + + ## A 'progression' update? + if (inherits(condition, "progression")) { + return(handle_progression(condition)) + } + + ## Nothing more do to? + if (is.null(delays) || !inherits(condition, delays$conditions)) return() + + ## Record non-progression condition to be flushed later + conditions[[length(conditions) + 1L]] <<- condition + + ## Muffle it for now + if (inherits(condition, "message")) { + invokeRestart("muffleMessage") + } else if (inherits(condition, "warning")) { + invokeRestart("muffleWarning") + } else if (inherits(condition, "condition")) { + ## If there is a "muffle" restart for this condition, + ## then invoke that restart, i.e. "muffle" the condition + restarts <- computeRestarts(condition) + for (restart in restarts) { + name <- restart$name + if (is.null(name)) next + if (!grepl("^muffle", name)) next + invokeRestart(restart) + break + } + } } }) ## global_progression_handler() diff --git a/incl/register_global_progression_handler.R b/incl/register_global_progression_handler.R index 27d769d..bf88158 100644 --- a/incl/register_global_progression_handler.R +++ b/incl/register_global_progression_handler.R @@ -5,7 +5,7 @@ register_global_progression_handler() for (ii in 1:3) { xs <- seq_len(ii + 3) message(sprintf("%d. slow_sum()", ii)) - y <- slow_sum(xs, stdout = TRUE, message = FALSE) + y <- slow_sum(xs, stdout = TRUE, message = TRUE) print(y) } diff --git a/man/global_progression_handler.Rd b/man/global_progression_handler.Rd index f56d7e5..e48838e 100644 --- a/man/global_progression_handler.Rd +++ b/man/global_progression_handler.Rd @@ -4,7 +4,7 @@ \alias{global_progression_handler} \title{A Global Calling Handler For 'progression':s} \usage{ -global_progression_handler(progression) +global_progression_handler(condition) } \arguments{ \item{progression}{A \link{progression} conditions.} diff --git a/man/register_global_progression_handler.Rd b/man/register_global_progression_handler.Rd index f1d56b3..5594098 100644 --- a/man/register_global_progression_handler.Rd +++ b/man/register_global_progression_handler.Rd @@ -33,7 +33,7 @@ register_global_progression_handler() for (ii in 1:3) { xs <- seq_len(ii + 3) message(sprintf("\%d. slow_sum()", ii)) - y <- slow_sum(xs, stdout = TRUE, message = FALSE) + y <- slow_sum(xs, stdout = TRUE, message = TRUE) print(y) } From 6541a4d38ccda7fb3e253834c58d97cef0df1122 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 13 Nov 2020 16:52:05 -0800 Subject: [PATCH 34/94] Make sure to shut down active global handler when there's an 'interrupt' or an 'error'. This makes sure the next progressor is accepted but also that buffering of stdout and conditions are stopped and flushed --- R/global_progression_handler.R | 47 ++++++++++++++++++++++------------ 1 file changed, 30 insertions(+), 17 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 22b95e3..f1e393f 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -85,6 +85,24 @@ global_progression_handler <- local({ calling_handler <<- make_calling_handler(handlers) } + finish <- function(progression, debug = FALSE) { + ## Already shutdown? Do nothing + if (is.null(current_progressor_uuid)) return() + + if (debug) message(" - shutdown progression handlers") + if (!is.null(calling_handler)) { + stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) + finished <- calling_handler(progression) + stdout_file <<- flush_stdout(stdout_file, close = TRUE) + conditions <<- flush_conditions(conditions) + delays <<- NULL + if (debug) message(" - finished: ", finished) + } + current_progressor_uuid <<- NULL + calling_handler <<- NULL + stop_if_not(is.null(stdout_file), length(conditions) == 0L, is.null(delays)) + } + handle_progression <- function(progression) { ## To please R CMD check calling_handler <- NULL; rm(list = "calling_handler") @@ -161,20 +179,7 @@ global_progression_handler <- local({ } } } else if (type == "finish") { - ## Already shutdown? Do nothing - if (!is.null(current_progressor_uuid)) { - if (debug) message(" - shutdown progression handlers") - if (!is.null(calling_handler)) { - stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) - finished <- calling_handler(progression) - stdout_file <<- flush_stdout(stdout_file, close = TRUE) - conditions <<- flush_conditions(conditions) - if (debug) message(" - finished: ", finished) - } - current_progressor_uuid <<- NULL - calling_handler <<- NULL - stop_if_not(is.null(stdout_file), length(conditions) == 0L) - } + finish(progression, debug = debug) } if (debug) message(" - done") @@ -183,14 +188,22 @@ global_progression_handler <- local({ function(condition) { - ## Nothing do to? - if (!capture_conditions || inherits(condition, "error")) return() - + ## Shut down progression handling? + if (inherits(condition, c("interrupt", "error"))) { + progression <- control_progression("shutdown") + finish(progression) + stop_if_not(is.null(stdout_file), length(conditions) == 0L, capture_conditions) + return() + } + ## A 'progression' update? if (inherits(condition, "progression")) { return(handle_progression(condition)) } + ## Nothing do to? + if (!capture_conditions) return() + ## Nothing more do to? if (is.null(delays) || !inherits(condition, delays$conditions)) return() From 6fd5ef24b54ab55203d12e0763918678898214e9 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 11:28:04 -0800 Subject: [PATCH 35/94] BUG FIX: known_progression_handlers() would incorrectly return also handler_backend_args() --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index f19af56..35e8c3a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -102,7 +102,7 @@ is_fake <- local({ known_progression_handlers <- function(exclude = NULL) { ns <- asNamespace(.packageName) handlers <- ls(envir = ns, pattern = "^handler_") - handlers <- setdiff(handlers, c("make_progression_handler", "print.progression_handler")) + handlers <- setdiff(handlers, c("handler_backend_args", "make_progression_handler", "print.progression_handler")) handlers <- setdiff(handlers, exclude) handlers <- mget(handlers, envir = ns, inherits = FALSE) handlers From 1c95334a9d0c940db5f866e0b048a9ef7d59d51f Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 11:28:32 -0800 Subject: [PATCH 36/94] TESTS: Add supported_progress_handlers() test utility function --- tests/incl/start,load-only.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/incl/start,load-only.R b/tests/incl/start,load-only.R index 7e2592d..bd590c8 100644 --- a/tests/incl/start,load-only.R +++ b/tests/incl/start,load-only.R @@ -42,6 +42,13 @@ non_supported_progression_handlers <- function() { } +supported_progress_handlers <- function(exclude = non_supported_progression_handlers()) { + handlers <- known_progression_handlers() + drop <- na.omit(match(exclude, names(handlers))) + if (length(drop) > 0L) handlers <- handlers[-drop] + handlers +} + ## Settings options(progressr.clear = TRUE) options(progressr.debug = FALSE) From 3851aa351bb118a5f360a198c9699ee4c9ff45ab Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 11:55:59 -0800 Subject: [PATCH 37/94] Test relay (stdout, messages, warnings) for _all_ progress handlers --- tests/incl/start,load-only.R | 57 ++++++++++++++++++++++++++++++++++++ tests/with_progress,relay.R | 55 ++++++++++++++++++++++++++++++++++ tests/with_progress,stdout.R | 35 ---------------------- 3 files changed, 112 insertions(+), 35 deletions(-) create mode 100644 tests/with_progress,relay.R delete mode 100644 tests/with_progress,stdout.R diff --git a/tests/incl/start,load-only.R b/tests/incl/start,load-only.R index bd590c8..58a210d 100644 --- a/tests/incl/start,load-only.R +++ b/tests/incl/start,load-only.R @@ -69,3 +69,60 @@ if (covr) { baseenv <- function() environment(base::sample) } + + +## WORKAROUND: capture.output() gained argument 'split' in R 3.3.0 +if (getRversion() >= "3.3.0") { + capture.output <- utils::capture.output +} else { + capture.output <- function(..., split = FALSE) utils::capture.output(...) +} +capture_output <- function(..., split = FALSE, collapse = NULL) { + bfr <- capture.output(..., split = split) + if (!is.null(collapse)) bfr <- paste(c(bfr, ""), collapse = "\n") + bfr +} + +record_conditions <- function(expr, ..., classes = "condition", split = FALSE) { + conditions <- list() + withCallingHandlers(expr, condition = function(c) { + if (inherits(c, classes)) { + attr(c, "received") <- Sys.time() + conditions[[length(conditions) + 1L]] <<- c + if (!split) muffle_condition(c) + } + }) + conditions +} + +record_relay <- function(..., all = FALSE, split = FALSE) { + stdout <- capture_output(conditions <- record_conditions(...), split = split) + msgs <- sapply(conditions, FUN = conditionMessage) + res <- list(stdout = stdout, msgs = msgs) + if (all) res$conditions <- conditions + res +} + +muffle_condition <- function(cond) { + muffled <- FALSE + if (inherits(cond, "message")) { + invokeRestart("muffleMessage") + muffled <- TRUE + } else if (inherits(cond, "warning")) { + invokeRestart("muffleWarning") + muffled <- TRUE + } else if (inherits(cond, "condition")) { + restarts <- computeRestarts(cond) + for (restart in restarts) { + name <- restart$name + if (is.null(name)) + next + if (!grepl("^muffle", name)) + next + invokeRestart(restart) + muffled <- TRUE + break + } + } + invisible(muffled) +} diff --git a/tests/with_progress,relay.R b/tests/with_progress,relay.R new file mode 100644 index 0000000..0065901 --- /dev/null +++ b/tests/with_progress,relay.R @@ -0,0 +1,55 @@ +source("incl/start.R") + +options(progressr.clear = TRUE) + +delay <- getOption("progressr.demo.delay", 0.1) +message("- delay: ", delay, " seconds") + +handlers("txtprogressbar") + +handlers <- supported_progress_handlers() + + +message("with_progress() - standard output, messages, warnings ...") + +n <- 5L +for (kk in seq_along(handlers)) { + handler <- handlers[[kk]] + name <- names(handlers)[kk] + message(sprintf("* Handler %d ('%s') of %d ...", kk, name, length(handlers))) + + for (type in c("message", "warning")) { + message(sprintf(" - stdout + %ss", type)) + truth <- c() + relay <- record_relay({ + with_progress({ + p <- progressor(n) + for (ii in seq_len(n)) { + ## Zero-amount progress with empty message + p(amount = 0) + msg <- sprintf("ii = %d", ii) + ## Zero-amount progress with non-empty message + p(message = msg, amount = 0) + truth <<- c(truth, msg) + cat(msg, "\n", sep = "") + ## Signal condition + do.call(type, args = list(msg)) + Sys.sleep(delay) + ## One-step progress with non-empty message + p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) + } + }) + }, classes = type) + stopifnot( + identical(relay$stdout, truth), + identical(gsub("\n$", "", relay$msgs), truth) + ) + } ## for (signal ...) + + message(sprintf("* Handler %d ('%s') of %d ... done", kk, name, length(handlers))) +} + + +message("with_progress() - standard output, messages, warnings ... done") + +source("incl/end.R") diff --git a/tests/with_progress,stdout.R b/tests/with_progress,stdout.R deleted file mode 100644 index 65b0f4a..0000000 --- a/tests/with_progress,stdout.R +++ /dev/null @@ -1,35 +0,0 @@ -source("incl/start.R") - -options(progressr.clear = FALSE) - -message("Multiple handlers ...") - -delay <- getOption("progressr.demo.delay", 0.1) -message("- delay: ", delay, " seconds") - -handlers(handler_txtprogressbar(clear = FALSE)) - -x <- 1:5 -stdout <- c() -bfr <- utils::capture.output({ - with_progress({ - p <- progressor(along = x) - for (ii in x) { - msg <- sprintf("ii = %d\n", ii) - stdout <- c(stdout, msg) - cat(msg) - Sys.sleep(delay) - p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) - } - }) -}) -cat(bfr, sep="\n") - -## Validate stdout -bfr <- paste(c(bfr, ""), collapse="\n") -stdout <- paste(stdout, collapse="") -stopifnot(bfr == stdout) - -message("Multiple handlers ... done") - -source("incl/end.R") From 4a9024ba05fc881a73b93144285c27224ae3293a Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 13:52:08 -0800 Subject: [PATCH 38/94] TESTS: Add package tests for global progression handlers and relaying of stdout, messages, and warnings --- tests/globals,relay.R | 61 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 tests/globals,relay.R diff --git a/tests/globals,relay.R b/tests/globals,relay.R new file mode 100644 index 0000000..8ee5425 --- /dev/null +++ b/tests/globals,relay.R @@ -0,0 +1,61 @@ +if (getRversion() >= "4.0.0") { + +source("incl/start.R") + +options(progressr.clear = TRUE) + +delay <- getOption("progressr.demo.delay", 0.1) +message("- delay: ", delay, " seconds") + +handlers("txtprogressbar") + +handlers <- supported_progress_handlers() + +register_global_progression_handler("remove") +register_global_progression_handler("add") + +message("global progress handlers - standard output, messages, warnings ...") + +n <- 5L +for (kk in seq_along(handlers)) { + handler <- handlers[[kk]] + name <- names(handlers)[kk] + message(sprintf("* Handler %d ('%s') of %d ...", kk, name, length(handlers))) + + for (type in c("message", "warning")) { + message(sprintf(" - stdout + %ss", type)) + truth <- c() + relay <- record_relay({ + p <- progressor(n) + for (ii in seq_len(n)) { + ## Zero-amount progress with empty message + p(amount = 0) + msg <- sprintf("ii = %d", ii) + ## Zero-amount progress with non-empty message + p(message = msg, amount = 0) + truth <<- c(truth, msg) + cat(msg, "\n", sep = "") + ## Signal condition + do.call(type, args = list(msg)) + Sys.sleep(delay) + ## One-step progress with non-empty message + p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) + } + }, classes = type) + stopifnot( + identical(relay$stdout, truth), + identical(gsub("\n$", "", relay$msgs), truth) + ) + } ## for (signal ...) + + message(sprintf("* Handler %d ('%s') of %d ... done", kk, name, length(handlers))) +} + + +message("global progress handlers - standard output, messages, warnings ... done") + +register_global_progression_handler("remove") + +source("incl/end.R") + +} ## if (getRversion() >= "4.0.0") From 83edb3ca502724006ef0cc45e636a7ee315f1b84 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 14:04:58 -0800 Subject: [PATCH 39/94] Test buffering and flusing when there are (i) the exact number expected of updated, too few and too many --- tests/globals,relay.R | 47 ++++++++++++++++++---------------- tests/with_progress,relay.R | 51 ++++++++++++++++++++----------------- 2 files changed, 52 insertions(+), 46 deletions(-) diff --git a/tests/globals,relay.R b/tests/globals,relay.R index 8ee5425..9236cd1 100644 --- a/tests/globals,relay.R +++ b/tests/globals,relay.R @@ -24,28 +24,31 @@ for (kk in seq_along(handlers)) { for (type in c("message", "warning")) { message(sprintf(" - stdout + %ss", type)) - truth <- c() - relay <- record_relay({ - p <- progressor(n) - for (ii in seq_len(n)) { - ## Zero-amount progress with empty message - p(amount = 0) - msg <- sprintf("ii = %d", ii) - ## Zero-amount progress with non-empty message - p(message = msg, amount = 0) - truth <<- c(truth, msg) - cat(msg, "\n", sep = "") - ## Signal condition - do.call(type, args = list(msg)) - Sys.sleep(delay) - ## One-step progress with non-empty message - p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) - } - }, classes = type) - stopifnot( - identical(relay$stdout, truth), - identical(gsub("\n$", "", relay$msgs), truth) - ) + for (delta in c(0L, +1L, -1L)) { + message(sprintf(" - delta = %+d", delta)) + truth <- c() + relay <- record_relay({ + p <- progressor(n) + for (ii in seq_len(n + delta)) { + ## Zero-amount progress with empty message + p(amount = 0) + msg <- sprintf("ii = %d", ii) + ## Zero-amount progress with non-empty message + p(message = msg, amount = 0) + truth <<- c(truth, msg) + cat(msg, "\n", sep = "") + ## Signal condition + do.call(type, args = list(msg)) + Sys.sleep(delay) + ## One-step progress with non-empty message + p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) + } + }, classes = type) + stopifnot( + identical(relay$stdout, truth), + identical(gsub("\n$", "", relay$msgs), truth) + ) + } ## for (delta ...) } ## for (signal ...) message(sprintf("* Handler %d ('%s') of %d ... done", kk, name, length(handlers))) diff --git a/tests/with_progress,relay.R b/tests/with_progress,relay.R index 0065901..ec58c1e 100644 --- a/tests/with_progress,relay.R +++ b/tests/with_progress,relay.R @@ -20,30 +20,33 @@ for (kk in seq_along(handlers)) { for (type in c("message", "warning")) { message(sprintf(" - stdout + %ss", type)) - truth <- c() - relay <- record_relay({ - with_progress({ - p <- progressor(n) - for (ii in seq_len(n)) { - ## Zero-amount progress with empty message - p(amount = 0) - msg <- sprintf("ii = %d", ii) - ## Zero-amount progress with non-empty message - p(message = msg, amount = 0) - truth <<- c(truth, msg) - cat(msg, "\n", sep = "") - ## Signal condition - do.call(type, args = list(msg)) - Sys.sleep(delay) - ## One-step progress with non-empty message - p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) - } - }) - }, classes = type) - stopifnot( - identical(relay$stdout, truth), - identical(gsub("\n$", "", relay$msgs), truth) - ) + for (delta in c(0L, +1L, -1L)) { + message(sprintf(" - delta = %+d", delta)) + truth <- c() + relay <- record_relay({ + with_progress({ + p <- progressor(n) + for (ii in seq_len(n + delta)) { + ## Zero-amount progress with empty message + p(amount = 0) + msg <- sprintf("ii = %d", ii) + ## Zero-amount progress with non-empty message + p(message = msg, amount = 0) + truth <<- c(truth, msg) + cat(msg, "\n", sep = "") + ## Signal condition + do.call(type, args = list(msg)) + Sys.sleep(delay) + ## One-step progress with non-empty message + p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) + } + }) + }, classes = type) + stopifnot( + identical(relay$stdout, truth), + identical(gsub("\n$", "", relay$msgs), truth) + ) + } ## for (delta ...) } ## for (signal ...) message(sprintf("* Handler %d ('%s') of %d ... done", kk, name, length(handlers))) From feaebd92014c462fe315ec0c071f3b9fe0e7faa9 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 14:37:55 -0800 Subject: [PATCH 40/94] Output status to the console output if there's an error --- R/global_progression_handler.R | 20 +++++++++++++++++--- tests/globals,relay.R | 16 ++++++++++++++-- tests/incl/start,load-only.R | 16 ++++++++++++++++ 3 files changed, 47 insertions(+), 5 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index f1e393f..745dd47 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -16,7 +16,7 @@ #' #' @export register_global_progression_handler <- function(action = c("add", "remove", "query")) { - action <- match.arg(action) + action <- match.arg(action[1], choices = c("add", "remove", "query", "status")) if (getRversion() < "4.0.0") { warning("register_global_progression_handler() requires R (>= 4.0.0)") @@ -36,15 +36,17 @@ register_global_progression_handler <- function(action = c("add", "remove", "que globalCallingHandlers(condition = global_progression_handler) } invisible(TRUE) - } else if (action == "remove") { + } else if (action == "remove") { handlers <- handlers[!exists] ## Remove all globalCallingHandlers(NULL) ## Add back the ones we didn't drop globalCallingHandlers(handlers) invisible(FALSE) - } else if (action == "query") { + } else if (action == "query") { any(exists) + } else if (action == "status") { + global_progression_handler(control_progression("status")) } } @@ -180,7 +182,19 @@ global_progression_handler <- local({ } } else if (type == "finish") { finish(progression, debug = debug) + } else if (type == "status") { + status <- list( + current_progressor_uuid = current_progressor_uuid, + calling_handler = calling_handler, + delays = delays, + stdout_file = stdout_file, + capture_conditions = capture_conditions, + conditions = conditions + ) + if (debug) message(" - done") + return(status) } + if (debug) message(" - done") return() diff --git a/tests/globals,relay.R b/tests/globals,relay.R index 9236cd1..94acf6e 100644 --- a/tests/globals,relay.R +++ b/tests/globals,relay.R @@ -2,7 +2,7 @@ if (getRversion() >= "4.0.0") { source("incl/start.R") -options(progressr.clear = TRUE) +options(progressr.clear = FALSE) delay <- getOption("progressr.demo.delay", 0.1) message("- delay: ", delay, " seconds") @@ -44,10 +44,22 @@ for (kk in seq_along(handlers)) { p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) } }, classes = type) + status <- register_global_progression_handler("status") + tryCatch({ stopifnot( identical(relay$stdout, truth), - identical(gsub("\n$", "", relay$msgs), truth) + identical(gsub("\n$", "", relay$msgs), truth), + is.null(status$current_progressor_uuid), + is.null(status$delays), + is.null(status$stdout_file), + !isTRUE(status$capture_conditions), + length(status$conditions) == 0L ) + }, error = function(ex) { + console_msg(capture.output(utils::str(status))) + signalCondition(ex) + }) + } ## for (delta ...) } ## for (signal ...) diff --git a/tests/incl/start,load-only.R b/tests/incl/start,load-only.R index 58a210d..e643766 100644 --- a/tests/incl/start,load-only.R +++ b/tests/incl/start,load-only.R @@ -126,3 +126,19 @@ muffle_condition <- function(cond) { } invisible(muffled) } + +## Adopted from R.utils::cmsg() +console_msg <- function(..., appendLF = TRUE) { + fh <- tempfile() + on.exit(file.remove(fh)) + cat(..., file = fh) + if (appendLF) + cat("\n", file = fh, append = TRUE) + if (.Platform$OS.type == "windows") { + file.show(fh, pager = "console", header = "", title = "", + delete.file = FALSE) + } else { + system(sprintf("cat %s", fh)) + } + invisible() +} From 9c2a6fb10f163b7c11cf5d5f091d9e42f0902ee0 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 16:30:12 -0800 Subject: [PATCH 41/94] GLOBAL: Default is now capture_conditions=NA --- R/global_progression_handler.R | 73 +++++++++++++++++++++++----------- tests/globals,relay.R | 42 +++++++++++++------ tests/incl/start,load-only.R | 4 +- 3 files changed, 81 insertions(+), 38 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 745dd47..4c23d9d 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -67,7 +67,7 @@ global_progression_handler <- local({ calling_handler <- NULL delays <- NULL stdout_file <- NULL - capture_conditions <- TRUE + capture_conditions <- NA conditions <- list() genv <- globalenv() @@ -88,21 +88,30 @@ global_progression_handler <- local({ } finish <- function(progression, debug = FALSE) { - ## Already shutdown? Do nothing - if (is.null(current_progressor_uuid)) return() - - if (debug) message(" - shutdown progression handlers") - if (!is.null(calling_handler)) { - stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) - finished <- calling_handler(progression) - stdout_file <<- flush_stdout(stdout_file, close = TRUE) - conditions <<- flush_conditions(conditions) - delays <<- NULL - if (debug) message(" - finished: ", finished) + finished <- FALSE + + ## Is progress handler active? + if (!is.null(current_progressor_uuid)) { + if (debug) message(" - shutdown progression handlers") + if (!is.null(calling_handler)) { + stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) + finished <- calling_handler(progression) + stdout_file <<- flush_stdout(stdout_file, close = TRUE) + conditions <<- flush_conditions(conditions) + delays <<- NULL + if (debug) message(" - finished: ", finished) + } else { + finished <- TRUE + } } + current_progressor_uuid <<- NULL calling_handler <<- NULL - stop_if_not(is.null(stdout_file), length(conditions) == 0L, is.null(delays)) + capture_conditions <<- NA + finished <- TRUE + stop_if_not(is.null(stdout_file), length(conditions) == 0L, is.null(delays), isTRUE(finished), is.na(capture_conditions)) + + finished } handle_progression <- function(progression) { @@ -110,8 +119,16 @@ global_progression_handler <- local({ calling_handler <- NULL; rm(list = "calling_handler") ## Don't capture conditions that are produced by progression handlers + last_capture_conditions <- capture_conditions + capture_conditions <<- FALSE - on.exit(capture_conditions <<- TRUE) + on.exit({ + if (is.null(current_progressor_uuid)) { + capture_conditions <<- NA + } else if (!is.na(capture_conditions)) { + capture_conditions <<- TRUE + } + }) stop_if_not(inherits(progression, "progression")) @@ -160,6 +177,11 @@ global_progression_handler <- local({ if (debug) message(" - initiate progression handlers") finished <- calling_handler(progression) if (debug) message(" - finished: ", finished) + if (finished) { + finished <- finish(progression, debug = debug) + stop_if_not(is.null(stdout_file), length(conditions) == 0L, + is.na(capture_conditions), isTRUE(finished)) + } } } else if (type == "update") { if (is.null(current_progressor_uuid)) { @@ -177,18 +199,22 @@ global_progression_handler <- local({ if (debug) message(" - finished: ", finished) if (finished) { calling_handler(control_progression("shutdown")) - current_progressor_uuid <<- NULL + finished <- finish(progression, debug = debug) + stop_if_not(is.null(stdout_file), length(conditions) == 0L, + is.na(capture_conditions), isTRUE(finished)) } } } else if (type == "finish") { - finish(progression, debug = debug) + finished <- finish(progression, debug = debug) + stop_if_not(is.null(stdout_file), length(conditions) == 0L, + is.na(capture_conditions), isTRUE(finished)) } else if (type == "status") { status <- list( current_progressor_uuid = current_progressor_uuid, calling_handler = calling_handler, delays = delays, stdout_file = stdout_file, - capture_conditions = capture_conditions, + capture_conditions = last_capture_conditions, conditions = conditions ) if (debug) message(" - done") @@ -196,8 +222,6 @@ global_progression_handler <- local({ } if (debug) message(" - done") - - return() } ## handle_progression() @@ -205,9 +229,10 @@ global_progression_handler <- local({ ## Shut down progression handling? if (inherits(condition, c("interrupt", "error"))) { progression <- control_progression("shutdown") - finish(progression) - stop_if_not(is.null(stdout_file), length(conditions) == 0L, capture_conditions) - return() + finished <- finish(progression) + stop_if_not(is.null(stdout_file), length(conditions) == 0L, + is.na(capture_conditions), isTRUE(finished)) + return() } ## A 'progression' update? @@ -216,9 +241,9 @@ global_progression_handler <- local({ } ## Nothing do to? - if (!capture_conditions) return() + if (!is.na(capture_conditions) || !isTRUE(capture_conditions)) return() - ## Nothing more do to? + ## Nothing do to? if (is.null(delays) || !inherits(condition, delays$conditions)) return() ## Record non-progression condition to be flushed later diff --git a/tests/globals,relay.R b/tests/globals,relay.R index 94acf6e..9de0336 100644 --- a/tests/globals,relay.R +++ b/tests/globals,relay.R @@ -26,6 +26,19 @@ for (kk in seq_along(handlers)) { message(sprintf(" - stdout + %ss", type)) for (delta in c(0L, +1L, -1L)) { message(sprintf(" - delta = %+d", delta)) + + register_global_progression_handler("remove") + register_global_progression_handler("add") + + status <- register_global_progression_handler("status") + stopifnot( + is.null(status$current_progressor_uuid), + is.null(status$delays), + is.null(status$stdout_file), + length(status$conditions) == 0L, + is.na(status$capture_conditions) + ) + truth <- c() relay <- record_relay({ p <- progressor(n) @@ -44,21 +57,26 @@ for (kk in seq_along(handlers)) { p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) } }, classes = type) - status <- register_global_progression_handler("status") - tryCatch({ stopifnot( identical(relay$stdout, truth), - identical(gsub("\n$", "", relay$msgs), truth), - is.null(status$current_progressor_uuid), - is.null(status$delays), - is.null(status$stdout_file), - !isTRUE(status$capture_conditions), - length(status$conditions) == 0L + identical(gsub("\n$", "", relay$msgs), truth) ) - }, error = function(ex) { - console_msg(capture.output(utils::str(status))) - signalCondition(ex) - }) + status <- register_global_progression_handler("status") + console_msg(capture.output(utils::str(status))) + if (delta == 0L) { + withCallingHandlers({ + stopifnot( + is.null(status$current_progressor_uuid), + is.null(status$delays), + is.null(status$stdout_file), + length(status$conditions) == 0L, + is.na(status$capture_conditions) + ) + }, error = function(ex) { + console_msg(paste("An error occurred:", conditionMessage(ex))) + console_msg(capture.output(utils::str(status))) + }) + } } ## for (delta ...) } ## for (signal ...) diff --git a/tests/incl/start,load-only.R b/tests/incl/start,load-only.R index e643766..f4e4179 100644 --- a/tests/incl/start,load-only.R +++ b/tests/incl/start,load-only.R @@ -128,10 +128,10 @@ muffle_condition <- function(cond) { } ## Adopted from R.utils::cmsg() -console_msg <- function(..., appendLF = TRUE) { +console_msg <- function(..., collapse = "\n", sep = "\n", appendLF = TRUE) { fh <- tempfile() on.exit(file.remove(fh)) - cat(..., file = fh) + cat(..., collapse = sep, sep = sep, file = fh) if (appendLF) cat("\n", file = fh, append = TRUE) if (.Platform$OS.type == "windows") { From 50897aa703b1e598b9dbdc3e34d128829b3e3dee Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 17:29:55 -0800 Subject: [PATCH 42/94] GLOBALS: Signaling too much progress is not longer an error; it's now a warning. By not ignoring it, we'll be able to find progressors that are incorrectly configured --- R/global_progression_handler.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 4c23d9d..75ace52 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -189,7 +189,7 @@ global_progression_handler <- local({ ## progress has been completed amount <- progression$amount if (!is.numeric(amount) || amount > 0) { - stop(sprintf("INTERNAL ERROR: Received an %s request but is not listening to this progressor", sQuote(type))) + warning(sprintf("[progressr]: Received a progression %s request (amount=%g) but is not listening to this progressor. This can happen when code signals more progress updates than it configured the progressor to do. When the progressor completes all steps, it shuts down resulting in the global progression handler to no longer listen to it", sQuote(type), amount)) } } if (debug) message(" - update progression handlers") From dc409e072e7914e29c7eed94eb7259ea43b71c24 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 19:01:20 -0800 Subject: [PATCH 43/94] SIGNIFICANT CHANGES: A progressor() can only be created in the global environment if done via with[out]_progress() --- NEWS | 8 +++++++- R/progressor.R | 17 +++++++++++++++++ R/with_progress.R | 3 +++ R/without_progress.R | 3 +++ tests/exceptions.R | 14 ++++++++------ tests/progressor.R | 12 ++++++++---- 6 files changed, 46 insertions(+), 11 deletions(-) diff --git a/NEWS b/NEWS index acd5f05..c69d390 100644 --- a/NEWS +++ b/NEWS @@ -1,8 +1,14 @@ Package: progressr ================== -Version: 0.6.0-9000 [2020-11-12] +Version: 0.6.0-9000 [2020-11-16] +SIGNIFICANT CHANGES: + + * A progressor must not be created in the global environment unless wrapped + in with_progress() or without_progress() call. Ideally, a progressor is + created within a function or a local() environment. + NEW FEATURES: * Add register_global_progression_handler(). diff --git a/R/progressor.R b/R/progressor.R index adc3be4..f2c8e2f 100644 --- a/R/progressor.R +++ b/R/progressor.R @@ -47,6 +47,10 @@ progressor <- local({ stop_if_not(is.logical(on_exit), length(on_exit) == 1L, !is.na(on_exit)) + if (identical(envir, globalenv()) && !progressr_in_globalenv()) { + stop("A progressor must not be created in the global environment unless wrapped in a with_progress() or without_progress() call, otherwise make sure to created inside a function or in a local() environment to make sure there is a finite life span of the progressor") + } + owner_session_uuid <- session_uuid(attributes = TRUE) progressor_count <<- progressor_count + 1L progressor_uuid <- progressor_uuid(progressor_count) @@ -100,3 +104,16 @@ print.progressor <- function(x, ...) { invisible(x) } + + +progressr_in_globalenv <- local({ + state <- FALSE + + function(action = c("query", "allow", "disallow")) { + action <- match.arg(action) + if (action == "query") return(state) + old_state <- state + state <<- switch(action, allow = TRUE, disallow = FALSE) + invisible(old_state) + } +}) diff --git a/R/with_progress.R b/R/with_progress.R index 2ebd3cf..5e564bc 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -93,6 +93,9 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE on.exit(options(oopts)) } + progressr_in_globalenv("allow") + on.exit(progressr_in_globalenv("disallow"), add = TRUE) + handlers <- as_progression_handler(handlers) ## Nothing to do? diff --git a/R/without_progress.R b/R/without_progress.R index 1f17e20..c158d42 100644 --- a/R/without_progress.R +++ b/R/without_progress.R @@ -5,6 +5,9 @@ #' @rdname with_progress #' @export without_progress <- function(expr) { + progressr_in_globalenv("allow") + on.exit(progressr_in_globalenv("disallow")) + withCallingHandlers(expr, progression = function(p) { invokeRestart("muffleProgression") }) diff --git a/tests/exceptions.R b/tests/exceptions.R index f9fd405..0ef88eb 100644 --- a/tests/exceptions.R +++ b/tests/exceptions.R @@ -18,12 +18,14 @@ message("- progress_aggregator()") invalid <- progression(type = "unknown", session_uuid = "dummy", progressor_uuid = "dummy", progression_index = 0L) print(invalid) -progress <- progress_aggregator(progressor(2L)) -res <- tryCatch(progress({ - signalCondition(invalid) -}), error = identity) -str(res) -stopifnot(inherits(res, "error")) +local({ + progress <- progress_aggregator(progressor(2L)) + res <- tryCatch(progress({ + signalCondition(invalid) + }), error = identity) + str(res) + stopifnot(inherits(res, "error")) +}) message("Exceptions ... done") diff --git a/tests/progressor.R b/tests/progressor.R index 0c0b2a2..a63b634 100644 --- a/tests/progressor.R +++ b/tests/progressor.R @@ -2,11 +2,15 @@ source("incl/start.R") message("progressor() ...") -p <- progressor(3L) -print(p) +local({ + p <- progressor(3L) + print(p) +}) -p <- progressor(along = 1:3) -print(p) +local({ + p <- progressor(along = 1:3) + print(p) +}) message("progressor() ... DONE") From ba24efb15dbffda2db332858e5c344ba75709c8d Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 19:52:35 -0800 Subject: [PATCH 44/94] It might not be possible to close a progressor if there are other active sinks preventing us from flushing any buffered output --- R/global_progression_handler.R | 34 +++++++++++++++++++++++++++------- tests/globals,relay.R | 20 ++++++++++++++++++-- 2 files changed, 45 insertions(+), 9 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 75ace52..56a2d84 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -37,6 +37,7 @@ register_global_progression_handler <- function(action = c("add", "remove", "que } invisible(TRUE) } else if (action == "remove") { + global_progression_handler(control_progression("shutdown")) handlers <- handlers[!exists] ## Remove all globalCallingHandlers(NULL) @@ -87,7 +88,7 @@ global_progression_handler <- local({ calling_handler <<- make_calling_handler(handlers) } - finish <- function(progression, debug = FALSE) { + finish <- function(progression = control_progression("shutdown"), debug = FALSE) { finished <- FALSE ## Is progress handler active? @@ -97,6 +98,7 @@ global_progression_handler <- local({ stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) finished <- calling_handler(progression) stdout_file <<- flush_stdout(stdout_file, close = TRUE) + stop_if_not(is.null(stdout_file)) conditions <<- flush_conditions(conditions) delays <<- NULL if (debug) message(" - finished: ", finished) @@ -154,6 +156,7 @@ global_progression_handler <- local({ if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { calling_handler(control_progression("hide")) stdout_file <<- flush_stdout(stdout_file, close = FALSE) + stop_if_not(inherits(stdout_file, "connection")) conditions <<- flush_conditions(conditions) calling_handler(control_progression("unhide")) } @@ -178,7 +181,7 @@ global_progression_handler <- local({ finished <- calling_handler(progression) if (debug) message(" - finished: ", finished) if (finished) { - finished <- finish(progression, debug = debug) + finished <- finish(debug = debug) stop_if_not(is.null(stdout_file), length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) } @@ -191,7 +194,9 @@ global_progression_handler <- local({ if (!is.numeric(amount) || amount > 0) { warning(sprintf("[progressr]: Received a progression %s request (amount=%g) but is not listening to this progressor. This can happen when code signals more progress updates than it configured the progressor to do. When the progressor completes all steps, it shuts down resulting in the global progression handler to no longer listen to it", sQuote(type), amount)) } + return() } + if (debug) message(" - update progression handlers") if (!is.null(calling_handler)) { stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) @@ -199,13 +204,13 @@ global_progression_handler <- local({ if (debug) message(" - finished: ", finished) if (finished) { calling_handler(control_progression("shutdown")) - finished <- finish(progression, debug = debug) + finished <- finish(debug = debug) stop_if_not(is.null(stdout_file), length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) } } } else if (type == "finish") { - finished <- finish(progression, debug = debug) + finished <- finish(debug = debug) stop_if_not(is.null(stdout_file), length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) } else if (type == "status") { @@ -229,7 +234,7 @@ global_progression_handler <- local({ ## Shut down progression handling? if (inherits(condition, c("interrupt", "error"))) { progression <- control_progression("shutdown") - finished <- finish(progression) + finished <- finish() stop_if_not(is.null(stdout_file), length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) return() @@ -282,12 +287,27 @@ if (getRversion() < "4.0.0") { buffer_stdout <- function() { stdout_file <- rawConnection(raw(0L), open = "w") sink(stdout_file, type = "output", split = FALSE) + attr(stdout_file, "sink_index") <- sink.number(type = "output") stdout_file } ## buffer_stdout() -flush_stdout <- function(stdout_file, close = TRUE) { +flush_stdout <- function(stdout_file, close = TRUE, must_work = FALSE) { if (is.null(stdout_file)) return(NULL) - sink(type = "output", split = FALSE) + + ## Can we close the sink we opened? + ## It could be that a progressor completes while there is a surrounding + ## sink active, e.g. an active capture.output(), or when signalled within + ## a sequential future. Because of this, we might not be able to flush + ## close the sink here. + sink_index <- attr(stdout_file, "sink_index") + if (sink_index != sink.number("output")) { + if (must_work) { + stop(sprintf("[progressr] Cannot flush stdout because the current sink index (%d) is out of sync with the sink we want to close (%d)", sink.number("output"), sink_index)) + } + return(stdout_file) + } + + sink(split = FALSE, type = "output") stdout <- rawToChar(rawConnectionValue(stdout_file)) if (length(stdout) > 0) cat(stdout, file = stdout()) close(stdout_file) diff --git a/tests/globals,relay.R b/tests/globals,relay.R index 9de0336..d87a2bf 100644 --- a/tests/globals,relay.R +++ b/tests/globals,relay.R @@ -2,6 +2,8 @@ if (getRversion() >= "4.0.0") { source("incl/start.R") +nsinks0 <- sink.number(type = "output") + options(progressr.clear = FALSE) delay <- getOption("progressr.demo.delay", 0.1) @@ -12,7 +14,10 @@ handlers("txtprogressbar") handlers <- supported_progress_handlers() register_global_progression_handler("remove") +stopifnot(sink.number(type = "output") == nsinks0) + register_global_progression_handler("add") +stopifnot(sink.number(type = "output") == nsinks0) message("global progress handlers - standard output, messages, warnings ...") @@ -28,7 +33,9 @@ for (kk in seq_along(handlers)) { message(sprintf(" - delta = %+d", delta)) register_global_progression_handler("remove") + stopifnot(sink.number(type = "output") == nsinks0) register_global_progression_handler("add") + stopifnot(sink.number(type = "output") == nsinks0) status <- register_global_progression_handler("status") stopifnot( @@ -39,8 +46,11 @@ for (kk in seq_along(handlers)) { is.na(status$capture_conditions) ) + nsinks <- sink.number(type = "output") + stopifnot(nsinks == nsinks0) + truth <- c() - relay <- record_relay({ + relay <- record_relay(local({ p <- progressor(n) for (ii in seq_len(n + delta)) { ## Zero-amount progress with empty message @@ -56,11 +66,17 @@ for (kk in seq_along(handlers)) { ## One-step progress with non-empty message p(message = sprintf("(%s)", paste(letters[1:ii], collapse=","))) } - }, classes = type) + }), classes = type) stopifnot( identical(relay$stdout, truth), identical(gsub("\n$", "", relay$msgs), truth) ) + + ## Assert sinks are balanced + stopifnot(sink.number(type = "output") == nsinks) + + cat(paste(c(relay$stdout, ""), collapse = "\n")) + message(relay$message, append = FALSE) status <- register_global_progression_handler("status") console_msg(capture.output(utils::str(status))) if (delta == 0L) { From 86fe9acf582f9bf34663b7be13e02bf398391e71 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Mon, 16 Nov 2020 21:22:27 -0800 Subject: [PATCH 45/94] Now pbcol display percentage. Added pbcol example --- R/handler_pbcol.R | 22 +++++++++++++++------- incl/handler_pbcol.R | 3 +++ man/handler_pbcol.Rd | 5 +++++ 3 files changed, 23 insertions(+), 7 deletions(-) create mode 100644 incl/handler_pbcol.R diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R index c342135..dab5ba8 100644 --- a/R/handler_pbcol.R +++ b/R/handler_pbcol.R @@ -18,6 +18,8 @@ #' @section Requirements: #' This progression handler requires the \pkg{crayon} package. #' +#' @example incl/handler_pbcol.R +#' #' @export handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = "cyan", intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) { cat_ <- function(...) { @@ -25,7 +27,7 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = } erase_progress_bar <- function() { - cat_(c("\r", rep(" ", times = getOption("width") - 1L), "\r")) + cat_(c("\r", rep(" ", times = getOption("width")), "\r")) } redraw_progress_bar <- function(ratio, message) { @@ -104,24 +106,30 @@ pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOpt fraction <- as.numeric(fraction) stop_if_not(length(fraction) == 1L, !is.na(fraction), fraction >= 0, fraction <= 1) + width <- as.integer(width) stop_if_not(length(width) == 1L, !is.na(width), width > 0L) - ## Pad 'msg' to align horizontally - msgpad <- (width - 2 * pad) - nchar(msg) + msgfraction <- sprintf(" %3.0f%%", 100 * fraction) + + ## Pad 'fullmsg' to align horizontally + nmsg <- nchar(msg) + nchar(msgfraction) + msgpad <- (width - 2 * pad) - nmsg ## Truncate 'msg'? if (msgpad < 0) { msg <- substr(msg, start = pad, stop = nchar(msg) + msgpad - pad) msg <- substr(msg, start = 1L, stop = nchar(msg) - 3L) msg <- paste(msg, "...", sep = "") - msgpad <- (width - 2 * pad) - nchar(msg) + msgpad <- (width - 2 * pad) - nchar(msg) - nchar(msgfraction) + stop_if_not(msgpad >= 0) } ## Pad 'msg' - lpad <- floor(adjust * msgpad) + pad - rpad <- (msgpad - lpad) + pad - pmsg <- sprintf("%*s%s%*s", lpad, "", msg, rpad, "") + lpad <- floor( adjust * msgpad) + pad + rpad <- floor((1-adjust) * msgpad) + stop_if_not(lpad >= 0L, rpad >= 0L) + pmsg <- sprintf("%*s%s%*s%s%*s", lpad, "", msg, rpad, "", msgfraction, pad, "") ## Make progress bar len <- round(fraction * nchar(pmsg), digits = 0L) diff --git a/incl/handler_pbcol.R b/incl/handler_pbcol.R new file mode 100644 index 0000000..5c42dbb --- /dev/null +++ b/incl/handler_pbcol.R @@ -0,0 +1,3 @@ +handlers(handler_pbcol) +with_progress({ y <- slow_sum(1:10) }) +print(y) diff --git a/man/handler_pbcol.Rd b/man/handler_pbcol.Rd index e810ef0..2ae2d5d 100644 --- a/man/handler_pbcol.Rd +++ b/man/handler_pbcol.Rd @@ -42,3 +42,8 @@ Progression Handler: Progress Reported as an ANSI Background Color in the Termin This progression handler requires the \pkg{crayon} package. } +\examples{ +handlers(handler_pbcol) +with_progress({ y <- slow_sum(1:10) }) +print(y) +} From 38fe8a65c2221fcc4f8eb12bda704c99ba8d9949 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Tue, 17 Nov 2020 08:52:21 -0800 Subject: [PATCH 46/94] BUG FIX: conditions were not buffered by the global handler --- R/global_progression_handler.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 56a2d84..48be82a 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -71,7 +71,7 @@ global_progression_handler <- local({ capture_conditions <- NA conditions <- list() genv <- globalenv() - + update_calling_handler <- function() { handlers <- handlers() # Nothing to do? @@ -122,7 +122,6 @@ global_progression_handler <- local({ ## Don't capture conditions that are produced by progression handlers last_capture_conditions <- capture_conditions - capture_conditions <<- FALSE on.exit({ if (is.null(current_progressor_uuid)) { @@ -135,7 +134,7 @@ global_progression_handler <- local({ stop_if_not(inherits(progression, "progression")) assign(".Last.progression", value = progression, envir = genv, inherits = FALSE) - + debug <- getOption("progressr.global.debug", FALSE) if (debug) message(sprintf("*** Caught a %s condition:", sQuote(class(progression)[1]))) @@ -246,7 +245,7 @@ global_progression_handler <- local({ } ## Nothing do to? - if (!is.na(capture_conditions) || !isTRUE(capture_conditions)) return() + if (is.na(capture_conditions) || !isTRUE(capture_conditions)) return() ## Nothing do to? if (is.null(delays) || !inherits(condition, delays$conditions)) return() From d7c82602f6c2b419d0506067c99aba5c0ae79190 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Tue, 17 Nov 2020 09:13:36 -0800 Subject: [PATCH 47/94] Give an error if progressor(..., on_exit=TRUE) is called in the global environment --- R/progressor.R | 13 +++++++++---- man/progressor.Rd | 2 +- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/R/progressor.R b/R/progressor.R index f2c8e2f..5058426 100644 --- a/R/progressor.R +++ b/R/progressor.R @@ -30,7 +30,7 @@ progressor <- local({ progressor_count <- 0L - function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = TRUE, envir = parent.frame()) { + function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), envir = parent.frame()) { stop_if_not(!is.null(steps) || !is.null(along)) stop_if_not(length(steps) == 1L, is.numeric(steps), !is.na(steps), steps >= 0) @@ -47,8 +47,13 @@ progressor <- local({ stop_if_not(is.logical(on_exit), length(on_exit) == 1L, !is.na(on_exit)) - if (identical(envir, globalenv()) && !progressr_in_globalenv()) { - stop("A progressor must not be created in the global environment unless wrapped in a with_progress() or without_progress() call, otherwise make sure to created inside a function or in a local() environment to make sure there is a finite life span of the progressor") + if (identical(envir, globalenv())) { + if (!progressr_in_globalenv()) { + stop("A progressor must not be created in the global environment unless wrapped in a with_progress() or without_progress() call, otherwise make sure to created inside a function or in a local() environment to make sure there is a finite life span of the progressor") + } + if (on_exit) { + stop("It is not possible to create a progressor in the global environment with on_exit = TRUE") + } } owner_session_uuid <- session_uuid(attributes = TRUE) @@ -69,7 +74,7 @@ progressor <- local({ if (initiate) fcn(type = "initiate", steps = steps, auto_finish = auto_finish) ## Add on.exit(...progressor(type = "finish")) - if (on_exit && !identical(envir, globalenv())) { + if (on_exit) { assign("...progressor", value = fcn, envir = envir) lockBinding("...progressor", env = envir) call <- call("...progressor", type = "finish") diff --git a/man/progressor.Rd b/man/progressor.Rd index 91e8c19..9066d59 100644 --- a/man/progressor.Rd +++ b/man/progressor.Rd @@ -13,7 +13,7 @@ progressor( label = NA_character_, initiate = TRUE, auto_finish = TRUE, - on_exit = TRUE, + on_exit = !identical(envir, globalenv()), envir = parent.frame() ) } From c1ccb0fdc7e786fee2f971c3c20c2b4b78cf5d44 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Tue, 17 Nov 2020 13:41:42 -0800 Subject: [PATCH 48/94] REVDEP: 22 pkgs w/ global calling handlers [ci skip] --- revdep/README.md | 21 ++--- revdep/cran.md | 2 +- revdep/problems.md | 195 +++++++++++++++++++-------------------------- 3 files changed, 93 insertions(+), 125 deletions(-) diff --git a/revdep/README.md b/revdep/README.md index 8d27d08..860188d 100644 --- a/revdep/README.md +++ b/revdep/README.md @@ -10,7 +10,7 @@ |collate |en_US.UTF-8 | |ctype |en_US.UTF-8 | |tz |America/Los_Angeles | -|date |2020-10-29 | +|date |2020-11-17 | # Dependencies @@ -21,26 +21,29 @@ # Revdeps -## All (19) +## All (22) |package |version |error |warning |note | |:---------------------------------------------------|:-------|:-----|:-------|:----| |[cSEM](problems.md#csem) |0.3.0 | | |1 | |dipsaus |0.1.1 | | | | -|[econet](problems.md#econet) |0.1.92 | |1 | | +|econet |0.1.92 | | | | +|[EFAtools](problems.md#efatools) |0.3.0 | | |2 | |[EpiNow2](problems.md#epinow2) |1.2.1 | | |2 | |epwshiftr |0.1.1 | | | | |fabletools |0.2.1 | | | | -|funGp |0.1.0 | | | | +|[funGp](problems.md#fungp) |0.2.0 | | |1 | |furrr |0.2.1 | | | | -|[gtfs2gps](problems.md#gtfs2gps) |1.3-0 |1 | | | +|gtfs2gps |1.3-2 | | | | |lightr |1.3 | | | | -|[lmtp](problems.md#lmtp) |0.0.5 |1 | |2 | +|[lmtp](problems.md#lmtp) |0.0.5 | | |2 | |mlr3 |0.8.0 | | | | -|[modeltime](problems.md#modeltime) |0.3.0 |1 | | | -|[modeltime.ensemble](problems.md#modeltimeensemble) |0.2.0 | | |1 | +|[modeltime](problems.md#modeltime) |0.3.1 |1 | | | +|[modeltime.ensemble](problems.md#modeltimeensemble) |0.3.0 | | |1 | +|[modeltime.resample](problems.md#modeltimeresample) |0.1.0 | | |1 | |nflfastR |3.1.1 | | | | -|[pavo](problems.md#pavo) |2.4.0 | |1 | | +|nlrx |0.4.2 | | | | +|[pavo](problems.md#pavo) |2.5.0 | |1 | | |poppr |2.8.6 | | | | |rainette |0.1.1 | | | | |trundler |0.1.19 | | | | diff --git a/revdep/cran.md b/revdep/cran.md index 0cfa344..acb84fc 100644 --- a/revdep/cran.md +++ b/revdep/cran.md @@ -1,6 +1,6 @@ ## revdepcheck results -We checked 19 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. +We checked 22 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. * We saw 0 new problems * We failed to check 0 packages diff --git a/revdep/problems.md b/revdep/problems.md index f32f187..ce2f1c2 100644 --- a/revdep/problems.md +++ b/revdep/problems.md @@ -6,7 +6,7 @@ * GitHub: https://github.com/M-E-Rademaker/cSEM * Source code: https://github.com/cran/cSEM * Date/Publication: 2020-10-12 16:40:03 UTC -* Number of recursive dependencies: 116 +* Number of recursive dependencies: 120 Run `revdep_details(, "cSEM")` for more info @@ -20,46 +20,34 @@ Run `revdep_details(, "cSEM")` for more info All declared Imports should be used. ``` -# econet +# EFAtools
-* Version: 0.1.92 -* GitHub: NA -* Source code: https://github.com/cran/econet -* Date/Publication: 2020-09-02 11:20:02 UTC -* Number of recursive dependencies: 62 +* Version: 0.3.0 +* GitHub: https://github.com/mdsteiner/EFAtools +* Source code: https://github.com/cran/EFAtools +* Date/Publication: 2020-11-04 18:00:02 UTC +* Number of recursive dependencies: 88 -Run `revdep_details(, "econet")` for more info +Run `revdep_details(, "EFAtools")` for more info
## In both -* checking re-building of vignette outputs ... WARNING +* checking installed package size ... NOTE ``` - ... - Error: processing vignette 'econet.tex' failed with diagnostics: - Running 'texi2dvi' on 'econet.tex' failed. - LaTeX errors: - ! LaTeX Error: File `xpatch.sty' not found. - - Type X to quit or to proceed, - or enter new name. (Default extension: sty) - - ! Emergency stop. - - - l.20 \makeatletter - ^^M - ! ==> Fatal error occurred, no output PDF file produced! - --- failed re-building ‘econet.tex’ - - SUMMARY: processing the following file failed: - ‘econet.tex’ - - Error: Vignette re-building failed. - Execution halted + installed size is 7.4Mb + sub-directories of 1Mb or more: + doc 1.0Mb + libs 5.5Mb + ``` + +* checking dependencies in R code ... NOTE + ``` + Namespace in Imports field not imported from: ‘progress’ + All declared Imports should be used. ``` # EpiNow2 @@ -70,7 +58,7 @@ Run `revdep_details(, "econet")` for more info * GitHub: NA * Source code: https://github.com/cran/EpiNow2 * Date/Publication: 2020-10-20 14:50:09 UTC -* Number of recursive dependencies: 141 +* Number of recursive dependencies: 146 Run `revdep_details(, "EpiNow2")` for more info @@ -91,46 +79,26 @@ Run `revdep_details(, "EpiNow2")` for more info libs 104.8Mb ``` -# gtfs2gps +# funGp
-* Version: 1.3-0 -* GitHub: https://github.com/ipeaGIT/gtfs2gps -* Source code: https://github.com/cran/gtfs2gps -* Date/Publication: 2020-09-15 19:50:02 UTC -* Number of recursive dependencies: 71 +* Version: 0.2.0 +* GitHub: NA +* Source code: https://github.com/cran/funGp +* Date/Publication: 2020-11-17 09:10:03 UTC +* Number of recursive dependencies: 35 -Run `revdep_details(, "gtfs2gps")` for more info +Run `revdep_details(, "funGp")` for more info
## In both -* checking tests ... +* checking dependencies in R code ... NOTE ``` - ... - > test_check("gtfs2gps") - ── 1. Error: gtfs2gps (@test_gtfs2gps.R#70) ─────────────────────────────────── - 'workers >= 1L' is not TRUE - Backtrace: - 1. gtfs2gps::read_gtfs(sp) - 1. gtfs2gps::filter_by_shape_id(., 52000:52200) - 1. gtfs2gps::filter_week_days(.) - 1. gtfs2gps::filter_single_trip(.) - 9. gtfs2gps::gtfs2gps(., parallel = TRUE, spatial_resolution = 15) - 10. future::plan(strategy, workers = cores) - 11. future:::plan_set(...) - 13. future:::nbrOfWorkers.NULL() - 15. future:::nbrOfWorkers.multiprocess(plan("next")) - 16. future:::stop_if_not(...) - - ══ testthat results ═══════════════════════════════════════════════════════════ - [ OK: 153 | SKIPPED: 0 | WARNINGS: 0 | FAILED: 1 ] - 1. Error: gtfs2gps (@test_gtfs2gps.R#70) - - Error: testthat unit tests failed - Execution halted + Namespace in Imports field not imported from: ‘plyr’ + All declared Imports should be used. ``` # lmtp @@ -141,7 +109,7 @@ Run `revdep_details(, "gtfs2gps")` for more info * GitHub: NA * Source code: https://github.com/cran/lmtp * Date/Publication: 2020-07-18 09:10:02 UTC -* Number of recursive dependencies: 77 +* Number of recursive dependencies: 86 Run `revdep_details(, "lmtp")` for more info @@ -149,32 +117,6 @@ Run `revdep_details(, "lmtp")` for more info ## In both -* checking tests ... - ``` - ... - > - > test_check("lmtp") - -- 1. Error: contrast output is correct (@test-contrasts.R#29) ---------------- - unable to start device PNG - Backtrace: - 1. testthat::verify_output(...) - 2. grDevices::png(filename = tempfile()) - - -- 2. Error: create proper node lists, t > 1 (@test-node_list.R#5) ------------ - unable to start device PNG - Backtrace: - 1. testthat::verify_output(...) - 2. grDevices::png(filename = tempfile()) - - ══ testthat results ═══════════════════════════════════════════════════════════ - [ OK: 24 | SKIPPED: 0 | WARNINGS: 2 | FAILED: 2 ] - 1. Error: contrast output is correct (@test-contrasts.R#29) - 2. Error: create proper node lists, t > 1 (@test-node_list.R#5) - - Error: testthat unit tests failed - Execution halted - ``` - * checking package dependencies ... NOTE ``` Package which this enhances but not available for checking: ‘sl3’ @@ -191,11 +133,11 @@ Run `revdep_details(, "lmtp")` for more info
-* Version: 0.3.0 +* Version: 0.3.1 * GitHub: https://github.com/business-science/modeltime * Source code: https://github.com/cran/modeltime -* Date/Publication: 2020-10-28 14:00:07 UTC -* Number of recursive dependencies: 190 +* Date/Publication: 2020-11-09 21:50:02 UTC +* Number of recursive dependencies: 195 Run `revdep_details(, "modeltime")` for more info @@ -206,26 +148,26 @@ Run `revdep_details(, "modeltime")` for more info * checking tests ... ``` ... - - The following object is masked from 'package:kernlab': - - error - - ── 1. Error: (unknown) (@test-results-forecast-plots.R#34) ──────────────────── - unable to start device PNG + Error: unable to start device PNG Backtrace: - 1. base::suppressWarnings(...) - 2. dplyr::mutate_at(., vars(.value:.conf_hi), exp) - 10. modeltime::plot_modeltime_forecast(., .interactive = TRUE) - 13. plotly:::ggplotly.ggplot(g, dynamicTicks = TRUE) - 14. plotly::gg2list(...) - 15. grDevices:::dev_fun(...) + █ + 1. ├─base::suppressWarnings(...) test-results-forecast-plots.R:34:0 + 2. │ └─base::withCallingHandlers(...) + 3. ├─forecast_tbl %>% mutate_at(vars(.value:.conf_hi), exp) %>% plot_modeltime_forecast(.interactive = TRUE) test-results-forecast-plots.R:36:4 + 4. └─modeltime::plot_modeltime_forecast(., .interactive = TRUE) + 5. ├─plotly::ggplotly(g, dynamicTicks = TRUE) + 6. └─plotly:::ggplotly.ggplot(g, dynamicTicks = TRUE) + 7. └─plotly::gg2list(...) + 8. └─grDevices:::dev_fun(...) + + ── Skipped tests ────────────────────────────────────────────────────────────── + ● On CRAN (7) ══ testthat results ═══════════════════════════════════════════════════════════ - [ OK: 465 | SKIPPED: 7 | WARNINGS: 0 | FAILED: 1 ] - 1. Error: (unknown) (@test-results-forecast-plots.R#34) + ERROR (test-results-forecast-plots.R:34:1): (code run outside of `test_that()`) - Error: testthat unit tests failed + [ FAIL 1 | WARN 0 | SKIP 7 | PASS 465 ] + Error: Test failures Execution halted ``` @@ -233,11 +175,11 @@ Run `revdep_details(, "modeltime")` for more info
-* Version: 0.2.0 +* Version: 0.3.0 * GitHub: https://github.com/business-science/modeltime.ensemble * Source code: https://github.com/cran/modeltime.ensemble -* Date/Publication: 2020-10-09 10:20:02 UTC -* Number of recursive dependencies: 184 +* Date/Publication: 2020-11-06 18:00:02 UTC +* Number of recursive dependencies: 190 Run `revdep_details(, "modeltime.ensemble")` for more info @@ -248,7 +190,30 @@ Run `revdep_details(, "modeltime.ensemble")` for more info * checking dependencies in R code ... NOTE ``` Namespaces in Imports field not imported from: - ‘crayon’ ‘dials’ ‘glmnet’ ‘parsnip’ ‘timetk’ + ‘crayon’ ‘dials’ ‘glmnet’ ‘parsnip’ ‘progressr’ ‘utils’ + All declared Imports should be used. + ``` + +# modeltime.resample + +
+ +* Version: 0.1.0 +* GitHub: https://github.com/business-science/modeltime.resample +* Source code: https://github.com/cran/modeltime.resample +* Date/Publication: 2020-11-05 07:40:09 UTC +* Number of recursive dependencies: 194 + +Run `revdep_details(, "modeltime.resample")` for more info + +
+ +## In both + +* checking dependencies in R code ... NOTE + ``` + Namespaces in Imports field not imported from: + ‘crayon’ ‘dials’ ‘glue’ ‘parsnip’ All declared Imports should be used. ``` @@ -256,11 +221,11 @@ Run `revdep_details(, "modeltime.ensemble")` for more info
-* Version: 2.4.0 +* Version: 2.5.0 * GitHub: https://github.com/rmaia/pavo * Source code: https://github.com/cran/pavo -* Date/Publication: 2020-02-08 16:20:08 UTC -* Number of recursive dependencies: 90 +* Date/Publication: 2020-11-12 09:00:02 UTC +* Number of recursive dependencies: 100 Run `revdep_details(, "pavo")` for more info From 20b713ff42cf187ae5f8cad4d1d2dbcb7ceee1ed Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 18 Nov 2020 12:38:50 -0800 Subject: [PATCH 49/94] TESTS: Run zzz,... tests also with the global handler --- R/utils.R | 6 ++++-- tests/zzz,doFuture.R | 17 +++++++++++++++++ tests/zzz,foreach_do.R | 17 +++++++++++++++++ tests/zzz,furrr.R | 19 ++++++++++++++++++- tests/zzz,future.apply.R | 17 +++++++++++++++++ tests/zzz,plyr.R | 16 ++++++++++++++++ tests/zzz,purrr.R | 17 +++++++++++++++++ 7 files changed, 106 insertions(+), 3 deletions(-) diff --git a/R/utils.R b/R/utils.R index 35e8c3a..ca6b7f7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -67,7 +67,7 @@ mstr <- function(..., appendLF = TRUE, debug = getOption("progressr.debug", FALS message(paste(now(), capture_output(str(...)), sep = "", collapse = "\n"), appendLF = appendLF) } -stop_if_not <- function(...) { +stop_if_not <- function(..., calls = sys.calls()) { res <- list(...) n <- length(res) if (n == 0L) return() @@ -78,7 +78,9 @@ stop_if_not <- function(...) { mc <- match.call() call <- deparse(mc[[ii + 1]], width.cutoff = 60L) if (length(call) > 1L) call <- paste(call[1L], "...") - stop(sQuote(call), " is not TRUE", call. = FALSE, domain = NA) + callstack <- paste(as.character(calls), collapse = " -> ") + stop(sQuote(call), " is not TRUE [call stack: ", callstack, "]", + call. = FALSE, domain = NA) } } } diff --git a/tests/zzz,doFuture.R b/tests/zzz,doFuture.R index 7df5538..0fb2050 100644 --- a/tests/zzz,doFuture.R +++ b/tests/zzz,doFuture.R @@ -8,6 +8,8 @@ if (requireNamespace("doFuture", quietly = TRUE)) { future::plan(strategy) print(future::plan()) + message("* with_progress()") + with_progress({ p <- progressor(4) y <- foreach(n = 3:6) %dopar% { @@ -15,6 +17,21 @@ if (requireNamespace("doFuture", quietly = TRUE)) { slow_sum(1:n, stdout=TRUE, message=TRUE) } }) + + + message("* global progression handler") + + register_global_progression_handler("add") + + local({ + p <- progressor(4) + y <- foreach(n = 3:6) %dopar% { +# p() + slow_sum(1:n, stdout=TRUE, message=TRUE) + } + }) + + register_global_progression_handler("remove") } } diff --git a/tests/zzz,foreach_do.R b/tests/zzz,foreach_do.R index e4c5516..c8a356a 100644 --- a/tests/zzz,foreach_do.R +++ b/tests/zzz,foreach_do.R @@ -2,6 +2,9 @@ source("incl/start.R") if (requireNamespace("foreach", quietly = TRUE)) { library("doFuture", character.only = TRUE) + + message("* with_progress()") + with_progress({ p <- progressor(4) y <- foreach(n = 3:6) %do% { @@ -9,6 +12,20 @@ if (requireNamespace("foreach", quietly = TRUE)) { slow_sum(1:n, stdout=TRUE, message=TRUE) } }) + + message("* global progression handler") + + register_global_progression_handler("add") + + local({ + p <- progressor(4) + y <- foreach(n = 3:6) %do% { +# p() + slow_sum(1:n, stdout=TRUE, message=TRUE) + } + }) + + register_global_progression_handler("remove") } source("incl/end.R") diff --git a/tests/zzz,furrr.R b/tests/zzz,furrr.R index 906c000..3e24122 100644 --- a/tests/zzz,furrr.R +++ b/tests/zzz,furrr.R @@ -4,7 +4,9 @@ if (requireNamespace("furrr", quietly = TRUE)) { for (strategy in c("sequential", "multisession", "multicore")) { future::plan(strategy) print(future::plan()) - + + message("* with_progress()") + with_progress({ p <- progressor(4) y <- furrr::future_map(3:6, function(n) { @@ -12,6 +14,21 @@ if (requireNamespace("furrr", quietly = TRUE)) { slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) + + + message("* global progression handler") + + register_global_progression_handler("add") + + local({ + p <- progressor(4) + y <- furrr::future_map(3:6, function(n) { +# p() + slow_sum(1:n, stdout=TRUE, message=TRUE) + }) + }) + + register_global_progression_handler("remove") } } diff --git a/tests/zzz,future.apply.R b/tests/zzz,future.apply.R index 34ac7f3..2bc9e12 100644 --- a/tests/zzz,future.apply.R +++ b/tests/zzz,future.apply.R @@ -4,6 +4,8 @@ if (requireNamespace("future.apply", quietly = TRUE)) { for (strategy in c("sequential", "multisession", "multicore")) { future::plan(strategy) print(future::plan()) + + message("* with_progress()") with_progress({ p <- progressor(4) @@ -12,6 +14,21 @@ if (requireNamespace("future.apply", quietly = TRUE)) { slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) + + + message("* global progression handler") + + register_global_progression_handler("add") + + local({ + p <- progressor(4) + y <- future.apply::future_lapply(3:6, function(n) { +# p() + slow_sum(1:n, stdout=TRUE, message=TRUE) + }) + }) + + register_global_progression_handler("remove") } } diff --git a/tests/zzz,plyr.R b/tests/zzz,plyr.R index a867f91..a6c89fd 100644 --- a/tests/zzz,plyr.R +++ b/tests/zzz,plyr.R @@ -1,11 +1,27 @@ source("incl/start.R") if (requireNamespace("plyr", quietly = TRUE)) { + message("* with_progress()") + with_progress({ y <- plyr::llply(3:6, function(n, ...) { slow_sum(1:n, stdout=TRUE, message=TRUE) }, .progress = "progressr") }) + + + + message("* global progression handler") + + register_global_progression_handler("add") + + local({ + y <- plyr::llply(3:6, function(n, ...) { + slow_sum(1:n, stdout=TRUE, message=TRUE) + }, .progress = "progressr") + }) + + register_global_progression_handler("remove") } source("incl/end.R") diff --git a/tests/zzz,purrr.R b/tests/zzz,purrr.R index 05b476a..34b4d51 100644 --- a/tests/zzz,purrr.R +++ b/tests/zzz,purrr.R @@ -1,6 +1,8 @@ source("incl/start.R") if (requireNamespace("purrr", quietly = TRUE)) { + message("* with_progress()") + with_progress({ p <- progressor(4) y <- purrr::map(3:6, function(n) { @@ -8,6 +10,21 @@ if (requireNamespace("purrr", quietly = TRUE)) { slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) + + + message("* global progression handler") + + register_global_progression_handler("add") + + local({ + p <- progressor(4) + y <- purrr::map(3:6, function(n) { +# p() + slow_sum(1:n, stdout=TRUE, message=TRUE) + }) + }) + + register_global_progression_handler("remove") } source("incl/end.R") From 2c4d3383a66a68de36685c76177601fe20f7f240 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 18 Nov 2020 15:08:19 -0800 Subject: [PATCH 50/94] Now handler_debug() give uuid info on progressor and owner session --- R/handler_debug.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/handler_debug.R b/R/handler_debug.R index f3a0803..0c842e3 100644 --- a/R/handler_debug.R +++ b/R/handler_debug.R @@ -29,8 +29,8 @@ handler_debug <- function(interval = getOption("progressr.interval", 0), intrusi 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)) + entry <- list(now(t), dt, delay, progression$type, state$step, config$max_steps, state$delta, message, config$clear, state$enabled, paste0(progression$status, ""), progression$progressor_uuid, progression$owner_session_uuid) + msg <- do.call(sprintf, args = c(list("%s(%.3fs => +%.3fs) %s: %d/%d (%+d) '%s' {clear=%s, enabled=%s, status=%s, progressor=%s, owner=%s}"), entry)) message(msg) } From 3ba571cedbeb507e132e45f8bdac006546b1195b Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 18 Nov 2020 15:09:08 -0800 Subject: [PATCH 51/94] Prepared stop_if_not() to also report on sys.calls() --- R/utils.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/utils.R b/R/utils.R index ca6b7f7..444c25f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -78,9 +78,12 @@ stop_if_not <- function(..., calls = sys.calls()) { mc <- match.call() call <- deparse(mc[[ii + 1]], width.cutoff = 60L) if (length(call) > 1L) call <- paste(call[1L], "...") - callstack <- paste(as.character(calls), collapse = " -> ") - stop(sQuote(call), " is not TRUE [call stack: ", callstack, "]", - call. = FALSE, domain = NA) + msg <- sprintf("%s is not TRUE", sQuote(call)) + if (FALSE) { + callstack <- paste(as.character(calls), collapse = " -> ") + msg <- sprintf("%s [call stack: %s]", msg, callstack) + } + stop(msg, call. = FALSE, domain = NA) } } } From ae15c3dad2f46708a58f77293307215de7a639ce Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Wed, 18 Nov 2020 15:10:53 -0800 Subject: [PATCH 52/94] BUG FIX: When closing the progressor, it might not be possible to close active sinks and the stdout_file connection due to other, blocking sinks [#95] --- R/global_progression_handler.R | 42 ++++++++++++++++++++-------------- tests/zzz,doFuture.R | 2 +- tests/zzz,foreach_do.R | 2 +- tests/zzz,furrr.R | 2 +- tests/zzz,future.apply.R | 2 +- tests/zzz,purrr.R | 2 +- 6 files changed, 30 insertions(+), 22 deletions(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 48be82a..30e7882 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -97,26 +97,36 @@ global_progression_handler <- local({ if (!is.null(calling_handler)) { stdout_file <<- delay_stdout(delays, stdout_file = stdout_file) finished <- calling_handler(progression) - stdout_file <<- flush_stdout(stdout_file, close = TRUE) - stop_if_not(is.null(stdout_file)) + ## Note that we might not be able to close 'stdout_file' due + ## to blocking, non-balanced sinks + stdout_file <<- flush_stdout(stdout_file, close = TRUE, must_work = FALSE) conditions <<- flush_conditions(conditions) delays <<- NULL if (debug) message(" - finished: ", finished) } else { finished <- TRUE } + } else { + if (debug) message(" - no active global progression handler") } - + + ## Note that we might not have been able to close 'stdout_file' in previous + ## calls to finish() due to blocking, non-balanced sinks. Try again here, + ## just in case + if (!is.null(stdout_file)) { + stdout_file <<- flush_stdout(stdout_file, close = TRUE, must_work = FALSE) + } + current_progressor_uuid <<- NULL calling_handler <<- NULL capture_conditions <<- NA finished <- TRUE - stop_if_not(is.null(stdout_file), length(conditions) == 0L, is.null(delays), isTRUE(finished), is.na(capture_conditions)) + stop_if_not(length(conditions) == 0L, is.null(delays), isTRUE(finished), is.na(capture_conditions)) finished } - handle_progression <- function(progression) { + handle_progression <- function(progression, debug = getOption("progressr.global.debug", FALSE)) { ## To please R CMD check calling_handler <- NULL; rm(list = "calling_handler") @@ -135,8 +145,6 @@ global_progression_handler <- local({ assign(".Last.progression", value = progression, envir = genv, inherits = FALSE) - debug <- getOption("progressr.global.debug", FALSE) - if (debug) message(sprintf("*** Caught a %s condition:", sQuote(class(progression)[1]))) progressor_uuid <- progression[["progressor_uuid"]] if (debug) message(" - source: ", progressor_uuid) @@ -170,6 +178,8 @@ global_progression_handler <- local({ stop(sprintf("INTERNAL ERROR: Already listening to this progressor which just sent another %s request", sQuote(type))) } if (debug) message(" - start listening") +# finished <- finish(debug = debug) +# stop_if_not(is.null(stdout_file), length(conditions) == 0L) current_progressor_uuid <<- progressor_uuid if (debug) message(" - reset progression handlers") update_calling_handler() @@ -181,8 +191,7 @@ global_progression_handler <- local({ if (debug) message(" - finished: ", finished) if (finished) { finished <- finish(debug = debug) - stop_if_not(is.null(stdout_file), length(conditions) == 0L, - is.na(capture_conditions), isTRUE(finished)) + stop_if_not(length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) } } } else if (type == "update") { @@ -204,14 +213,12 @@ global_progression_handler <- local({ if (finished) { calling_handler(control_progression("shutdown")) finished <- finish(debug = debug) - stop_if_not(is.null(stdout_file), length(conditions) == 0L, - is.na(capture_conditions), isTRUE(finished)) + stop_if_not(length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) } } } else if (type == "finish") { finished <- finish(debug = debug) - stop_if_not(is.null(stdout_file), length(conditions) == 0L, - is.na(capture_conditions), isTRUE(finished)) + stop_if_not(length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) } else if (type == "status") { status <- list( current_progressor_uuid = current_progressor_uuid, @@ -230,18 +237,19 @@ global_progression_handler <- local({ function(condition) { + debug <- getOption("progressr.global.debug", FALSE) + ## Shut down progression handling? if (inherits(condition, c("interrupt", "error"))) { progression <- control_progression("shutdown") - finished <- finish() - stop_if_not(is.null(stdout_file), length(conditions) == 0L, - is.na(capture_conditions), isTRUE(finished)) + finished <- finish(debug = debug) + stop_if_not(length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) return() } ## A 'progression' update? if (inherits(condition, "progression")) { - return(handle_progression(condition)) + return(handle_progression(condition, debug = debug)) } ## Nothing do to? diff --git a/tests/zzz,doFuture.R b/tests/zzz,doFuture.R index 0fb2050..e09728f 100644 --- a/tests/zzz,doFuture.R +++ b/tests/zzz,doFuture.R @@ -26,7 +26,7 @@ if (requireNamespace("doFuture", quietly = TRUE)) { local({ p <- progressor(4) y <- foreach(n = 3:6) %dopar% { -# p() + p() slow_sum(1:n, stdout=TRUE, message=TRUE) } }) diff --git a/tests/zzz,foreach_do.R b/tests/zzz,foreach_do.R index c8a356a..8ee7860 100644 --- a/tests/zzz,foreach_do.R +++ b/tests/zzz,foreach_do.R @@ -20,7 +20,7 @@ if (requireNamespace("foreach", quietly = TRUE)) { local({ p <- progressor(4) y <- foreach(n = 3:6) %do% { -# p() + p() slow_sum(1:n, stdout=TRUE, message=TRUE) } }) diff --git a/tests/zzz,furrr.R b/tests/zzz,furrr.R index 3e24122..cade4f8 100644 --- a/tests/zzz,furrr.R +++ b/tests/zzz,furrr.R @@ -23,7 +23,7 @@ if (requireNamespace("furrr", quietly = TRUE)) { local({ p <- progressor(4) y <- furrr::future_map(3:6, function(n) { -# p() + p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) diff --git a/tests/zzz,future.apply.R b/tests/zzz,future.apply.R index 2bc9e12..c858003 100644 --- a/tests/zzz,future.apply.R +++ b/tests/zzz,future.apply.R @@ -23,7 +23,7 @@ if (requireNamespace("future.apply", quietly = TRUE)) { local({ p <- progressor(4) y <- future.apply::future_lapply(3:6, function(n) { -# p() + p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) diff --git a/tests/zzz,purrr.R b/tests/zzz,purrr.R index 34b4d51..9cf7e42 100644 --- a/tests/zzz,purrr.R +++ b/tests/zzz,purrr.R @@ -19,7 +19,7 @@ if (requireNamespace("purrr", quietly = TRUE)) { local({ p <- progressor(4) y <- purrr::map(3:6, function(n) { -# p() + p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) From 2f0ec667855b4985a896bd4cd74e11467bfdb90b Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 14:16:15 -0800 Subject: [PATCH 53/94] Adding handlers(globals = TRUE) for the global progression handler [#95] --- NEWS | 8 +++++--- R/handlers.R | 36 ++++++++++++++++++++++++++++++------ R/zzz.R | 14 ++++++++++++++ incl/handlers.R | 11 ++++++++++- man/handlers.Rd | 20 ++++++++++++++++++-- 5 files changed, 77 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index c69d390..eab049a 100644 --- a/NEWS +++ b/NEWS @@ -1,18 +1,20 @@ Package: progressr ================== -Version: 0.6.0-9000 [2020-11-16] +Version: 0.6.0-9000 [2020-12-04] SIGNIFICANT CHANGES: + * The user can how use handlers(globals = TRUE) to enable progress reports + everywhere without having to use with_progress(). This works on in + R (>= 4.0.0) because it relies on global calling handlers. + * A progressor must not be created in the global environment unless wrapped in with_progress() or without_progress() call. Ideally, a progressor is created within a function or a local() environment. NEW FEATURES: - * Add register_global_progression_handler(). - * progressor() gained argument 'on_exit = TRUE'. * Add the 'pbcol' handler, which renders the progress as a colored progress diff --git a/R/handlers.R b/R/handlers.R index ae473b4..7ea7133 100644 --- a/R/handlers.R +++ b/R/handlers.R @@ -16,9 +16,15 @@ #' @param default The default progression calling handler to use if none #' are set. #' +#' @param global If TRUE, then the global progression handler is enabled. +#' If FALSE, it is disabled. If NA, then TRUE is returned if it is enabled, +#' otherwise FALSE. Argument `global` must not used with other arguments. +#' #' @return (invisibly) the previous list of progression handlers set. #' If no arguments are specified, then the current set of progression #' handlers is returned. +#' If `global` is specified, then TRUE is returned if the global progression +#' handlers is enabled, otherwise false. #' #' @details #' This function provides a convenient alternative for getting and setting @@ -32,19 +38,37 @@ #' @example incl/handlers.R #' #' @export -handlers <- function(..., append = FALSE, on_missing = c("error", "warning", "ignore"), default = handler_txtprogressbar) { +handlers <- function(..., append = FALSE, on_missing = c("error", "warning", "ignore"), default = handler_txtprogressbar, global = NULL) { + stop_if_not( + is.null(global) || + ( is.logical(global) && length(global) == 1L ) + ) args <- list(...) + nargs <- length(args) + + if (nargs == 0L) { + ## Get the current set of progression handlers? + if (is.null(global)) { + if (!is.list(default) && !is.null(default)) default <- list(default) + return(getOption("progressr.handlers", default)) + } + + ## Check, register, or reset global calling handlers? + if (is.na(global)) { + return(register_global_progression_handler(action = "query")) + } + action <- if (isTRUE(global)) "add" else "remove" + return(invisible(register_global_progression_handler(action = action))) + } - ## Get the current set of progression handlers? - if (length(args) == 0L) { - if (!is.list(default) && !is.null(default)) default <- list(default) - return(getOption("progressr.handlers", default)) + if (!is.null(global)) { + stop("Argument 'global' must not be specified when also registering progress handlers") } on_missing <- match.arg(on_missing) ## Was a list specified? - if (length(args) == 1L && is.vector(args[[1]])) { + if (nargs == 1L && is.vector(args[[1]])) { args <- args[[1]] } diff --git a/R/zzz.R b/R/zzz.R index 2383d18..ea26509 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,6 +1,20 @@ .onLoad <- function(libname, pkgname) { + ## R CMD check if (in_r_cmd_check()) { options(progressr.demo.delay = 0.0) } + + ## R CMD build register_vignette_engine_during_build_only(pkgname) + + ## Register a global progression handler on load? + global <- Sys.getenv("R_PROGRESSR_GLOBAL_HANDLER", "FALSE") + global <- getOption("progressr.global.handler", as.logical(global)) + if (isTRUE(global)) { + utils::str(globalCallingHandlers()) + globalCallingHandlers(foo=function(c) utils::str(c)) +# register_global_progression_handler() + } } + + diff --git a/incl/handlers.R b/incl/handlers.R index 3f8ec68..b452a7c 100644 --- a/incl/handlers.R +++ b/incl/handlers.R @@ -2,5 +2,14 @@ handlers("txtprogressbar") if (requireNamespace("beepr", quietly = TRUE)) handlers("beepr", append = TRUE) -with_progress({ y <- slow_sum(10) }) +with_progress({ y <- slow_sum(1:5) }) print(y) + + +if (getRversion() >= "4.0.0") { + handlers(global = TRUE) + y <- slow_sum(1:4) + z <- slow_sum(6:9) + handlers(global = FALSE) +} + diff --git a/man/handlers.Rd b/man/handlers.Rd index f6227ac..02e80a8 100644 --- a/man/handlers.Rd +++ b/man/handlers.Rd @@ -8,7 +8,8 @@ handlers( ..., append = FALSE, on_missing = c("error", "warning", "ignore"), - default = handler_txtprogressbar + default = handler_txtprogressbar, + global = NULL ) } \arguments{ @@ -27,11 +28,17 @@ missing handlers is ignored.} \item{default}{The default progression calling handler to use if none are set.} + +\item{global}{If TRUE, then the global progression handler is enabled. +If FALSE, it is disabled. If NA, then TRUE is returned if it is enabled, +otherwise FALSE. Argument \code{global} must not used with other arguments.} } \value{ (invisibly) the previous list of progression handlers set. If no arguments are specified, then the current set of progression handlers is returned. +If \code{global} is specified, then TRUE is returned if the global progression +handlers is enabled, otherwise false. } \description{ Control How Progress is Reported @@ -50,6 +57,15 @@ handlers("txtprogressbar") if (requireNamespace("beepr", quietly = TRUE)) handlers("beepr", append = TRUE) -with_progress({ y <- slow_sum(10) }) +with_progress({ y <- slow_sum(1:5) }) print(y) + + +if (getRversion() >= "4.0.0") { + handlers(global = TRUE) + y <- slow_sum(1:4) + z <- slow_sum(6:9) + handlers(global = FALSE) +} + } From 70031f8c75267f344c1e9af13aaafb88193290ad Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 14:51:38 -0800 Subject: [PATCH 54/94] No longer need to export register_global_progression_handler(); use handlers(global=TRUE/FALSE/NA) instead [#95] --- NAMESPACE | 1 - R/global_progression_handler.R | 2 +- incl/register_global_progression_handler.R | 4 ++-- man/register_global_progression_handler.Rd | 5 +++-- tests/globals,relay.R | 14 +++++++------- tests/zzz,doFuture.R | 4 ++-- tests/zzz,foreach_do.R | 4 ++-- tests/zzz,furrr.R | 4 ++-- tests/zzz,future.apply.R | 4 ++-- tests/zzz,plyr.R | 4 ++-- tests/zzz,purrr.R | 4 ++-- 11 files changed, 25 insertions(+), 25 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index be3b4dd..0c4c807 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,7 +24,6 @@ export(progress_aggregator) export(progress_progressr) export(progression) export(progressor) -export(register_global_progression_handler) export(slow_sum) export(withProgressShiny) export(with_progress) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 30e7882..729aa04 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -14,7 +14,7 @@ #' #' @example incl/register_global_progression_handler.R #' -#' @export +#' @keywords internal register_global_progression_handler <- function(action = c("add", "remove", "query")) { action <- match.arg(action[1], choices = c("add", "remove", "query", "status")) diff --git a/incl/register_global_progression_handler.R b/incl/register_global_progression_handler.R index bf88158..001780e 100644 --- a/incl/register_global_progression_handler.R +++ b/incl/register_global_progression_handler.R @@ -1,5 +1,5 @@ \dontshow{if (getRversion() >= "4.0.0")} -register_global_progression_handler() +handlers(global = TRUE) ## This renders progress updates for each of the three calls slow_sum() for (ii in 1:3) { @@ -10,4 +10,4 @@ for (ii in 1:3) { } \dontshow{if (getRversion() >= "4.0.0")} -register_global_progression_handler("remove") +handlers(global = FALSE) diff --git a/man/register_global_progression_handler.Rd b/man/register_global_progression_handler.Rd index 5594098..9607079 100644 --- a/man/register_global_progression_handler.Rd +++ b/man/register_global_progression_handler.Rd @@ -27,7 +27,7 @@ handlers where introduces. \examples{ \dontshow{if (getRversion() >= "4.0.0")} -register_global_progression_handler() +handlers(global = TRUE) ## This renders progress updates for each of the three calls slow_sum() for (ii in 1:3) { @@ -38,5 +38,6 @@ for (ii in 1:3) { } \dontshow{if (getRversion() >= "4.0.0")} -register_global_progression_handler("remove") +handlers(global = FALSE) } +\keyword{internal} diff --git a/tests/globals,relay.R b/tests/globals,relay.R index d87a2bf..ec7fc6f 100644 --- a/tests/globals,relay.R +++ b/tests/globals,relay.R @@ -13,10 +13,10 @@ handlers("txtprogressbar") handlers <- supported_progress_handlers() -register_global_progression_handler("remove") +handlers(global = FALSE) stopifnot(sink.number(type = "output") == nsinks0) -register_global_progression_handler("add") +handlers(global = TRUE) stopifnot(sink.number(type = "output") == nsinks0) message("global progress handlers - standard output, messages, warnings ...") @@ -32,12 +32,12 @@ for (kk in seq_along(handlers)) { for (delta in c(0L, +1L, -1L)) { message(sprintf(" - delta = %+d", delta)) - register_global_progression_handler("remove") + handlers(global = FALSE) stopifnot(sink.number(type = "output") == nsinks0) - register_global_progression_handler("add") + handlers(global = TRUE) stopifnot(sink.number(type = "output") == nsinks0) - status <- register_global_progression_handler("status") + status <- progressr:::register_global_progression_handler("status") stopifnot( is.null(status$current_progressor_uuid), is.null(status$delays), @@ -77,7 +77,7 @@ for (kk in seq_along(handlers)) { cat(paste(c(relay$stdout, ""), collapse = "\n")) message(relay$message, append = FALSE) - status <- register_global_progression_handler("status") + status <- progressr:::register_global_progression_handler("status") console_msg(capture.output(utils::str(status))) if (delta == 0L) { withCallingHandlers({ @@ -103,7 +103,7 @@ for (kk in seq_along(handlers)) { message("global progress handlers - standard output, messages, warnings ... done") -register_global_progression_handler("remove") +handlers(global = FALSE) source("incl/end.R") diff --git a/tests/zzz,doFuture.R b/tests/zzz,doFuture.R index e09728f..1976f5e 100644 --- a/tests/zzz,doFuture.R +++ b/tests/zzz,doFuture.R @@ -21,7 +21,7 @@ if (requireNamespace("doFuture", quietly = TRUE)) { message("* global progression handler") - register_global_progression_handler("add") + handlers(global = TRUE) local({ p <- progressor(4) @@ -31,7 +31,7 @@ if (requireNamespace("doFuture", quietly = TRUE)) { } }) - register_global_progression_handler("remove") + handlers(global = FALSE) } } diff --git a/tests/zzz,foreach_do.R b/tests/zzz,foreach_do.R index 8ee7860..75b9f18 100644 --- a/tests/zzz,foreach_do.R +++ b/tests/zzz,foreach_do.R @@ -15,7 +15,7 @@ if (requireNamespace("foreach", quietly = TRUE)) { message("* global progression handler") - register_global_progression_handler("add") + handlers(global = TRUE) local({ p <- progressor(4) @@ -25,7 +25,7 @@ if (requireNamespace("foreach", quietly = TRUE)) { } }) - register_global_progression_handler("remove") + handlers(global = FALSE) } source("incl/end.R") diff --git a/tests/zzz,furrr.R b/tests/zzz,furrr.R index cade4f8..51b6844 100644 --- a/tests/zzz,furrr.R +++ b/tests/zzz,furrr.R @@ -18,7 +18,7 @@ if (requireNamespace("furrr", quietly = TRUE)) { message("* global progression handler") - register_global_progression_handler("add") + handlers(global = TRUE) local({ p <- progressor(4) @@ -28,7 +28,7 @@ if (requireNamespace("furrr", quietly = TRUE)) { }) }) - register_global_progression_handler("remove") + handlers(global = FALSE) } } diff --git a/tests/zzz,future.apply.R b/tests/zzz,future.apply.R index c858003..175df49 100644 --- a/tests/zzz,future.apply.R +++ b/tests/zzz,future.apply.R @@ -18,7 +18,7 @@ if (requireNamespace("future.apply", quietly = TRUE)) { message("* global progression handler") - register_global_progression_handler("add") + handlers(global = TRUE) local({ p <- progressor(4) @@ -28,7 +28,7 @@ if (requireNamespace("future.apply", quietly = TRUE)) { }) }) - register_global_progression_handler("remove") + handlers(global = FALSE) } } diff --git a/tests/zzz,plyr.R b/tests/zzz,plyr.R index a6c89fd..0f0a00c 100644 --- a/tests/zzz,plyr.R +++ b/tests/zzz,plyr.R @@ -13,7 +13,7 @@ if (requireNamespace("plyr", quietly = TRUE)) { message("* global progression handler") - register_global_progression_handler("add") + handlers(global = TRUE) local({ y <- plyr::llply(3:6, function(n, ...) { @@ -21,7 +21,7 @@ if (requireNamespace("plyr", quietly = TRUE)) { }, .progress = "progressr") }) - register_global_progression_handler("remove") + handlers(global = FALSE) } source("incl/end.R") diff --git a/tests/zzz,purrr.R b/tests/zzz,purrr.R index 9cf7e42..751a900 100644 --- a/tests/zzz,purrr.R +++ b/tests/zzz,purrr.R @@ -14,7 +14,7 @@ if (requireNamespace("purrr", quietly = TRUE)) { message("* global progression handler") - register_global_progression_handler("add") + handlers(global = TRUE) local({ p <- progressor(4) @@ -24,7 +24,7 @@ if (requireNamespace("purrr", quietly = TRUE)) { }) }) - register_global_progression_handler("remove") + handlers(global = FALSE) } source("incl/end.R") From 5c8030e6fe76b9fd7fa3c2e6f347fb56146bf229 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 16:23:14 -0800 Subject: [PATCH 55/94] ROBUSTNESS: Start making use of suspendInterrupts(), which requires R (>= 3.5.0) --- .github/workflows/R-CMD-check.yaml | 1 - DESCRIPTION | 2 ++ NEWS | 4 +++- R/global_progression_handler.R | 13 +++++++++---- 4 files changed, 14 insertions(+), 6 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 2e323db..3086917 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -20,7 +20,6 @@ jobs: - { os: macOS-latest, r: '3.6'} - { os: macOS-latest, r: '4.0'} - { os: macOS-latest, r: 'devel'} - - { os: ubuntu-16.04, r: '3.4', cran: "https://demo.rstudiopm.com/all/__linux__/xenial/latest"} - { os: ubuntu-16.04, r: '3.5', cran: "https://demo.rstudiopm.com/all/__linux__/xenial/latest"} - { os: ubuntu-16.04, r: '3.6', cran: "https://demo.rstudiopm.com/all/__linux__/xenial/latest"} - { os: ubuntu-16.04, r: '4.0', cran: "https://demo.rstudiopm.com/all/__linux__/xenial/latest"} diff --git a/DESCRIPTION b/DESCRIPTION index 5b2a51f..3bf1544 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -6,6 +6,8 @@ Authors@R: c( person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"), email = "henrikb@braju.com")) License: GPL (>= 3) +Depends: + R (>= 3.5.0) Imports: digest, utils diff --git a/NEWS b/NEWS index eab049a..5d3c5a8 100644 --- a/NEWS +++ b/NEWS @@ -12,7 +12,9 @@ SIGNIFICANT CHANGES: * A progressor must not be created in the global environment unless wrapped in with_progress() or without_progress() call. Ideally, a progressor is created within a function or a local() environment. - + + * Package now requires R (>= 3.5.0) in order to protect against interrupts. + NEW FEATURES: * progressor() gained argument 'on_exit = TRUE'. diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 729aa04..63f0171 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -241,15 +241,20 @@ global_progression_handler <- local({ ## Shut down progression handling? if (inherits(condition, c("interrupt", "error"))) { - progression <- control_progression("shutdown") - finished <- finish(debug = debug) - stop_if_not(length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) + suspendInterrupts({ + progression <- control_progression("shutdown") + finished <- finish(debug = debug) + stop_if_not(length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) + }) return() } ## A 'progression' update? if (inherits(condition, "progression")) { - return(handle_progression(condition, debug = debug)) + suspendInterrupts({ + res <- handle_progression(condition, debug = debug) + }) + return(res) } ## Nothing do to? From f89a8af5e11fad99298fa2e9b12851119ed106bb Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 16:28:24 -0800 Subject: [PATCH 56/94] CLEANUP: Drop backward-compatible code not needed with new R (>= 3.5.0) requirement --- tests/demo.R | 2 +- tests/incl/start,load-only.R | 6 ------ 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/tests/demo.R b/tests/demo.R index a8acaff..7b39371 100644 --- a/tests/demo.R +++ b/tests/demo.R @@ -10,7 +10,7 @@ message("*** Demos ...") message("*** Mandelbrot demo ...") -if (getRversion() >= "3.2.0" && !isWin32) { +if (!isWin32) { options(future.demo.mandelbrot.nrow = 2L) options(future.demo.mandelbrot.resolution = 50L) options(future.demo.mandelbrot.delay = FALSE) diff --git a/tests/incl/start,load-only.R b/tests/incl/start,load-only.R index f4e4179..032f155 100644 --- a/tests/incl/start,load-only.R +++ b/tests/incl/start,load-only.R @@ -71,12 +71,6 @@ if (covr) { -## WORKAROUND: capture.output() gained argument 'split' in R 3.3.0 -if (getRversion() >= "3.3.0") { - capture.output <- utils::capture.output -} else { - capture.output <- function(..., split = FALSE) utils::capture.output(...) -} capture_output <- function(..., split = FALSE, collapse = NULL) { bfr <- capture.output(..., split = split) if (!is.null(collapse)) bfr <- paste(c(bfr, ""), collapse = "\n") From e4f5328ef4245b06b6e4ea9687c2b384da3a5210 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 21:50:41 -0800 Subject: [PATCH 57/94] Now debug handler can report on fractional deltas --- R/handler_debug.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/handler_debug.R b/R/handler_debug.R index 0c842e3..0e743cb 100644 --- a/R/handler_debug.R +++ b/R/handler_debug.R @@ -30,7 +30,7 @@ handler_debug <- function(interval = getOption("progressr.interval", 0), intrusi 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, ""), progression$progressor_uuid, progression$owner_session_uuid) - msg <- do.call(sprintf, args = c(list("%s(%.3fs => +%.3fs) %s: %d/%d (%+d) '%s' {clear=%s, enabled=%s, status=%s, progressor=%s, owner=%s}"), entry)) + msg <- do.call(sprintf, args = c(list("%s(%.3fs => +%.3fs) %s: %.0f/%.0f (%+g) '%s' {clear=%s, enabled=%s, status=%s, progressor=%s, owner=%s}"), entry)) message(msg) } From 713fa617aa30896f03e9ac2b0fc438a0106d86df Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 22:34:19 -0800 Subject: [PATCH 58/94] BUG FIX: Zero-amount progress updates never reached the progress handlers [#94] --- NEWS | 2 ++ R/handler_progress.R | 2 +- R/make_progression_handler.R | 20 ++++++++++++-------- 3 files changed, 15 insertions(+), 9 deletions(-) diff --git a/NEWS b/NEWS index 5d3c5a8..d3bd427 100644 --- a/NEWS +++ b/NEWS @@ -26,6 +26,8 @@ NEW FEATURES: BUG FIXES: + * Zero-amount progress updates never reached the progress handlers. + * Argument 'enable' for with_progress() had no effect. diff --git a/R/handler_progress.R b/R/handler_progress.R index df7f3da..bdfe3ff 100644 --- a/R/handler_progress.R +++ b/R/handler_progress.R @@ -83,7 +83,7 @@ handler_progress <- function(format = "[:bar] :percent :message", show_after = 0 pb_tick <- function(pb, delta = 0, message = NULL, ...) { tokens <- list(message = paste0(message, "")) last_tokens <<- tokens - if (delta <= 0) return() + if (delta < 0) return() pb$tick(delta, tokens = tokens) } diff --git a/R/make_progression_handler.R b/R/make_progression_handler.R index 79978b0..0681bb8 100644 --- a/R/make_progression_handler.R +++ b/R/make_progression_handler.R @@ -360,10 +360,12 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en timestamps[step] <<- Sys.time() if (debug) mstr(list(finished = finished, step = step, milestones = milestones, prev_milestone = prev_milestone, interval = interval)) - ## Only update if a new milestone step has been reached - if (length(milestones) > 0L && step >= milestones[1]) { + ## Only update if a new milestone step has been reached ... + ## ... or if we want to send a zero-amount update + if ((length(milestones) > 0L && step >= milestones[1]) || + p[["amount"]] == 0) { skip <- FALSE - if (interval > 0) { + if (interval > 0 && step > 0) { dt <- difftime(timestamps[step], timestamps[max(prev_milestone, 1L)], units = "secs") skip <- (dt < interval) if (debug) mstr(list(dt = dt, timestamps[step], timestamps[prev_milestone], skip = skip)) @@ -371,12 +373,14 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en if (!skip) { if (debug) mstr(list(milestones = milestones)) update_reporter(p) - prev_milestone <<- step + if (p[["amount"]] > 0) prev_milestone <<- step } - milestones <<- milestones[milestones > step] - if (auto_finish && step == max_steps) { - if (debug) mstr(list(type = "finish (auto)", milestones = milestones)) - finish_reporter(p) + if (p[["amount"]] > 0) { + milestones <<- milestones[milestones > step] + if (auto_finish && step == max_steps) { + if (debug) mstr(list(type = "finish (auto)", milestones = milestones)) + finish_reporter(p) + } } } .validate_internal_state(sprintf("handler(type=%s) ... end", type)) From 9910894d88190a87cb74f20d85dba4aeddb905c0 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 22:56:13 -0800 Subject: [PATCH 59/94] The pbcol handlers gained a spinner [#94] --- R/handler_pbcol.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R index dab5ba8..39a0ebf 100644 --- a/R/handler_pbcol.R +++ b/R/handler_pbcol.R @@ -30,7 +30,7 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = cat_(c("\r", rep(" ", times = getOption("width")), "\r")) } - redraw_progress_bar <- function(ratio, message) { + redraw_progress_bar <- function(ratio, message, spin = " ") { stop_if_not(ratio >= 0, ratio <= 1) pbstr <- pbcol( fraction = ratio, @@ -38,16 +38,19 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = adjust = adjust, pad = pad, done_col = done_col, - todo_col = todo_col + todo_col = todo_col, + spin = spin, ) cat_("\r", pbstr) } reporter <- local({ + spin_state <- 0L + spinner <- c("-", "\\", "|", "/", "-", "\\", "|", "/") list( initiate = function(config, state, ...) { if (!state$enabled || config$times <= 2L) return() - redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) + redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message, spin = spinner[spin_state+1L]) }, reset = function(...) { @@ -60,17 +63,14 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = unhide = function(config, state, ...) { if (!state$enabled || config$times <= 2L) return() - redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) + redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message, spin = spinner[spin_state+1L]) }, update = function(config, state, progression, ...) { if (!state$enabled || config$times <= 2L) return() if (state$delta < 0) return() - if (state$delta == 0) { - cat_("\r.") - Sys.sleep(0.5) - } - redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message) + spin_state <<- (spin_state+1L) %% length(spinner) + redraw_progress_bar(ratio = state$step / config$max_steps, message = state$message, spin = spinner[spin_state+1L]) }, finish = function(...) { @@ -84,7 +84,7 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = -pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOption("width"), done_col = "blue", todo_col = "cyan") { +pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOption("width") - 1L, done_col = "blue", todo_col = "cyan", spin = " ") { bgColor <- function(s, col) { bgFcn <- switch(col, black = crayon::bgBlack, @@ -129,7 +129,7 @@ pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOpt lpad <- floor( adjust * msgpad) + pad rpad <- floor((1-adjust) * msgpad) stop_if_not(lpad >= 0L, rpad >= 0L) - pmsg <- sprintf("%*s%s%*s%s%*s", lpad, "", msg, rpad, "", msgfraction, pad, "") + pmsg <- sprintf("%*s%s%*s%s%s%*s", lpad, "", msg, rpad, "", msgfraction, spin, pad, "") ## Make progress bar len <- round(fraction * nchar(pmsg), digits = 0L) From 0ecba8255954e48f0e0101e7b1a37f64c0773d37 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 23:09:03 -0800 Subject: [PATCH 60/94] Now the 'progress' handler shows also a spinner by default --- NEWS | 2 ++ R/handler_progress.R | 14 +++++++------- man/handler_progress.Rd | 14 +++++++------- 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/NEWS b/NEWS index d3bd427..c51c318 100644 --- a/NEWS +++ b/NEWS @@ -19,6 +19,8 @@ NEW FEATURES: * progressor() gained argument 'on_exit = TRUE'. + * Now the 'progress' handler shows also a spinner by default. + * Add the 'pbcol' handler, which renders the progress as a colored progress bar in the terminal with any messages written in the front. diff --git a/R/handler_progress.R b/R/handler_progress.R index bdfe3ff..4a88b2d 100644 --- a/R/handler_progress.R +++ b/R/handler_progress.R @@ -20,22 +20,22 @@ #' #' With `handlers(handler_progress())`: #' ```r -#' [-------------------------------------------------] 0% -#' [====>--------------------------------------------] 10% -#' [================================================>] 99% +#' - [-------------------------------------------------] 0% +#' \ [====>--------------------------------------------] 10% +#' | [================================================>] 99% #' ``` #' #' If the progression updates have messages, they will appear like: #' ```r -#' [-----------------------------------------] 0% Starting -#' [===========>----------------------------] 30% Importing -#' [=====================================>] 99% Summarizing +#' - [-----------------------------------------] 0% Starting +#' \ [===========>----------------------------] 30% Importing +#' | [=====================================>] 99% Summarizing #' ``` #' #' @example incl/handler_progress.R #' #' @export -handler_progress <- function(format = "[:bar] :percent :message", show_after = 0.0, intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) { +handler_progress <- function(format = ":spin [:bar] :percent :message", show_after = 0.0, intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) { ## Additional arguments passed to the progress-handler backend backend_args <- handler_backend_args(...) diff --git a/man/handler_progress.Rd b/man/handler_progress.Rd index 0ea4160..12794ab 100644 --- a/man/handler_progress.Rd +++ b/man/handler_progress.Rd @@ -5,7 +5,7 @@ \title{Progression Handler: Progress Reported via 'progress' Progress Bars (Text) in the Terminal} \usage{ handler_progress( - format = "[:bar] :percent :message", + format = ":spin [:bar] :percent :message", show_after = 0, intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", @@ -39,14 +39,14 @@ This progression handler requires the \pkg{progress} package. Below is how this progress handler renders by default at 0\%, 30\% and 99\% progress: -With \code{handlers(handler_progress())}:\if{html}{\out{
}}\preformatted{[-------------------------------------------------] 0\% -[====>--------------------------------------------] 10\% -[================================================>] 99\% +With \code{handlers(handler_progress())}:\if{html}{\out{
}}\preformatted{- [-------------------------------------------------] 0\% +\\ [====>--------------------------------------------] 10\% +| [================================================>] 99\% }\if{html}{\out{
}} -If the progression updates have messages, they will appear like:\if{html}{\out{
}}\preformatted{[-----------------------------------------] 0\% Starting -[===========>----------------------------] 30\% Importing -[=====================================>] 99\% Summarizing +If the progression updates have messages, they will appear like:\if{html}{\out{
}}\preformatted{- [-----------------------------------------] 0\% Starting +\\ [===========>----------------------------] 30\% Importing +| [=====================================>] 99\% Summarizing }\if{html}{\out{
}} } From 423965aeafa864a71f15f51f1f97b6943d66b091 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 4 Dec 2020 23:24:36 -0800 Subject: [PATCH 61/94] Refresh README + vignette [ci skip] --- OVERVIEW.md | 49 ++++++++++++++++++++---------------- R/handler_debug.R | 13 +++++++--- README.md | 49 ++++++++++++++++++++---------------- man/handler_debug.Rd | 4 +++ vignettes/progressr-intro.md | 49 ++++++++++++++++++++---------------- 5 files changed, 98 insertions(+), 66 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 4cca32e..641744e 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -72,7 +72,7 @@ handlers("progress") This progress handler will present itself as: ```r > with_progress(y <- slow_sum(1:10)) -[=================>---------------------------] 40% Added 4 +/ [================>--------------------------] 40% Added 4 ``` To set the default progress handler(s) in all your R sessions, call `progressr::handlers(...)` in your ~/.Rprofile file. @@ -173,7 +173,7 @@ and > with_progress(y <- slow_sum(1:30)) Step 5 Step 10 -[================>---------------------------] 43% Added 13 +/ [===============>--------------------------] 43% Added 13 ``` @@ -201,7 +201,7 @@ we will get: > with_progress(y <- slow_sqrt(1:8)) Calculating the square root of 1 Calculating the square root of 2 -[===========>-------------------------------------] 25% x=2 +- [===========>-----------------------------------] 25% x=2 ``` This works because `with_progress()` will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. @@ -320,7 +320,7 @@ with_progress({ sqrt(x) }) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` @@ -346,7 +346,7 @@ with_progress({ sqrt(x) } }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` @@ -371,7 +371,7 @@ with_progress({ sqrt(x) }) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` _Note:_ This solution does not involved the `.progress = TRUE` argument that **furrr** implements. Because **progressr** is more generic and because `.progress = TRUE` only works for certain future backends and produces errors on others, I recommended to stop using `.progress = TRUE` and use the **progressr** package instead. @@ -400,7 +400,7 @@ with_progress({ sqrt(x) }, .parallel = TRUE) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` _Note:_ Although **progressr** implements support for using `.progress = "progressr"` with **plyr**, unfortunately, this will _not_ work when using `.parallel = TRUE`. This is because **plyr** resets `.progress` to the default `"none"` internally regardless how we set `.progress`. See for details and a hack that works around this limitation. @@ -496,20 +496,27 @@ _Figure: Sequence diagram illustrating how signaled progression conditions are c To debug progress updates, use: ```r > handlers("debug") -> with_progress(y <- slow_sum(1:10)) -[13:33:49.743] (0.000s => +0.002s) initiate: 0/10 (+0) '' {clear=TRUE, enabled=TRUE, status=} -[13:33:49.847] (0.104s => +0.001s) update: 1/10 (+1) 'Added 1' {clear=TRUE, enabled=TRUE, status=} -[13:33:49.950] (0.206s => +0.001s) update: 2/10 (+1) 'Added 2' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.052] (0.309s => +0.000s) update: 3/10 (+1) 'Added 3' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.154] (0.411s => +0.001s) update: 4/10 (+1) 'Added 4' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.257] (0.514s => +0.001s) update: 5/10 (+1) 'Added 5' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.361] (0.618s => +0.002s) update: 6/10 (+1) 'Added 6' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.464] (0.721s => +0.001s) update: 7/10 (+1) 'Added 7' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.567] (0.824s => +0.001s) update: 8/10 (+1) 'Added 8' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.670] (0.927s => +0.001s) update: 9/10 (+1) 'Added 9' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.773] (1.030s => +0.001s) update: 10/10 (+1) 'Added 10' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.774] (1.031s => +0.003s) update: 10/10 (+0) 'Added 10' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.776] (1.033s => +0.001s) shutdown: 10/10 (+0) '' {clear=TRUE, enabled=TRUE, status=ok} +> with_progress(y <- slow_sum(1:3)) +[23:19:52.738] (0.000s => +0.002s) initiate: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:52.739] (0.001s => +0.000s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:52.942] (0.203s => +0.002s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.145] (0.407s => +0.001s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.348] (0.610s => +0.002s) update: 1/3 (+1) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +M: Added value 1 +[23:19:53.555] (0.817s => +0.004s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.758] (1.020s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.961] (1.223s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.165] (1.426s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.368] (1.630s => +0.001s) update: 2/3 (+1) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +M: Added value 2 +[23:19:54.574] (1.835s => +0.003s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.777] (2.039s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.980] (2.242s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.183] (2.445s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.387] (2.649s => +0.001s) update: 3/3 (+1) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.388] (2.650s => +0.003s) update: 3/3 (+0) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=} +M: Added value 3 +[23:19:55.795] (3.057s => +0.000s) shutdown: 3/3 (+0) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=ok} ``` diff --git a/R/handler_debug.R b/R/handler_debug.R index 0e743cb..086c700 100644 --- a/R/handler_debug.R +++ b/R/handler_debug.R @@ -2,6 +2,9 @@ #' #' @inheritParams make_progression_handler #' +#' @param uuid If TRUE, then the progressor UUID and the owner UUID are shown, +#' otherwise not (default). +#' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @example incl/handler_debug.R @@ -19,7 +22,7 @@ #' [21:27:16.246] (5.010s => +0.003s) update: 100/100 (+0) 'Summarizing' {clear=TRIE, enabled=TRUE, status=} #' ``` #' @export -handler_debug <- function(interval = getOption("progressr.interval", 0), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", ...) { +handler_debug <- function(interval = getOption("progressr.interval", 0), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", uuid = FALSE, ...) { reporter <- local({ t_init <- NULL @@ -29,8 +32,12 @@ handler_debug <- function(interval = getOption("progressr.interval", 0), intrusi 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, ""), progression$progressor_uuid, progression$owner_session_uuid) - msg <- do.call(sprintf, args = c(list("%s(%.3fs => +%.3fs) %s: %.0f/%.0f (%+g) '%s' {clear=%s, enabled=%s, status=%s, progressor=%s, owner=%s}"), entry)) + 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: %.0f/%.0f (%+g) '%s' {clear=%s, enabled=%s, status=%s}"), entry)) + if (uuid) { + msg <- sprintf("%s [progressor=%s, owner=%s]", msg, progression$progressor_uuid, progression$owner_session_uuid) + } message(msg) } diff --git a/README.md b/README.md index 359d396..fd8070c 100644 --- a/README.md +++ b/README.md @@ -77,7 +77,7 @@ handlers("progress") This progress handler will present itself as: ```r > with_progress(y <- slow_sum(1:10)) -[=================>---------------------------] 40% Added 4 +/ [================>--------------------------] 40% Added 4 ``` To set the default progress handler(s) in all your R sessions, call `progressr::handlers(...)` in your ~/.Rprofile file. @@ -178,7 +178,7 @@ and > with_progress(y <- slow_sum(1:30)) Step 5 Step 10 -[================>---------------------------] 43% Added 13 +/ [===============>--------------------------] 43% Added 13 ``` @@ -206,7 +206,7 @@ we will get: > with_progress(y <- slow_sqrt(1:8)) Calculating the square root of 1 Calculating the square root of 2 -[===========>-------------------------------------] 25% x=2 +- [===========>-----------------------------------] 25% x=2 ``` This works because `with_progress()` will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. @@ -325,7 +325,7 @@ with_progress({ sqrt(x) }) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` @@ -351,7 +351,7 @@ with_progress({ sqrt(x) } }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` @@ -376,7 +376,7 @@ with_progress({ sqrt(x) }) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` _Note:_ This solution does not involved the `.progress = TRUE` argument that **furrr** implements. Because **progressr** is more generic and because `.progress = TRUE` only works for certain future backends and produces errors on others, I recommended to stop using `.progress = TRUE` and use the **progressr** package instead. @@ -405,7 +405,7 @@ with_progress({ sqrt(x) }, .parallel = TRUE) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` _Note:_ Although **progressr** implements support for using `.progress = "progressr"` with **plyr**, unfortunately, this will _not_ work when using `.parallel = TRUE`. This is because **plyr** resets `.progress` to the default `"none"` internally regardless how we set `.progress`. See for details and a hack that works around this limitation. @@ -501,20 +501,27 @@ _Figure: Sequence diagram illustrating how signaled progression conditions are c To debug progress updates, use: ```r > handlers("debug") -> with_progress(y <- slow_sum(1:10)) -[13:33:49.743] (0.000s => +0.002s) initiate: 0/10 (+0) '' {clear=TRUE, enabled=TRUE, status=} -[13:33:49.847] (0.104s => +0.001s) update: 1/10 (+1) 'Added 1' {clear=TRUE, enabled=TRUE, status=} -[13:33:49.950] (0.206s => +0.001s) update: 2/10 (+1) 'Added 2' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.052] (0.309s => +0.000s) update: 3/10 (+1) 'Added 3' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.154] (0.411s => +0.001s) update: 4/10 (+1) 'Added 4' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.257] (0.514s => +0.001s) update: 5/10 (+1) 'Added 5' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.361] (0.618s => +0.002s) update: 6/10 (+1) 'Added 6' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.464] (0.721s => +0.001s) update: 7/10 (+1) 'Added 7' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.567] (0.824s => +0.001s) update: 8/10 (+1) 'Added 8' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.670] (0.927s => +0.001s) update: 9/10 (+1) 'Added 9' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.773] (1.030s => +0.001s) update: 10/10 (+1) 'Added 10' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.774] (1.031s => +0.003s) update: 10/10 (+0) 'Added 10' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.776] (1.033s => +0.001s) shutdown: 10/10 (+0) '' {clear=TRUE, enabled=TRUE, status=ok} +> with_progress(y <- slow_sum(1:3)) +[23:19:52.738] (0.000s => +0.002s) initiate: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:52.739] (0.001s => +0.000s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:52.942] (0.203s => +0.002s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.145] (0.407s => +0.001s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.348] (0.610s => +0.002s) update: 1/3 (+1) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +M: Added value 1 +[23:19:53.555] (0.817s => +0.004s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.758] (1.020s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.961] (1.223s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.165] (1.426s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.368] (1.630s => +0.001s) update: 2/3 (+1) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +M: Added value 2 +[23:19:54.574] (1.835s => +0.003s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.777] (2.039s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.980] (2.242s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.183] (2.445s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.387] (2.649s => +0.001s) update: 3/3 (+1) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.388] (2.650s => +0.003s) update: 3/3 (+0) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=} +M: Added value 3 +[23:19:55.795] (3.057s => +0.000s) shutdown: 3/3 (+0) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=ok} ``` diff --git a/man/handler_debug.Rd b/man/handler_debug.Rd index 3065ec9..91d6938 100644 --- a/man/handler_debug.Rd +++ b/man/handler_debug.Rd @@ -8,6 +8,7 @@ handler_debug( interval = getOption("progressr.interval", 0), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", + uuid = FALSE, ... ) } @@ -21,6 +22,9 @@ successive progression updates from this handler.} \item{target}{(character vector) Specifies where progression updates are rendered.} +\item{uuid}{If TRUE, then the progressor UUID and the owner UUID are shown, +otherwise not (default).} + \item{\ldots}{Additional arguments passed to \code{\link[=make_progression_handler]{make_progression_handler()}}.} } \description{ diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index 8e02872..e8515ee 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -81,7 +81,7 @@ handlers("progress") This progress handler will present itself as: ```r > with_progress(y <- slow_sum(1:10)) -[=================>---------------------------] 40% Added 4 +/ [================>--------------------------] 40% Added 4 ``` To set the default progress handler(s) in all your R sessions, call `progressr::handlers(...)` in your ~/.Rprofile file. @@ -182,7 +182,7 @@ and > with_progress(y <- slow_sum(1:30)) Step 5 Step 10 -[================>---------------------------] 43% Added 13 +/ [===============>--------------------------] 43% Added 13 ``` @@ -210,7 +210,7 @@ we will get: > with_progress(y <- slow_sqrt(1:8)) Calculating the square root of 1 Calculating the square root of 2 -[===========>-------------------------------------] 25% x=2 +- [===========>-----------------------------------] 25% x=2 ``` This works because `with_progress()` will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. @@ -329,7 +329,7 @@ with_progress({ sqrt(x) }) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` @@ -355,7 +355,7 @@ with_progress({ sqrt(x) } }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` @@ -380,7 +380,7 @@ with_progress({ sqrt(x) }) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` _Note:_ This solution does not involved the `.progress = TRUE` argument that **furrr** implements. Because **progressr** is more generic and because `.progress = TRUE` only works for certain future backends and produces errors on others, I recommended to stop using `.progress = TRUE` and use the **progressr** package instead. @@ -409,7 +409,7 @@ with_progress({ sqrt(x) }, .parallel = TRUE) }) -# [=================>------------------------------] 40% x=2 +# / [================>-----------------------------] 40% x=2 ``` _Note:_ Although **progressr** implements support for using `.progress = "progressr"` with **plyr**, unfortunately, this will _not_ work when using `.parallel = TRUE`. This is because **plyr** resets `.progress` to the default `"none"` internally regardless how we set `.progress`. See for details and a hack that works around this limitation. @@ -505,20 +505,27 @@ _Figure: Sequence diagram illustrating how signaled progression conditions are c To debug progress updates, use: ```r > handlers("debug") -> with_progress(y <- slow_sum(1:10)) -[13:33:49.743] (0.000s => +0.002s) initiate: 0/10 (+0) '' {clear=TRUE, enabled=TRUE, status=} -[13:33:49.847] (0.104s => +0.001s) update: 1/10 (+1) 'Added 1' {clear=TRUE, enabled=TRUE, status=} -[13:33:49.950] (0.206s => +0.001s) update: 2/10 (+1) 'Added 2' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.052] (0.309s => +0.000s) update: 3/10 (+1) 'Added 3' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.154] (0.411s => +0.001s) update: 4/10 (+1) 'Added 4' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.257] (0.514s => +0.001s) update: 5/10 (+1) 'Added 5' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.361] (0.618s => +0.002s) update: 6/10 (+1) 'Added 6' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.464] (0.721s => +0.001s) update: 7/10 (+1) 'Added 7' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.567] (0.824s => +0.001s) update: 8/10 (+1) 'Added 8' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.670] (0.927s => +0.001s) update: 9/10 (+1) 'Added 9' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.773] (1.030s => +0.001s) update: 10/10 (+1) 'Added 10' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.774] (1.031s => +0.003s) update: 10/10 (+0) 'Added 10' {clear=TRUE, enabled=TRUE, status=} -[13:33:50.776] (1.033s => +0.001s) shutdown: 10/10 (+0) '' {clear=TRUE, enabled=TRUE, status=ok} +> with_progress(y <- slow_sum(1:3)) +[23:19:52.738] (0.000s => +0.002s) initiate: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:52.739] (0.001s => +0.000s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:52.942] (0.203s => +0.002s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.145] (0.407s => +0.001s) update: 0/3 (+0) '' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.348] (0.610s => +0.002s) update: 1/3 (+1) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +M: Added value 1 +[23:19:53.555] (0.817s => +0.004s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.758] (1.020s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:53.961] (1.223s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.165] (1.426s => +0.001s) update: 1/3 (+0) 'P: Adding 1' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.368] (1.630s => +0.001s) update: 2/3 (+1) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +M: Added value 2 +[23:19:54.574] (1.835s => +0.003s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.777] (2.039s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:54.980] (2.242s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.183] (2.445s => +0.001s) update: 2/3 (+0) 'P: Adding 2' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.387] (2.649s => +0.001s) update: 3/3 (+1) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=} +[23:19:55.388] (2.650s => +0.003s) update: 3/3 (+0) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=} +M: Added value 3 +[23:19:55.795] (3.057s => +0.000s) shutdown: 3/3 (+0) 'P: Adding 3' {clear=TRUE, enabled=TRUE, status=ok} ``` From b720a16c93b4668018c3323d65ee15066d39ea14 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 15:19:36 -0800 Subject: [PATCH 62/94] progressor() gained argument 'message' to set the default message --- NEWS | 5 ++++- R/progressor.R | 24 ++++++++++++++++++++---- man/progressor.Rd | 4 ++++ tests/progressor.R | 6 +++++- 4 files changed, 33 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index c51c318..0f08e56 100644 --- a/NEWS +++ b/NEWS @@ -1,7 +1,7 @@ Package: progressr ================== -Version: 0.6.0-9000 [2020-12-04] +Version: 0.6.0-9000 [2020-12-05] SIGNIFICANT CHANGES: @@ -17,6 +17,9 @@ SIGNIFICANT CHANGES: NEW FEATURES: + * progressor() gained argument 'message' to set the default message of all + progression updates, unless otherwise specified. + * progressor() gained argument 'on_exit = TRUE'. * Now the 'progress' handler shows also a spinner by default. diff --git a/R/progressor.R b/R/progressor.R index 5058426..7f8e808 100644 --- a/R/progressor.R +++ b/R/progressor.R @@ -12,6 +12,9 @@ #' number of `steps` as input and returns another finite and non-negative #' number of steps. #' +#' @param message (character) The default progress message used in all +#' progression updated, unless otherwise specified. +#' #' @param label (character) A label. #' #' @param initiate (logical) If TRUE, the progressor will signal a @@ -30,14 +33,16 @@ progressor <- local({ progressor_count <- 0L - function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), envir = parent.frame()) { + function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), envir = parent.frame()) { stop_if_not(!is.null(steps) || !is.null(along)) stop_if_not(length(steps) == 1L, is.numeric(steps), !is.na(steps), steps >= 0) stop_if_not(length(offset) == 1L, is.numeric(offset), !is.na(offset)) stop_if_not(length(scale) == 1L, is.numeric(scale), !is.na(scale)) stop_if_not(is.function(transform)) - + + message <- as.character(message) + label <- as.character(label) stop_if_not(length(label) == 1L) @@ -61,17 +66,25 @@ progressor <- local({ progressor_uuid <- progressor_uuid(progressor_count) progression_index <- 0L - fcn <- function(..., type = "update") { + fcn <- function(message = character(0L), ..., type = "update") { progression_index <<- progression_index + 1L progress(type = type, + message = message, ..., progressor_uuid = progressor_uuid, progression_index = progression_index, owner_session_uuid = owner_session_uuid) } + formals(fcn)$message <- message class(fcn) <- c("progressor", class(fcn)) - if (initiate) fcn(type = "initiate", steps = steps, auto_finish = auto_finish) + if (initiate) { + fcn( + type = "initiate", + steps = steps, + auto_finish = auto_finish + ) + } ## Add on.exit(...progressor(type = "finish")) if (on_exit) { @@ -98,6 +111,9 @@ print.progressor <- function(x, ...) { s <- c(s, paste("- initiate:", e$initiate)) s <- c(s, paste("- auto_finish:", e$auto_finish)) + s <- c(s, paste("- default message:", + paste(sQuote(e$message), collapse = ", "))) + s <- c(s, paste("- progressor_uuid:", e$progressor_uuid)) s <- c(s, paste("- progressor_count:", pe$progressor_count)) s <- c(s, paste("- progression_index:", e$progression_index)) diff --git a/man/progressor.Rd b/man/progressor.Rd index 9066d59..c7daf89 100644 --- a/man/progressor.Rd +++ b/man/progressor.Rd @@ -10,6 +10,7 @@ progressor( offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, + message = character(0L), label = NA_character_, initiate = TRUE, auto_finish = TRUE, @@ -30,6 +31,9 @@ progressor( number of \code{steps} as input and returns another finite and non-negative number of steps.} +\item{message}{(character) The default progress message used in all +progression updated, unless otherwise specified.} + \item{label}{(character) A label.} \item{initiate}{(logical) If TRUE, the progressor will signal a diff --git a/tests/progressor.R b/tests/progressor.R index a63b634..b716e33 100644 --- a/tests/progressor.R +++ b/tests/progressor.R @@ -5,11 +5,15 @@ message("progressor() ...") local({ p <- progressor(3L) print(p) + p() + p("A message") }) local({ - p <- progressor(along = 1:3) + p <- progressor(along = 1:3, message = "A default message") print(p) + p() + p("A message") }) message("progressor() ... DONE") From 61e966974aa5abcf7fc3105679a76fae415a8a80 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 15:39:43 -0800 Subject: [PATCH 63/94] progressor() gained arguments 'calls = sys.calls()' and 'frames = sys.frames()' --- R/progressor.R | 13 +++++++++++-- man/progressor.Rd | 4 ++++ 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/R/progressor.R b/R/progressor.R index 7f8e808..6901583 100644 --- a/R/progressor.R +++ b/R/progressor.R @@ -15,6 +15,8 @@ #' @param message (character) The default progress message used in all #' progression updated, unless otherwise specified. #' +#' @param calls,frames (pairlist) All active calls and the corresponding frames. +#' #' @param label (character) A label. #' #' @param initiate (logical) If TRUE, the progressor will signal a @@ -33,7 +35,7 @@ progressor <- local({ progressor_count <- 0L - function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), envir = parent.frame()) { + function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), calls = sys.calls(), frames = sys.frames(), label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), envir = parent.frame()) { stop_if_not(!is.null(steps) || !is.null(along)) stop_if_not(length(steps) == 1L, is.numeric(steps), !is.na(steps), steps >= 0) @@ -66,16 +68,20 @@ progressor <- local({ progressor_uuid <- progressor_uuid(progressor_count) progression_index <- 0L - fcn <- function(message = character(0L), ..., type = "update") { + fcn <- function(message = character(0L), ..., calls = sys.calls(), frames = sys.frames(), type = "update") { progression_index <<- progression_index + 1L progress(type = type, message = message, ..., + calls = calls, + frames = frames, progressor_uuid = progressor_uuid, progression_index = progression_index, owner_session_uuid = owner_session_uuid) } formals(fcn)$message <- message + formals(fcn)$calls <- calls + formals(fcn)$frames <- frames class(fcn) <- c("progressor", class(fcn)) if (initiate) { @@ -114,6 +120,9 @@ print.progressor <- function(x, ...) { s <- c(s, paste("- default message:", paste(sQuote(e$message), collapse = ", "))) + call <- vapply(e$calls, FUN = function(call) deparse(call[1]), FUN.VALUE = "") + s <- c(s, paste("- call stack:", paste(call, collapse = " -> "))) + s <- c(s, paste("- progressor_uuid:", e$progressor_uuid)) s <- c(s, paste("- progressor_count:", pe$progressor_count)) s <- c(s, paste("- progression_index:", e$progression_index)) diff --git a/man/progressor.Rd b/man/progressor.Rd index c7daf89..7d96780 100644 --- a/man/progressor.Rd +++ b/man/progressor.Rd @@ -11,6 +11,8 @@ progressor( scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), + calls = sys.calls(), + frames = sys.frames(), label = NA_character_, initiate = TRUE, auto_finish = TRUE, @@ -34,6 +36,8 @@ number of steps.} \item{message}{(character) The default progress message used in all progression updated, unless otherwise specified.} +\item{calls, frames}{(pairlist) All active calls and the corresponding frames.} + \item{label}{(character) A label.} \item{initiate}{(logical) If TRUE, the progressor will signal a From 6ee8e8d237d4da2dea1c04da8171a77d5a587822 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 16:41:24 -0800 Subject: [PATCH 64/94] Now progression 'message':s can also be a function --- NAMESPACE | 1 + NEWS | 10 +++++++++- R/progression.R | 29 +++++++++++++++++++++++++---- R/progressor.R | 25 ++++++++++--------------- inst/WORDLIST | 1 + man/progression.Rd | 11 ++++++++++- man/progressor.Rd | 11 +++++------ 7 files changed, 61 insertions(+), 27 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0c4c807..c11d908 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(conditionMessage,progression) S3method(print,progression) S3method(print,progression_handler) S3method(print,progressor) diff --git a/NEWS b/NEWS index 0f08e56..f5217a8 100644 --- a/NEWS +++ b/NEWS @@ -5,7 +5,7 @@ Version: 0.6.0-9000 [2020-12-05] SIGNIFICANT CHANGES: - * The user can how use handlers(globals = TRUE) to enable progress reports + * The user can how use handlers(global = TRUE) to enable progress reports everywhere without having to use with_progress(). This works on in R (>= 4.0.0) because it relies on global calling handlers. @@ -17,6 +17,14 @@ SIGNIFICANT CHANGES: NEW FEATURES: + * The progression message can now be created dynamically based on the + information in the 'progression' condition. Specifically, if 'message' is + a function, then that function will called with the 'progression' condition + as the first argument. This function should return a character string. + Importantly, it is only when the progression handler receives the + progression update and calls conditionMessage(p) on it that this function + is called. + * progressor() gained argument 'message' to set the default message of all progression updates, unless otherwise specified. diff --git a/R/progression.R b/R/progression.R index 4591b86..495b99d 100644 --- a/R/progression.R +++ b/R/progression.R @@ -2,7 +2,11 @@ #' #' A progression condition represents a progress in an \R program. #' -#' @param message (character) A progress message. +#' @param message (character vector or a function) If a character vector, then +#' it is pasted together into a single string using an empty separator. +#' If a function, then the message is constructed by `conditionMessage(p)` +#' calling this function with the progression condition `p` itself as the +#' first argument. #' #' @param amount (numeric) The total amount of progress made. #' @@ -30,6 +34,9 @@ #' #' @param call (expression) A call expression. #' +#' @param calls,frames (pairlist) The calls and the corresponding frames +#' that lead up to this progression update. +#' #' @return A [base::condition] of class `progression`. #' #' @seealso @@ -38,8 +45,7 @@ #' #' @keywords internal #' @export -progression <- function(message = character(0L), amount = 1.0, step = NULL, time = progression_time, ..., type = "update", class = NULL, progressor_uuid = NULL, progression_index = NULL, progression_time = Sys.time(), call = NULL, owner_session_uuid = NULL) { - message <- as.character(message) +progression <- function(message = character(0L), amount = 1.0, step = NULL, time = progression_time, ..., type = "update", class = NULL, progressor_uuid = NULL, progression_index = NULL, progression_time = Sys.time(), call = NULL, calls = sys.calls(), frames = sys.frames(), owner_session_uuid = NULL) { amount <- as.numeric(amount) time <- as.POSIXct(time) stop_if_not(is.character(type), length(type) == 1L, !is.na(type)) @@ -69,13 +75,28 @@ progression <- function(message = character(0L), amount = 1.0, step = NULL, time step = step, time = time, ..., - call = call + call = call, + calls = calls, + frames = frames ), class = c(class, "progression", "immediateCondition", "condition") ) } +#' @export +conditionMessage.progression <- function(c) { + message <- NextMethod("conditionMessage") ## == c$message + + ## Dynamically generate message from the 'progression' condition? + if (is.function(message)) { + message_fcn <- message + message <- message_fcn(c) + } + + paste(as.character(message), collapse = "") +} + #' @export print.progression <- function(x, ...) { diff --git a/R/progressor.R b/R/progressor.R index 6901583..4d387b5 100644 --- a/R/progressor.R +++ b/R/progressor.R @@ -1,5 +1,7 @@ #' Create a Progressor Function that Signals Progress Updates #' +#' @inheritParams progression +#' #' @param steps (integer) Number of progressing steps. #' #' @param along (vector; alternative) Alternative that sets @@ -12,11 +14,6 @@ #' number of `steps` as input and returns another finite and non-negative #' number of steps. #' -#' @param message (character) The default progress message used in all -#' progression updated, unless otherwise specified. -#' -#' @param calls,frames (pairlist) All active calls and the corresponding frames. -#' #' @param label (character) A label. #' #' @param initiate (logical) If TRUE, the progressor will signal a @@ -35,7 +32,7 @@ progressor <- local({ progressor_count <- 0L - function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), calls = sys.calls(), frames = sys.frames(), label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), envir = parent.frame()) { + function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), envir = parent.frame()) { stop_if_not(!is.null(steps) || !is.null(along)) stop_if_not(length(steps) == 1L, is.numeric(steps), !is.na(steps), steps >= 0) @@ -43,8 +40,6 @@ progressor <- local({ stop_if_not(length(scale) == 1L, is.numeric(scale), !is.na(scale)) stop_if_not(is.function(transform)) - message <- as.character(message) - label <- as.character(label) stop_if_not(length(label) == 1L) @@ -68,20 +63,16 @@ progressor <- local({ progressor_uuid <- progressor_uuid(progressor_count) progression_index <- 0L - fcn <- function(message = character(0L), ..., calls = sys.calls(), frames = sys.frames(), type = "update") { + fcn <- function(message = character(0L), ..., type = "update") { progression_index <<- progression_index + 1L progress(type = type, message = message, ..., - calls = calls, - frames = frames, progressor_uuid = progressor_uuid, progression_index = progression_index, owner_session_uuid = owner_session_uuid) } formals(fcn)$message <- message - formals(fcn)$calls <- calls - formals(fcn)$frames <- frames class(fcn) <- c("progressor", class(fcn)) if (initiate) { @@ -117,8 +108,12 @@ print.progressor <- function(x, ...) { s <- c(s, paste("- initiate:", e$initiate)) s <- c(s, paste("- auto_finish:", e$auto_finish)) - s <- c(s, paste("- default message:", - paste(sQuote(e$message), collapse = ", "))) + if (is.function(e$message)) { + message <- "" + } else { + message <- hpaste(deparse(e$message)) + } + s <- c(s, paste("- default message:", message)) call <- vapply(e$calls, FUN = function(call) deparse(call[1]), FUN.VALUE = "") s <- c(s, paste("- call stack:", paste(call, collapse = " -> "))) diff --git a/inst/WORDLIST b/inst/WORDLIST index fdd32f4..4328cc0 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -61,3 +61,4 @@ winprogressbar withProgressShiny withRestart pbcol +conditionMessage diff --git a/man/progression.Rd b/man/progression.Rd index 198ff26..3042a7f 100644 --- a/man/progression.Rd +++ b/man/progression.Rd @@ -16,11 +16,17 @@ progression( progression_index = NULL, progression_time = Sys.time(), call = NULL, + calls = sys.calls(), + frames = sys.frames(), owner_session_uuid = NULL ) } \arguments{ -\item{message}{(character) A progress message.} +\item{message}{(character vector or a function) If a character vector, then +it is pasted together into a single string using an empty separator. +If a function, then the message is constructed by \code{conditionMessage(p)} +calling this function with the progression condition \code{p} itself as the +first argument.} \item{amount}{(numeric) The total amount of progress made.} @@ -43,6 +49,9 @@ when the progression condition was created.} \item{call}{(expression) A call expression.} +\item{calls, frames}{(pairlist) The calls and the corresponding frames +that lead up to this progression update.} + \item{owner_session_uuid}{(character string) A character string that is unique for the \R session where the progressor was created.} diff --git a/man/progressor.Rd b/man/progressor.Rd index 7d96780..771b97b 100644 --- a/man/progressor.Rd +++ b/man/progressor.Rd @@ -11,8 +11,6 @@ progressor( scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), - calls = sys.calls(), - frames = sys.frames(), label = NA_character_, initiate = TRUE, auto_finish = TRUE, @@ -33,10 +31,11 @@ progressor( number of \code{steps} as input and returns another finite and non-negative number of steps.} -\item{message}{(character) The default progress message used in all -progression updated, unless otherwise specified.} - -\item{calls, frames}{(pairlist) All active calls and the corresponding frames.} +\item{message}{(character vector or a function) If a character vector, then +it is pasted together into a single string using an empty separator. +If a function, then the message is constructed by \code{conditionMessage(p)} +calling this function with the progression condition \code{p} itself as the +first argument.} \item{label}{(character) A label.} From ad21f7bdb68d6c57101681c1d3761b87ebaf7e4d Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 16:42:27 -0800 Subject: [PATCH 65/94] DEMO: Suggest 'multisession' since 'multiprocess' is now deprecated --- demo/mandelbrot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/demo/mandelbrot.R b/demo/mandelbrot.R index 581c9fa..4ae09a8 100644 --- a/demo/mandelbrot.R +++ b/demo/mandelbrot.R @@ -104,4 +104,4 @@ with_progress({ close.screen() -message("SUGGESTION: Try to rerun this demo after changing strategy for how futures are resolved, e.g. plan(multiprocess).\n") +message("SUGGESTION: Try to rerun this demo after changing strategy for how futures are resolved, e.g. plan(multisession).\n") From 93c468a953ffded11e8f276420a4f2a8316f02c5 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 16:54:41 -0800 Subject: [PATCH 66/94] Oh ... it's gonna be expensive to record sys.frames() in every 'progression' condition, especially if the condition objects is serialized during communication of parallel processing; so, dropping 'frames = sys.frames()' again --- R/progression.R | 8 +++----- man/progression.Rd | 4 +--- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/R/progression.R b/R/progression.R index 495b99d..442e9a7 100644 --- a/R/progression.R +++ b/R/progression.R @@ -34,8 +34,7 @@ #' #' @param call (expression) A call expression. #' -#' @param calls,frames (pairlist) The calls and the corresponding frames -#' that lead up to this progression update. +#' @param calls (pairlist) The calls that lead up to this progression update. #' #' @return A [base::condition] of class `progression`. #' @@ -45,7 +44,7 @@ #' #' @keywords internal #' @export -progression <- function(message = character(0L), amount = 1.0, step = NULL, time = progression_time, ..., type = "update", class = NULL, progressor_uuid = NULL, progression_index = NULL, progression_time = Sys.time(), call = NULL, calls = sys.calls(), frames = sys.frames(), owner_session_uuid = NULL) { +progression <- function(message = character(0L), amount = 1.0, step = NULL, time = progression_time, ..., type = "update", class = NULL, progressor_uuid = NULL, progression_index = NULL, progression_time = Sys.time(), call = NULL, calls = sys.calls(), owner_session_uuid = NULL) { amount <- as.numeric(amount) time <- as.POSIXct(time) stop_if_not(is.character(type), length(type) == 1L, !is.na(type)) @@ -76,8 +75,7 @@ progression <- function(message = character(0L), amount = 1.0, step = NULL, time time = time, ..., call = call, - calls = calls, - frames = frames + calls = calls ), class = c(class, "progression", "immediateCondition", "condition") ) diff --git a/man/progression.Rd b/man/progression.Rd index 3042a7f..733f6d4 100644 --- a/man/progression.Rd +++ b/man/progression.Rd @@ -17,7 +17,6 @@ progression( progression_time = Sys.time(), call = NULL, calls = sys.calls(), - frames = sys.frames(), owner_session_uuid = NULL ) } @@ -49,8 +48,7 @@ when the progression condition was created.} \item{call}{(expression) A call expression.} -\item{calls, frames}{(pairlist) The calls and the corresponding frames -that lead up to this progression update.} +\item{calls}{(pairlist) The calls that lead up to this progression update.} \item{owner_session_uuid}{(character string) A character string that is unique for the \R session where the progressor was created.} From 34c4718e807a7e95f34aa1c6abe98683e08fe982 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 17:55:01 -0800 Subject: [PATCH 67/94] BUG FIX: the internal combined multi-handlers would not return 'finished' status --- R/global_progression_handler.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/global_progression_handler.R b/R/global_progression_handler.R index 63f0171..b20cbbd 100644 --- a/R/global_progression_handler.R +++ b/R/global_progression_handler.R @@ -423,10 +423,12 @@ delay_stdout <- function(delays, stdout_file) { make_calling_handler <- function(handlers) { if (length(handlers) > 1L) { calling_handler <- function(p) { + finished <- FALSE for (kk in seq_along(handlers)) { handler <- handlers[[kk]] - handler(p) + finished <- finished || handler(p) } + finished } } else { calling_handler <- handlers[[1]] From f7de855678684b6d7df80abe20af36e7be76c541 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 18:47:32 -0800 Subject: [PATCH 68/94] Update README / vignette with respect to global progression handler --- OVERVIEW.md | 221 +++++++++++++++++++++++++++-------- README.md | 221 +++++++++++++++++++++++++++-------- vignettes/progressr-intro.md | 221 +++++++++++++++++++++++++++-------- 3 files changed, 525 insertions(+), 138 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 641744e..51050fa 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -10,14 +10,68 @@ Design motto: > The developer is responsible for providing progress updates but it's only the end user who decides if, when, and how progress should be presented. No exceptions will be allowed. -## Two Minimal APIs +## Two Minimal APIs - One For Developers and One For End-Users + + + + + + + + + +
Developer's APIEnd-user's API
+

+1. Set up a progressor with a certain number of steps: +

+
+p <- progressor(nsteps)
+p <- progressor(along = x)
+
+ +

+2. Signal progress: +

+ +
+p()               # one-step progress
+p(amount = 0)     # "still alive"
+p("loading ...")  # pass on a message
+
+		 +

+1a. Subscribe to progress updates from everywhere: +

+ +
+handler(global = TRUE)
+
+y <- slow_sum(1:5)
+y <- slow_sum(6:10)
+
+ +

+1b. Subscribe to a specific expression: +

+ +
+with_progress({
+  y <- slow_sum(1:3)
+  y <- slow_sum(6:10)
+})
+
- | Developer's API | End-user's API | - |-------------------------------|-----------------------------| - | `p <- progressor(n)` | `with_progress(expr)` | - | `p <- progressor(along = x)` | `handlers(...)` | - | `p(msg, ...)` | | +

+2. Configure how progress is presented: +

+
+handlers("progress")
+handlers("txtprogressbar", "beepr")
+handlers("pbcol")
+handlers(handler_progress(show_after = 3.0))
+
+
## A simple example @@ -40,7 +94,7 @@ slow_sum <- function(x) { Note how there are _no_ arguments in the code that specifies how progress is presented. The only task for the developer is to decide on where in the code it makes sense to signal that progress has been made. As we will see next, it is up to the end user of this code to decide whether they want to receive progress updates or not, and, if so, in what format. -### Without reporting progress +### Without reporting on progress When calling this function as in: ```r @@ -52,15 +106,40 @@ When calling this function as in: it will behave as any function and there will be no progress updates displayed. -### Reporting progress +### Reporting on progress + +If we are only interested in progress for a particular call, we can do: -To get progress updates, we can call it as: ```r > library(progressr) > with_progress(y <- slow_sum(1:10)) |==================== | 40% ``` +However, if we want to report on progress from _every_ call, wrapping the calls in `with_progress()` might become too cumbersome. If so, we can enable the global progress handler: + +```r +> library(progressr) +> handlers(global = TRUE) +``` + +so that progress updates are reported on wherever signaled, e.g. + +```r +> y <- slow_sum(1:10) + |==================== | 40% +> y <- slow_sum(10:1) + |======================================== | 80% +``` + +This requires R 4.0.0 or newer. To disable this again, do: + +```r +> handlers(global = FALSE) +``` + +In the below examples, we will assume `handlers(global = TRUE)` is already set. + ## Customizing how progress is reported @@ -71,7 +150,7 @@ handlers("progress") ``` This progress handler will present itself as: ```r -> with_progress(y <- slow_sum(1:10)) +> y <- slow_sum(1:10) / [================>--------------------------] 40% Added 4 ``` @@ -88,7 +167,7 @@ handlers("beepr") ``` will present itself as sounds played at the beginning, while progressing, and at the end (using different **[beepr]** sounds). There will be _no_ output written to the terminal; ```r -> with_progress(y <- slow_sum(1:10)) +> y <- slow_sum(1:10) > y [1] 55 > @@ -160,7 +239,7 @@ slow_sum <- function(x) { we get ```r > handlers("txtprogressbar") -> with_progress(y <- slow_sum(1:30)) +> y <- slow_sum(1:30) Step 5 Step 10 |==================== | 43% @@ -170,7 +249,7 @@ and ```r > handlers("progress") -> with_progress(y <- slow_sum(1:30)) +> y <- slow_sum(1:30) Step 5 Step 10 / [===============>--------------------------] 43% Added 13 @@ -198,13 +277,13 @@ we will get: ```r > library(progressr) > handlers("progress") -> with_progress(y <- slow_sqrt(1:8)) +> y <- slow_sqrt(1:8) Calculating the square root of 1 Calculating the square root of 2 - [===========>-----------------------------------] 25% x=2 ``` -This works because `with_progress()` will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. +This works because **progressr** will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. _Comment_: When signaling a warning using `warning(msg, immediate. = TRUE)` the message is immediately outputted to the standard-error stream. However, this is not possible to emulate when warnings are intercepted using calling handlers, which are used by `with_progress()`. This is a limitation of R that cannot be worked around. Because of this, the above call will behave the same as `warning(msg)` - that is, all warnings will be buffered by R internally and released only when all computations are done. @@ -220,9 +299,7 @@ Note that progression updates by **progressr** is designed to work out of the bo ```r library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- lapply(xs, function(x) { Sys.sleep(0.1) @@ -230,25 +307,28 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` + ### The foreach package ```r library(foreach) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- foreach(x = xs) %do% { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) } -}) +} + +my_fcn(1:5) # |==================== | 40% ``` @@ -258,9 +338,7 @@ with_progress({ library(purrr) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- map(xs, function(x) { Sys.sleep(0.1) @@ -268,6 +346,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` @@ -278,9 +358,7 @@ with_progress({ library(plyr) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(0.1) @@ -288,6 +366,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` @@ -310,9 +390,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_lapply(xs, function(x, ...) { Sys.sleep(6.0-x) @@ -320,6 +398,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -336,9 +416,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- foreach(x = xs) %dopar% { Sys.sleep(6.0-x) @@ -346,6 +424,8 @@ with_progress({ sqrt(x) } }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -361,9 +441,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_map(xs, function(x) { Sys.sleep(6.0-x) @@ -371,6 +449,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -390,9 +470,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(0.1) @@ -400,6 +478,8 @@ with_progress({ sqrt(x) }, .parallel = TRUE) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -443,7 +523,7 @@ The overhead of progress signaling may depend on context. For example, in paral ## Progress updates in non-interactive mode ("batch mode") When running R from the command line, R runs in a non-interactive mode -(`interactive()` returns `FALSE`). The default behavior of `with_progress()` +(`interactive()` returns `FALSE`). The default behavior of **progressr** is to _not_ report on progress in non-interactive mode. To reported on progress also then, set R options `progressr.enable` or environment variable `R_PROGRESSR_ENABLE` to `TRUE`. For example, @@ -464,19 +544,68 @@ will. Because this project is under active development, the progressr API is currently kept at a very minimum. This will allow for the framework and the API to evolve while minimizing the risk for breaking code that depends on it. The roadmap for developing the API is roughly: -1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` +* [x] Provide minimal API for producing progress updates, i.e. `progressor()`, `with_progress()`, `handlers()` + +* [x] Add support for global progress handlers removing the need for the user having to specify `with_progress()`, i.e. `handlers(global = TRUE)` and `handlers(global = FALSE)` -2. Add support for global progress handlers removing the need for the user having to specify `with_progress()` +* [ ] Make it possible to create a progressor also in the global environment (see 'Known issues' below) -3. Add support for nested progress updates +* [ ] Add support for nested progress updates -4. Add API to allow users and package developers to design additional progression handlers +* [ ] Add API to allow users and package developers to design additional progression handlers For a more up-to-date view on what features might be added, see . ## Appendix +### Known issues + +It is not possible to create a progressor in the global environment, e.g. in the the top-level of a script. It has to be created inside a function, within `with_progress({ ... })`, `local({ ... }), or a similar construct. For example, the following: + +```r +library(progressr) +handlers(global = TRUE) + +xs <- 1:5 +p <- progressor(along = xs) +y <- lapply(xs, function(x) { + Sys.sleep(0.1) + p(sprintf("x=%g", x)) + sqrt(x) +}) +``` + +results in an error if tried: + +``` +Error in progressor(along = xs) : + A progressor must not be created in the global environment unless wrapped in a with_progress() +or without_progress() call, otherwise make sure to created inside a function or in a local() +environment to make sure there is a finite life span of the progressor +``` + +The solution is to wrap it in a `local({ ... })` call, or more explicitly, in a `with_progress({ ... })` call: + +```r +library(progressr) +handlers(global = TRUE) + +xs <- 1:5 +with_progress({ + p <- progressor(along = xs) + y <- lapply(xs, function(x) { + Sys.sleep(0.1) + p(sprintf("x=%g", x)) + sqrt(x) + }) +}) +# |==================== | 40% +``` + +The main reason for this is to limit the life span of each progressor. If we created it in the global environment, there is a significant risk it would never finish and block all of the following progressors. + + ### Under the hood When using the **progressr** package, progression updates are communicated via R's condition framework, which provides methods for creating, signaling, capturing, muffling, and relaying conditions. Progression updates are of classes `progression` and `immediateCondition`(\*). The below figure gives an example how progression conditions are created, signaled, and rendered. @@ -488,7 +617,7 @@ When using the **progressr** package, progression updates are communicated via R ![](vignettes/imgs/slow_sum.svg) -_Figure: Sequence diagram illustrating how signaled progression conditions are captured by `with_progress()` and relayed to the two progression handlers 'progress' (a progress bar in the terminal) and 'beepr' (auditory) that the end user has chosen._ +_Figure: Sequence diagram illustrating how signaled progression conditions are captured by `with_progress()`, or the global progression handler, and relayed to the two progression handlers 'progress' (a progress bar in the terminal) and 'beepr' (auditory) that the end user has chosen._ ### Debugging diff --git a/README.md b/README.md index fd8070c..e0e34aa 100644 --- a/README.md +++ b/README.md @@ -15,14 +15,68 @@ Design motto: > The developer is responsible for providing progress updates but it's only the end user who decides if, when, and how progress should be presented. No exceptions will be allowed. -## Two Minimal APIs +## Two Minimal APIs - One For Developers and One For End-Users + + + + + + + + + +
Developer's APIEnd-user's API
+

+1. Set up a progressor with a certain number of steps: +

+
+p <- progressor(nsteps)
+p <- progressor(along = x)
+
+ +

+2. Signal progress: +

+ +
+p()               # one-step progress
+p(amount = 0)     # "still alive"
+p("loading ...")  # pass on a message
+
+		 +

+1a. Subscribe to progress updates from everywhere: +

+ +
+handler(global = TRUE)
+
+y <- slow_sum(1:5)
+y <- slow_sum(6:10)
+
+ +

+1b. Subscribe to a specific expression: +

+ +
+with_progress({
+  y <- slow_sum(1:3)
+  y <- slow_sum(6:10)
+})
+
- | Developer's API | End-user's API | - |-------------------------------|-----------------------------| - | `p <- progressor(n)` | `with_progress(expr)` | - | `p <- progressor(along = x)` | `handlers(...)` | - | `p(msg, ...)` | | +

+2. Configure how progress is presented: +

+
+handlers("progress")
+handlers("txtprogressbar", "beepr")
+handlers("pbcol")
+handlers(handler_progress(show_after = 3.0))
+
+
## A simple example @@ -45,7 +99,7 @@ slow_sum <- function(x) { Note how there are _no_ arguments in the code that specifies how progress is presented. The only task for the developer is to decide on where in the code it makes sense to signal that progress has been made. As we will see next, it is up to the end user of this code to decide whether they want to receive progress updates or not, and, if so, in what format. -### Without reporting progress +### Without reporting on progress When calling this function as in: ```r @@ -57,15 +111,40 @@ When calling this function as in: it will behave as any function and there will be no progress updates displayed. -### Reporting progress +### Reporting on progress + +If we are only interested in progress for a particular call, we can do: -To get progress updates, we can call it as: ```r > library(progressr) > with_progress(y <- slow_sum(1:10)) |==================== | 40% ``` +However, if we want to report on progress from _every_ call, wrapping the calls in `with_progress()` might become too cumbersome. If so, we can enable the global progress handler: + +```r +> library(progressr) +> handlers(global = TRUE) +``` + +so that progress updates are reported on wherever signaled, e.g. + +```r +> y <- slow_sum(1:10) + |==================== | 40% +> y <- slow_sum(10:1) + |======================================== | 80% +``` + +This requires R 4.0.0 or newer. To disable this again, do: + +```r +> handlers(global = FALSE) +``` + +In the below examples, we will assume `handlers(global = TRUE)` is already set. + ## Customizing how progress is reported @@ -76,7 +155,7 @@ handlers("progress") ``` This progress handler will present itself as: ```r -> with_progress(y <- slow_sum(1:10)) +> y <- slow_sum(1:10) / [================>--------------------------] 40% Added 4 ``` @@ -93,7 +172,7 @@ handlers("beepr") ``` will present itself as sounds played at the beginning, while progressing, and at the end (using different **[beepr]** sounds). There will be _no_ output written to the terminal; ```r -> with_progress(y <- slow_sum(1:10)) +> y <- slow_sum(1:10) > y [1] 55 > @@ -165,7 +244,7 @@ slow_sum <- function(x) { we get ```r > handlers("txtprogressbar") -> with_progress(y <- slow_sum(1:30)) +> y <- slow_sum(1:30) Step 5 Step 10 |==================== | 43% @@ -175,7 +254,7 @@ and ```r > handlers("progress") -> with_progress(y <- slow_sum(1:30)) +> y <- slow_sum(1:30) Step 5 Step 10 / [===============>--------------------------] 43% Added 13 @@ -203,13 +282,13 @@ we will get: ```r > library(progressr) > handlers("progress") -> with_progress(y <- slow_sqrt(1:8)) +> y <- slow_sqrt(1:8) Calculating the square root of 1 Calculating the square root of 2 - [===========>-----------------------------------] 25% x=2 ``` -This works because `with_progress()` will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. +This works because **progressr** will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. _Comment_: When signaling a warning using `warning(msg, immediate. = TRUE)` the message is immediately outputted to the standard-error stream. However, this is not possible to emulate when warnings are intercepted using calling handlers, which are used by `with_progress()`. This is a limitation of R that cannot be worked around. Because of this, the above call will behave the same as `warning(msg)` - that is, all warnings will be buffered by R internally and released only when all computations are done. @@ -225,9 +304,7 @@ Note that progression updates by **progressr** is designed to work out of the bo ```r library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- lapply(xs, function(x) { Sys.sleep(0.1) @@ -235,25 +312,28 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` + ### The foreach package ```r library(foreach) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- foreach(x = xs) %do% { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) } -}) +} + +my_fcn(1:5) # |==================== | 40% ``` @@ -263,9 +343,7 @@ with_progress({ library(purrr) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- map(xs, function(x) { Sys.sleep(0.1) @@ -273,6 +351,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` @@ -283,9 +363,7 @@ with_progress({ library(plyr) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(0.1) @@ -293,6 +371,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` @@ -315,9 +395,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_lapply(xs, function(x, ...) { Sys.sleep(6.0-x) @@ -325,6 +403,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -341,9 +421,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- foreach(x = xs) %dopar% { Sys.sleep(6.0-x) @@ -351,6 +429,8 @@ with_progress({ sqrt(x) } }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -366,9 +446,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_map(xs, function(x) { Sys.sleep(6.0-x) @@ -376,6 +454,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -395,9 +475,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(0.1) @@ -405,6 +483,8 @@ with_progress({ sqrt(x) }, .parallel = TRUE) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -448,7 +528,7 @@ The overhead of progress signaling may depend on context. For example, in paral ## Progress updates in non-interactive mode ("batch mode") When running R from the command line, R runs in a non-interactive mode -(`interactive()` returns `FALSE`). The default behavior of `with_progress()` +(`interactive()` returns `FALSE`). The default behavior of **progressr** is to _not_ report on progress in non-interactive mode. To reported on progress also then, set R options `progressr.enable` or environment variable `R_PROGRESSR_ENABLE` to `TRUE`. For example, @@ -469,19 +549,68 @@ will. Because this project is under active development, the progressr API is currently kept at a very minimum. This will allow for the framework and the API to evolve while minimizing the risk for breaking code that depends on it. The roadmap for developing the API is roughly: -1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` +* [x] Provide minimal API for producing progress updates, i.e. `progressor()`, `with_progress()`, `handlers()` + +* [x] Add support for global progress handlers removing the need for the user having to specify `with_progress()`, i.e. `handlers(global = TRUE)` and `handlers(global = FALSE)` -2. Add support for global progress handlers removing the need for the user having to specify `with_progress()` +* [ ] Make it possible to create a progressor also in the global environment (see 'Known issues' below) -3. Add support for nested progress updates +* [ ] Add support for nested progress updates -4. Add API to allow users and package developers to design additional progression handlers +* [ ] Add API to allow users and package developers to design additional progression handlers For a more up-to-date view on what features might be added, see . ## Appendix +### Known issues + +It is not possible to create a progressor in the global environment, e.g. in the the top-level of a script. It has to be created inside a function, within `with_progress({ ... })`, `local({ ... }), or a similar construct. For example, the following: + +```r +library(progressr) +handlers(global = TRUE) + +xs <- 1:5 +p <- progressor(along = xs) +y <- lapply(xs, function(x) { + Sys.sleep(0.1) + p(sprintf("x=%g", x)) + sqrt(x) +}) +``` + +results in an error if tried: + +``` +Error in progressor(along = xs) : + A progressor must not be created in the global environment unless wrapped in a with_progress() +or without_progress() call, otherwise make sure to created inside a function or in a local() +environment to make sure there is a finite life span of the progressor +``` + +The solution is to wrap it in a `local({ ... })` call, or more explicitly, in a `with_progress({ ... })` call: + +```r +library(progressr) +handlers(global = TRUE) + +xs <- 1:5 +with_progress({ + p <- progressor(along = xs) + y <- lapply(xs, function(x) { + Sys.sleep(0.1) + p(sprintf("x=%g", x)) + sqrt(x) + }) +}) +# |==================== | 40% +``` + +The main reason for this is to limit the life span of each progressor. If we created it in the global environment, there is a significant risk it would never finish and block all of the following progressors. + + ### Under the hood When using the **progressr** package, progression updates are communicated via R's condition framework, which provides methods for creating, signaling, capturing, muffling, and relaying conditions. Progression updates are of classes `progression` and `immediateCondition`(\*). The below figure gives an example how progression conditions are created, signaled, and rendered. @@ -493,7 +622,7 @@ When using the **progressr** package, progression updates are communicated via R ![](vignettes/imgs/slow_sum.svg) -_Figure: Sequence diagram illustrating how signaled progression conditions are captured by `with_progress()` and relayed to the two progression handlers 'progress' (a progress bar in the terminal) and 'beepr' (auditory) that the end user has chosen._ +_Figure: Sequence diagram illustrating how signaled progression conditions are captured by `with_progress()`, or the global progression handler, and relayed to the two progression handlers 'progress' (a progress bar in the terminal) and 'beepr' (auditory) that the end user has chosen._ ### Debugging diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index e8515ee..b7b28c6 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -19,14 +19,68 @@ Design motto: > The developer is responsible for providing progress updates but it's only the end user who decides if, when, and how progress should be presented. No exceptions will be allowed. -## Two Minimal APIs +## Two Minimal APIs - One For Developers and One For End-Users + + + + + + + + + +
Developer's APIEnd-user's API
+

+1. Set up a progressor with a certain number of steps: +

+
+p <- progressor(nsteps)
+p <- progressor(along = x)
+
+ +

+2. Signal progress: +

+ +
+p()               # one-step progress
+p(amount = 0)     # "still alive"
+p("loading ...")  # pass on a message
+
+		 +

+1a. Subscribe to progress updates from everywhere: +

+ +
+handler(global = TRUE)
+
+y <- slow_sum(1:5)
+y <- slow_sum(6:10)
+
+ +

+1b. Subscribe to a specific expression: +

+ +
+with_progress({
+  y <- slow_sum(1:3)
+  y <- slow_sum(6:10)
+})
+
- | Developer's API | End-user's API | - |-------------------------------|-----------------------------| - | `p <- progressor(n)` | `with_progress(expr)` | - | `p <- progressor(along = x)` | `handlers(...)` | - | `p(msg, ...)` | | +

+2. Configure how progress is presented: +

+
+handlers("progress")
+handlers("txtprogressbar", "beepr")
+handlers("pbcol")
+handlers(handler_progress(show_after = 3.0))
+
+
## A simple example @@ -49,7 +103,7 @@ slow_sum <- function(x) { Note how there are _no_ arguments in the code that specifies how progress is presented. The only task for the developer is to decide on where in the code it makes sense to signal that progress has been made. As we will see next, it is up to the end user of this code to decide whether they want to receive progress updates or not, and, if so, in what format. -### Without reporting progress +### Without reporting on progress When calling this function as in: ```r @@ -61,15 +115,40 @@ When calling this function as in: it will behave as any function and there will be no progress updates displayed. -### Reporting progress +### Reporting on progress + +If we are only interested in progress for a particular call, we can do: -To get progress updates, we can call it as: ```r > library(progressr) > with_progress(y <- slow_sum(1:10)) |==================== | 40% ``` +However, if we want to report on progress from _every_ call, wrapping the calls in `with_progress()` might become too cumbersome. If so, we can enable the global progress handler: + +```r +> library(progressr) +> handlers(global = TRUE) +``` + +so that progress updates are reported on wherever signaled, e.g. + +```r +> y <- slow_sum(1:10) + |==================== | 40% +> y <- slow_sum(10:1) + |======================================== | 80% +``` + +This requires R 4.0.0 or newer. To disable this again, do: + +```r +> handlers(global = FALSE) +``` + +In the below examples, we will assume `handlers(global = TRUE)` is already set. + ## Customizing how progress is reported @@ -80,7 +159,7 @@ handlers("progress") ``` This progress handler will present itself as: ```r -> with_progress(y <- slow_sum(1:10)) +> y <- slow_sum(1:10) / [================>--------------------------] 40% Added 4 ``` @@ -97,7 +176,7 @@ handlers("beepr") ``` will present itself as sounds played at the beginning, while progressing, and at the end (using different **[beepr]** sounds). There will be _no_ output written to the terminal; ```r -> with_progress(y <- slow_sum(1:10)) +> y <- slow_sum(1:10) > y [1] 55 > @@ -169,7 +248,7 @@ slow_sum <- function(x) { we get ```r > handlers("txtprogressbar") -> with_progress(y <- slow_sum(1:30)) +> y <- slow_sum(1:30) Step 5 Step 10 |==================== | 43% @@ -179,7 +258,7 @@ and ```r > handlers("progress") -> with_progress(y <- slow_sum(1:30)) +> y <- slow_sum(1:30) Step 5 Step 10 / [===============>--------------------------] 43% Added 13 @@ -207,13 +286,13 @@ we will get: ```r > library(progressr) > handlers("progress") -> with_progress(y <- slow_sqrt(1:8)) +> y <- slow_sqrt(1:8) Calculating the square root of 1 Calculating the square root of 2 - [===========>-----------------------------------] 25% x=2 ``` -This works because `with_progress()` will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. +This works because **progressr** will briefly buffer any output internally and only release it when the next progress update is received just before the progress is re-rendered in the terminal. This is why you see a two second delay when running the above example. Note that, if we use progress handlers that do not output to the terminal, such as `handlers("beepr")`, then output does not have to be buffered and will appear immediately. _Comment_: When signaling a warning using `warning(msg, immediate. = TRUE)` the message is immediately outputted to the standard-error stream. However, this is not possible to emulate when warnings are intercepted using calling handlers, which are used by `with_progress()`. This is a limitation of R that cannot be worked around. Because of this, the above call will behave the same as `warning(msg)` - that is, all warnings will be buffered by R internally and released only when all computations are done. @@ -229,9 +308,7 @@ Note that progression updates by **progressr** is designed to work out of the bo ```r library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- lapply(xs, function(x) { Sys.sleep(0.1) @@ -239,25 +316,28 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` + ### The foreach package ```r library(foreach) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- foreach(x = xs) %do% { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) } -}) +} + +my_fcn(1:5) # |==================== | 40% ``` @@ -267,9 +347,7 @@ with_progress({ library(purrr) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- map(xs, function(x) { Sys.sleep(0.1) @@ -277,6 +355,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` @@ -287,9 +367,7 @@ with_progress({ library(plyr) library(progressr) -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(0.1) @@ -297,6 +375,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # |==================== | 40% ``` @@ -319,9 +399,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_lapply(xs, function(x, ...) { Sys.sleep(6.0-x) @@ -329,6 +407,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -345,9 +425,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- foreach(x = xs) %dopar% { Sys.sleep(6.0-x) @@ -355,6 +433,8 @@ with_progress({ sqrt(x) } }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -370,9 +450,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_map(xs, function(x) { Sys.sleep(6.0-x) @@ -380,6 +458,8 @@ with_progress({ sqrt(x) }) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -399,9 +479,7 @@ plan(multisession) library(progressr) handlers("progress", "beepr") -xs <- 1:5 - -with_progress({ +my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(0.1) @@ -409,6 +487,8 @@ with_progress({ sqrt(x) }, .parallel = TRUE) }) + +my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` @@ -452,7 +532,7 @@ The overhead of progress signaling may depend on context. For example, in paral ## Progress updates in non-interactive mode ("batch mode") When running R from the command line, R runs in a non-interactive mode -(`interactive()` returns `FALSE`). The default behavior of `with_progress()` +(`interactive()` returns `FALSE`). The default behavior of **progressr** is to _not_ report on progress in non-interactive mode. To reported on progress also then, set R options `progressr.enable` or environment variable `R_PROGRESSR_ENABLE` to `TRUE`. For example, @@ -473,19 +553,68 @@ will. Because this project is under active development, the progressr API is currently kept at a very minimum. This will allow for the framework and the API to evolve while minimizing the risk for breaking code that depends on it. The roadmap for developing the API is roughly: -1. Provide minimal API for producing progress updates, i.e. `progressor()` and `with_progress()` +* [x] Provide minimal API for producing progress updates, i.e. `progressor()`, `with_progress()`, `handlers()` + +* [x] Add support for global progress handlers removing the need for the user having to specify `with_progress()`, i.e. `handlers(global = TRUE)` and `handlers(global = FALSE)` -2. Add support for global progress handlers removing the need for the user having to specify `with_progress()` +* [ ] Make it possible to create a progressor also in the global environment (see 'Known issues' below) -3. Add support for nested progress updates +* [ ] Add support for nested progress updates -4. Add API to allow users and package developers to design additional progression handlers +* [ ] Add API to allow users and package developers to design additional progression handlers For a more up-to-date view on what features might be added, see . ## Appendix +### Known issues + +It is not possible to create a progressor in the global environment, e.g. in the the top-level of a script. It has to be created inside a function, within `with_progress({ ... })`, `local({ ... }), or a similar construct. For example, the following: + +```r +library(progressr) +handlers(global = TRUE) + +xs <- 1:5 +p <- progressor(along = xs) +y <- lapply(xs, function(x) { + Sys.sleep(0.1) + p(sprintf("x=%g", x)) + sqrt(x) +}) +``` + +results in an error if tried: + +``` +Error in progressor(along = xs) : + A progressor must not be created in the global environment unless wrapped in a with_progress() +or without_progress() call, otherwise make sure to created inside a function or in a local() +environment to make sure there is a finite life span of the progressor +``` + +The solution is to wrap it in a `local({ ... })` call, or more explicitly, in a `with_progress({ ... })` call: + +```r +library(progressr) +handlers(global = TRUE) + +xs <- 1:5 +with_progress({ + p <- progressor(along = xs) + y <- lapply(xs, function(x) { + Sys.sleep(0.1) + p(sprintf("x=%g", x)) + sqrt(x) + }) +}) +# |==================== | 40% +``` + +The main reason for this is to limit the life span of each progressor. If we created it in the global environment, there is a significant risk it would never finish and block all of the following progressors. + + ### Under the hood When using the **progressr** package, progression updates are communicated via R's condition framework, which provides methods for creating, signaling, capturing, muffling, and relaying conditions. Progression updates are of classes `progression` and `immediateCondition`(\*). The below figure gives an example how progression conditions are created, signaled, and rendered. @@ -497,7 +626,7 @@ When using the **progressr** package, progression updates are communicated via R ![](imgs/slow_sum.svg) -_Figure: Sequence diagram illustrating how signaled progression conditions are captured by `with_progress()` and relayed to the two progression handlers 'progress' (a progress bar in the terminal) and 'beepr' (auditory) that the end user has chosen._ +_Figure: Sequence diagram illustrating how signaled progression conditions are captured by `with_progress()`, or the global progression handler, and relayed to the two progression handlers 'progress' (a progress bar in the terminal) and 'beepr' (auditory) that the end user has chosen._ ### Debugging From 501cbcbfe78cf088557bd03977969f563db1dfb3 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 18:57:20 -0800 Subject: [PATCH 69/94] better examples --- OVERVIEW.md | 4 ++-- README.md | 4 ++-- vignettes/progressr-intro.md | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 51050fa..e8cf099 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -67,8 +67,8 @@ with_progress({ 
 handlers("progress")
 handlers("txtprogressbar", "beepr")
-handlers("pbcol")
-handlers(handler_progress(show_after = 3.0))
+handlers(handler_pbcol(enable_after = 3.0))
+handlers(handler_progress(format = "[:bar] :percent eta: :eta"))
diff --git a/README.md b/README.md index e0e34aa..80d6cf3 100644 --- a/README.md +++ b/README.md @@ -72,8 +72,8 @@ with_progress({ 
 handlers("progress")
 handlers("txtprogressbar", "beepr")
-handlers("pbcol")
-handlers(handler_progress(show_after = 3.0))
+handlers(handler_pbcol(enable_after = 3.0))
+handlers(handler_progress(format = "[:bar] :percent eta: :eta"))
diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index b7b28c6..634daa6 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -76,8 +76,8 @@ with_progress({ 
 handlers("progress")
 handlers("txtprogressbar", "beepr")
-handlers("pbcol")
-handlers(handler_progress(show_after = 3.0))
+handlers(handler_pbcol(enable_after = 3.0))
+handlers(handler_progress(format = "[:bar] :percent eta: :eta"))
From fd40c385ddc17c6ec1a2d3517af455c5794ee52a Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 19:03:50 -0800 Subject: [PATCH 70/94] Allow for empty message again and make sure they're not erasing existing output [ci skip] --- R/progression.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/progression.R b/R/progression.R index 442e9a7..9e29e2a 100644 --- a/R/progression.R +++ b/R/progression.R @@ -91,8 +91,11 @@ conditionMessage.progression <- function(c) { message_fcn <- message message <- message_fcn(c) } + + message <- as.character(message) + if (length(message) > 0L) message <- paste(message, collapse = "") - paste(as.character(message), collapse = "") + message } From 44369744c3acb99f2a9d75469df628057153a20d Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sat, 5 Dec 2020 19:10:21 -0800 Subject: [PATCH 71/94] tweaks [ci skip] --- OVERVIEW.md | 6 ++++-- README.md | 6 ++++-- vignettes/progressr-intro.md | 6 ++++-- 3 files changed, 12 insertions(+), 6 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index e8cf099..9e121df 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -37,6 +37,8 @@ p("loading ...") # pass on a message +




+




1a. Subscribe to progress updates from everywhere: @@ -68,7 +70,7 @@ with_progress({ handlers("progress") handlers("txtprogressbar", "beepr") handlers(handler_pbcol(enable_after = 3.0)) -handlers(handler_progress(format = "[:bar] :percent eta: :eta")) +handlers(handler_progress(complete = "#")) @@ -561,7 +563,7 @@ For a more up-to-date view on what features might be added, see +




+




1a. Subscribe to progress updates from everywhere: @@ -73,7 +75,7 @@ with_progress({ handlers("progress") handlers("txtprogressbar", "beepr") handlers(handler_pbcol(enable_after = 3.0)) -handlers(handler_progress(format = "[:bar] :percent eta: :eta")) +handlers(handler_progress(complete = "#")) @@ -566,7 +568,7 @@ For a more up-to-date view on what features might be added, see +




+




1a. Subscribe to progress updates from everywhere: @@ -77,7 +79,7 @@ with_progress({ handlers("progress") handlers("txtprogressbar", "beepr") handlers(handler_pbcol(enable_after = 3.0)) -handlers(handler_progress(format = "[:bar] :percent eta: :eta")) +handlers(handler_progress(complete = "#")) @@ -570,7 +572,7 @@ For a more up-to-date view on what features might be added, see Date: Sat, 5 Dec 2020 21:42:34 -0800 Subject: [PATCH 72/94] Tidy up the API boxes [ci skip] --- OVERVIEW.md | 22 ++++++++++++++-------- R/progressr-package.R | 3 ++- README.md | 22 ++++++++++++++-------- man/progressr.Rd | 3 ++- vignettes/progressr-intro.md | 22 ++++++++++++++-------- 5 files changed, 46 insertions(+), 26 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 9e121df..8bf9d1e 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -12,10 +12,10 @@ Design motto: ## Two Minimal APIs - One For Developers and One For End-Users - - - - +
+
+
Developer's APIEnd-user's API
+ - -




-




+ +
Developer's API

@@ -36,9 +36,14 @@ p(amount = 0) # "still alive" p("loading ...") # pass on a message

+

+
    
+
+ + +
End-user's API

1a. Subscribe to progress updates from everywhere: @@ -74,7 +79,8 @@ handlers(handler_progress(complete = "#"))

- +
+
## A simple example diff --git a/R/progressr-package.R b/R/progressr-package.R index 04a0303..d5cda96 100644 --- a/R/progressr-package.R +++ b/R/progressr-package.R @@ -35,6 +35,7 @@ #' #' In the terminal: #' * [handler_txtprogressbar] (default) +#' * [handler_pbcol] #' * [handler_pbmcapply] #' * [handler_progress] #' * [handler_ascii_alert] @@ -44,7 +45,7 @@ #' * [handler_tkprogressbar] #' * [handler_winprogressbar] #' -#' Via audio: +#' As sound: #' * [handler_beepr] #' * [handler_ascii_alert] #' diff --git a/README.md b/README.md index 4eb70ab..63ecbfc 100644 --- a/README.md +++ b/README.md @@ -17,10 +17,10 @@ Design motto: ## Two Minimal APIs - One For Developers and One For End-Users - - - - +
+
+
Developer's APIEnd-user's API
+ - -




-




+ +
Developer's API

@@ -41,9 +41,14 @@ p(amount = 0) # "still alive" p("loading ...") # pass on a message

+ +
    
+
+ + +
End-user's API

1a. Subscribe to progress updates from everywhere: @@ -79,7 +84,8 @@ handlers(handler_progress(complete = "#"))

- +
+ ## A simple example diff --git a/man/progressr.Rd b/man/progressr.Rd index 7b440a2..e49fca5 100644 --- a/man/progressr.Rd +++ b/man/progressr.Rd @@ -44,6 +44,7 @@ The \pkg{progressr} package is compatible with Shiny applications. In the terminal: \itemize{ \item \link{handler_txtprogressbar} (default) +\item \link{handler_pbcol} \item \link{handler_pbmcapply} \item \link{handler_progress} \item \link{handler_ascii_alert} @@ -56,7 +57,7 @@ In the graphical user interface (GUI): \item \link{handler_winprogressbar} } -Via audio: +As sound: \itemize{ \item \link{handler_beepr} \item \link{handler_ascii_alert} diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md index 9b20e2a..ba69de4 100644 --- a/vignettes/progressr-intro.md +++ b/vignettes/progressr-intro.md @@ -21,10 +21,10 @@ Design motto: ## Two Minimal APIs - One For Developers and One For End-Users - - - - +
+
+
Developer's APIEnd-user's API
+ - -




-




+ +
Developer's API

@@ -45,9 +45,14 @@ p(amount = 0) # "still alive" p("loading ...") # pass on a message

+ +
    
+
+ + +
End-user's API

1a. Subscribe to progress updates from everywhere: @@ -83,7 +88,8 @@ handlers(handler_progress(complete = "#"))

- +
+ ## A simple example From 4110561ca96a3c8f8e4326f60073a44f51ba56c8 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sun, 6 Dec 2020 08:14:33 -0800 Subject: [PATCH 73/94] Add comment why we cannot register a global calling handler onLoad [ci skip] --- R/zzz.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index ea26509..da0c078 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -11,8 +11,11 @@ global <- Sys.getenv("R_PROGRESSR_GLOBAL_HANDLER", "FALSE") global <- getOption("progressr.global.handler", as.logical(global)) if (isTRUE(global)) { - utils::str(globalCallingHandlers()) - globalCallingHandlers(foo=function(c) utils::str(c)) + ## UPDATE It is not possible to register a global calling handler when + ## there is already an active condition handler as it is here because + ## loadNamespace()/library() uses tryCatch() internally. If attempted, + ## we'll get an error "should not be called with handlers on the stack". + ## /HB 2020-11-19 # register_global_progression_handler() } } From a010f9031a028e5c01e31e9f71a98aa2f19a3082 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sun, 6 Dec 2020 08:26:06 -0800 Subject: [PATCH 74/94] Now with_progress() and without_progress() returns the value of the evaluated expression [#26] --- NEWS | 5 ++++- R/with_progress.R | 16 ++++++++++------ R/without_progress.R | 10 ++++++++-- man/with_progress.Rd | 2 +- 4 files changed, 23 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index f5217a8..10ef73b 100644 --- a/NEWS +++ b/NEWS @@ -1,7 +1,7 @@ Package: progressr ================== -Version: 0.6.0-9000 [2020-12-05] +Version: 0.6.0-9000 [2020-12-06] SIGNIFICANT CHANGES: @@ -9,6 +9,9 @@ SIGNIFICANT CHANGES: everywhere without having to use with_progress(). This works on in R (>= 4.0.0) because it relies on global calling handlers. + * Now with_progress() and without_progress() returns the value of the + evaluated expression. + * A progressor must not be created in the global environment unless wrapped in with_progress() or without_progress() call. Ideally, a progressor is created within a function or a local() environment. diff --git a/R/with_progress.R b/R/with_progress.R index 5e564bc..8c3c700 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -25,7 +25,7 @@ #' default is to report progress in interactive mode but not batch mode. #' See below for more details. #' -#' @return Return nothing (reserved for future usage). +#' @return Returns the value of the expression. #' #' @example incl/with_progress.R #' @@ -145,9 +145,9 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE ## Evaluate expression capture_conditions <- TRUE - withCallingHandlers( - expr, - progression = function(p) { + withCallingHandlers({ + res <- withVisible(expr) + }, progression = function(p) { ## Don't capture conditions that are produced by progression handlers capture_conditions <<- FALSE on.exit(capture_conditions <<- TRUE) @@ -192,8 +192,12 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE ## Success status <- "ok" - - invisible(NULL) + + if (isTRUE(res$visible)) { + res$value + } else { + invisible(res$value) + } } diff --git a/R/without_progress.R b/R/without_progress.R index c158d42..b4f9470 100644 --- a/R/without_progress.R +++ b/R/without_progress.R @@ -8,9 +8,15 @@ without_progress <- function(expr) { progressr_in_globalenv("allow") on.exit(progressr_in_globalenv("disallow")) - withCallingHandlers(expr, progression = function(p) { + withCallingHandlers({ + res <- withVisible(expr) + }, progression = function(p) { invokeRestart("muffleProgression") }) - invisible(NULL) + if (isTRUE(res$visible)) { + res$value + } else { + invisible(res$value) + } } diff --git a/man/with_progress.Rd b/man/with_progress.Rd index 18ae942..3b38f2a 100644 --- a/man/with_progress.Rd +++ b/man/with_progress.Rd @@ -45,7 +45,7 @@ default is to report progress in interactive mode but not batch mode. See below for more details.} } \value{ -Return nothing (reserved for future usage). +Returns the value of the expression. } \description{ Report on Progress while Evaluating an R Expression From 165fa552e2c2ad032b472e5f6d4f2f8dcf69623c Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sun, 6 Dec 2020 09:06:04 -0800 Subject: [PATCH 75/94] Add debug info for with_progress() + fixing indentation [ci skip] --- R/with_progress.R | 119 +++++++++++++++++++++++++++++----------------- 1 file changed, 75 insertions(+), 44 deletions(-) diff --git a/R/with_progress.R b/R/with_progress.R index 8c3c700..b60c3fd 100644 --- a/R/with_progress.R +++ b/R/with_progress.R @@ -63,13 +63,22 @@ #' @export with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE, delay_terminal = NULL, delay_stdout = NULL, delay_conditions = NULL, interval = NULL, enable = NULL) { stop_if_not(is.logical(cleanup), length(cleanup) == 1L, !is.na(cleanup)) + + debug <- getOption("progressr.debug", FALSE) + if (debug) { + message("with_progress() ...") + on.exit(message("with_progress() ... done"), add = TRUE) + } ## FIXME: With zero handlers, progression conditions will be ## passed on upstream just as without with_progress(). ## Is that what we want? /HB 2019-05-17 # Nothing to do? - if (length(handlers) == 0L) return(expr) + if (length(handlers) == 0L) { + if (debug) message("No progress handlers - skipping") + return(expr) + } ## Temporarily set progressr options options <- list() @@ -83,14 +92,17 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE stop_if_not(is.logical(enable), length(enable) == 1L, !is.na(enable)) # Nothing to do? - if (!enable) return(expr) + if (!enable) { + if (debug) message("Progress disabled - skipping") + return(expr) + } options[["progressr.enable"]] <- enable } if (length(options) > 0L) { oopts <- options(options) - on.exit(options(oopts)) + on.exit(options(oopts), add = TRUE) } progressr_in_globalenv("allow") @@ -99,7 +111,10 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE handlers <- as_progression_handler(handlers) ## Nothing to do? - if (length(handlers) == 0L) return(expr) + if (length(handlers) == 0L) { + if (debug) message("No remaining progress handlers - skipping") + return(expr) + } ## Do we need to buffer? delays <- use_delays(handlers, @@ -107,17 +122,25 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE stdout = delay_stdout, conditions = delay_conditions ) + if (debug) { + what <- c( + if (delays$terminal) "terminal", + if (delays$stdout) "stdout", + delays$conditions + ) + message("- Buffering: ", paste(sQuote(what), collapse = ", ")) + } calling_handler <- make_calling_handler(handlers) - ## Flag indicating whether with_progress() exited due to - ## an error or not. + ## Flag indicating whether nor not with_progress() exited due to an error status <- "incomplete" ## Tell all progression handlers to shutdown at the end and ## the status of the evaluation. if (cleanup) { on.exit({ + if (debug) message("- signaling 'shutdown' to all handlers") withCallingHandlers({ withRestarts({ signalCondition(control_progression("shutdown", status = status)) @@ -136,59 +159,67 @@ with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE on.exit(flush_conditions(conditions), add = TRUE) } - ## Reset all handlers up start + ## Reset all handlers upfront + if (debug) message("- signaling 'reset' to all handlers") withCallingHandlers({ withRestarts({ signalCondition(control_progression("reset")) }, muffleProgression = function(p) NULL) }, progression = calling_handler) + ## Just for debugging purposes + progression_counter <- 0 + ## Evaluate expression capture_conditions <- TRUE withCallingHandlers({ res <- withVisible(expr) }, progression = function(p) { - ## Don't capture conditions that are produced by progression handlers - capture_conditions <<- FALSE - on.exit(capture_conditions <<- TRUE) - - ## Any buffered output to flush? - if (isTRUE(attr(delays$terminal, "flush"))) { - if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { - calling_handler(control_progression("hide")) - stdout_file <<- flush_stdout(stdout_file, close = FALSE) - conditions <<- flush_conditions(conditions) - calling_handler(control_progression("unhide")) - } + progression_counter <<- progression_counter + 1 + if (debug) message(sprintf("- received a %s (n=%g)", sQuote(class(p)[1]), progression_counter)) + + ## Don't capture conditions that are produced by progression handlers + capture_conditions <<- FALSE + on.exit(capture_conditions <<- TRUE) + + ## Any buffered output to flush? + if (isTRUE(attr(delays$terminal, "flush"))) { + if (length(conditions) > 0L || has_buffered_stdout(stdout_file)) { + calling_handler(control_progression("hide")) + stdout_file <<- flush_stdout(stdout_file, close = FALSE) + conditions <<- flush_conditions(conditions) + calling_handler(control_progression("unhide")) } - - calling_handler(p) - }, - condition = function(c) { - if (!capture_conditions || inherits(c, c("progression", "error"))) return() - if (inherits(c, delays$conditions)) { - ## Record - conditions[[length(conditions) + 1L]] <<- c - ## Muffle - if (inherits(c, "message")) { - invokeRestart("muffleMessage") - } else if (inherits(c, "warning")) { - invokeRestart("muffleWarning") - } else if (inherits(c, "condition")) { - ## If there is a "muffle" restart for this condition, - ## then invoke that restart, i.e. "muffle" the condition - restarts <- computeRestarts(c) - for (restart in restarts) { - name <- restart$name - if (is.null(name)) next - if (!grepl("^muffle", name)) next - invokeRestart(restart) - break - } + } + + calling_handler(p) + }, + condition = function(c) { + if (!capture_conditions || inherits(c, c("progression", "error"))) return() + if (debug) message("- received a ", sQuote(class(c)[1])) + + if (inherits(c, delays$conditions)) { + ## Record + conditions[[length(conditions) + 1L]] <<- c + ## Muffle + if (inherits(c, "message")) { + invokeRestart("muffleMessage") + } else if (inherits(c, "warning")) { + invokeRestart("muffleWarning") + } else if (inherits(c, "condition")) { + ## If there is a "muffle" restart for this condition, + ## then invoke that restart, i.e. "muffle" the condition + restarts <- computeRestarts(c) + for (restart in restarts) { + name <- restart$name + if (is.null(name)) next + if (!grepl("^muffle", name)) next + invokeRestart(restart) + break } } } - ) + }) ## Success status <- "ok" From e22cc7fe8861781edb92d97f687839d4d429afe0 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sun, 6 Dec 2020 10:37:26 -0800 Subject: [PATCH 76/94] with_progress() now reports on progress from multiple consecutive progressors [#55] --- NEWS | 3 ++ R/make_progression_handler.R | 82 ++++++++++++++++++++++++++---------- 2 files changed, 63 insertions(+), 22 deletions(-) diff --git a/NEWS b/NEWS index 10ef73b..662fee3 100644 --- a/NEWS +++ b/NEWS @@ -9,6 +9,9 @@ SIGNIFICANT CHANGES: everywhere without having to use with_progress(). This works on in R (>= 4.0.0) because it relies on global calling handlers. + * with_progress() now reports on progress from multiple consecutive + progressors, e.g. with_progress({ a <- slow_sum(1:3); b <- slow_sum(1:3) }). + * Now with_progress() and without_progress() returns the value of the evaluated expression. diff --git a/R/make_progression_handler.R b/R/make_progression_handler.R index 0681bb8..b3a36cc 100644 --- a/R/make_progression_handler.R +++ b/R/make_progression_handler.R @@ -84,6 +84,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en } ## Progress state + active <- FALSE max_steps <- NULL step <- NULL message <- NULL @@ -105,7 +106,10 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en stop(sprintf(".validate_internal_state(%s): %s", sQuote(label), msg)) } if (!is.null(timestamps)) { - if (length(timestamps) == 0L) error("length(timestamp) == 0L") + if (length(timestamps) == 0L) { + error(paste("length(timestamps) == 0L but not is.null(timestamps):", + sQuote(deparse(timestamps)))) + } } } @@ -145,6 +149,24 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en )) } + reset_internal_state <- function() { + ## Progress state + active <<- FALSE + max_steps <<- NULL + step <<- NULL + message <<- NULL + auto_finish <<- TRUE + timestamps <<- NULL + milestones <<- NULL + prev_milestone <<- NULL + finished <<- FALSE + enabled <<- FALSE + + ## Progress cache + owner <<- NULL + done <<- list() + } + reset_reporter <- function(p) { args <- reporter_args(progression = p) debug <- getOption("progressr.debug", FALSE) @@ -164,8 +186,10 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en mprintf("initiate_reporter() ...") mstr(args) } + stop_if_not(!isTRUE(active)) stop_if_not(is.null(prev_milestone), length(milestones) > 0L) do.call(reporter$initiate, args = args) + active <<- TRUE finished <<- FALSE .validate_internal_state("initiate_reporter() ... done") if (debug) mprintf("initiate_reporter() ... done") @@ -178,6 +202,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en mprintf("update_reporter() ...") mstr(args) } + stop_if_not(isTRUE(active)) stop_if_not(!is.null(step), length(milestones) > 0L) do.call(reporter$update, args = args) .validate_internal_state("update_reporter() ... done") @@ -191,6 +216,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en mprintf("hide_reporter() ...") mstr(args) } +# stop_if_not(isTRUE(active)) if (is.null(reporter$hide)) { if (debug) mprintf("hide_reporter() ... skipping; not supported") return() @@ -207,6 +233,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en mprintf("unhide_reporter() ...") mstr(args) } +# stop_if_not(isTRUE(active)) if (is.null(reporter$unhide)) { if (debug) mprintf("unhide_reporter() ... skipping; not supported") return() @@ -223,8 +250,18 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en mprintf("finish_reporter() ...") mstr(args) } - do.call(reporter$finish, args = args) + + ## Signal 'finish' if active and not already finished + ## because it could already have been auto-finished before + if (active && !finished) { + do.call(reporter$finish, args = args) + } else { + if (debug) message("- Hmm ... got a request to 'finish' handler, but it's not active. Oh well, will finish it then") + } + + reset_internal_state() finished <<- TRUE + if (debug) message("- owner: ", deparse(owner)) .validate_internal_state("finish_reporter() ... done") if (debug) mprintf("finish_reporter() ... done") } @@ -257,17 +294,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en if (inherits(p, "control_progression")) { type <- p[["type"]] if (type == "reset") { - max_steps <<- NULL - step <<- NULL - message <<- NULL - auto_finish <<- TRUE - timestamps <<- NULL - milestones <<- NULL - prev_milestone <<- NULL - enabled <<- FALSE - finished <<- FALSE - owner <<- NULL - done <<- list() + reset_internal_state() reset_reporter(p) .validate_internal_state(sprintf("handler(type=%s) ... end", type)) } else if (type == "shutdown") { @@ -286,14 +313,18 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en return(invisible(finished)) } + debug <- getOption("progressr.debug", FALSE) + ## Ignore stray progressions coming from other sources, e.g. ## a function of a package that started to report on progression. - if (!is_owner(p)) return(invisible(finished)) + if (!is_owner(p)) { + if (debug) message("- not owner of this progression. Skipping") + return(invisible(finished)) + } duplicated <- is_duplicated(p) type <- p[["type"]] - debug <- getOption("progressr.debug", FALSE) if (debug) { mprintf("Progression calling handler %s ...", sQuote(type)) mprintf("- progression:") @@ -304,14 +335,18 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en } if (duplicated) { - if (debug) mprintf("Progression calling handler %s ... already done", sQuote(type)) + if (debug) mprintf("Progression calling handler %s ... condition already done", sQuote(type)) return(invisible(finished)) - } else if (finished) { - if (debug) mprintf("Progression calling handler %s ... already finished", sQuote(type)) + } else if (active && finished) { + if (debug) mprintf("Progression calling handler %s ... active but already finished", sQuote(type)) return(invisible(finished)) } if (type == "initiate") { + if (active) { + if (debug) message("- cannot 'initiate' handler, because it is already active") + return(invisible(finished)) + } max_steps <<- p[["steps"]] if (debug) mstr(list(max_steps=max_steps)) stop_if_not(!is.null(max_steps), is.numeric(max_steps), length(max_steps) == 1L, max_steps >= 1) @@ -348,17 +383,20 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en } else if (type == "finish") { if (debug) mstr(list(finished = finished, milestones = milestones)) finish_reporter(p) - timestamps[max_steps] <<- Sys.time() - prev_milestone <<- max_steps - .validate_internal_state() + .validate_internal_state("type=finish") } else if (type == "update") { + if (!active) { + if (debug) message("- cannot 'update' handler, because it is not active") + return(invisible(finished)) + } if (debug) mstr(list(step=step, "p$amount"=p[["amount"]], max_steps=max_steps)) step <<- min(max(step + p[["amount"]], 0L), max_steps) stop_if_not(step >= 0L) msg <- conditionMessage(p) if (length(msg) > 0) message <<- msg - timestamps[step] <<- Sys.time() + if (step > 0) timestamps[step] <<- Sys.time() if (debug) mstr(list(finished = finished, step = step, milestones = milestones, prev_milestone = prev_milestone, interval = interval)) + .validate_internal_state("type=update") ## Only update if a new milestone step has been reached ... ## ... or if we want to send a zero-amount update From 7e07f186c2c16012d6ce20cb1403744406106766 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Sun, 6 Dec 2020 10:45:32 -0800 Subject: [PATCH 77/94] Typo: handler() -> handlers() [ci skip] --- OVERVIEW.md | 4 ++-- README.md | 4 ++-- vignettes/progressr-intro.md | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/OVERVIEW.md b/OVERVIEW.md index 8bf9d1e..b076b28 100644 --- a/OVERVIEW.md +++ b/OVERVIEW.md @@ -50,7 +50,7 @@ p("loading ...") # pass on a message 

-handler(global = TRUE)
+handlers(global = TRUE)
 
 y <- slow_sum(1:5)
 y <- slow_sum(6:10)
@@ -162,7 +162,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 ~/.Rprofile file.
+To set the default progress handler, or handlers, in all your R sessions, call `progressr::handlers(...)` in your ~/.Rprofile file.
 
 
 
diff --git a/README.md b/README.md
index 63ecbfc..4d2cdcd 100644
--- a/README.md
+++ b/README.md
@@ -55,7 +55,7 @@ p("loading ...")  # pass on a message
 

 
 
-handler(global = TRUE)
+handlers(global = TRUE)
 
 y <- slow_sum(1:5)
 y <- slow_sum(6:10)
@@ -167,7 +167,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 ~/.Rprofile file.
+To set the default progress handler, or handlers, in all your R sessions, call `progressr::handlers(...)` in your ~/.Rprofile file.
 
 
 
diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md
index ba69de4..3bb80d9 100644
--- a/vignettes/progressr-intro.md
+++ b/vignettes/progressr-intro.md
@@ -59,7 +59,7 @@ p("loading ...")  # pass on a message
 

 
 
-handler(global = TRUE)
+handlers(global = TRUE)
 
 y <- slow_sum(1:5)
 y <- slow_sum(6:10)
@@ -171,7 +171,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 ~/.Rprofile file.
+To set the default progress handler, or handlers, in all your R sessions, call `progressr::handlers(...)` in your ~/.Rprofile file.
 
 
 

From 4395db9f71968e2dfef96095ce4b2dd24f8d6287 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Sun, 6 Dec 2020 10:46:26 -0800
Subject: [PATCH 78/94] use same example code in both cases [ci skip]

---
 OVERVIEW.md                  | 2 +-
 README.md                    | 2 +-
 vignettes/progressr-intro.md | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/OVERVIEW.md b/OVERVIEW.md
index b076b28..70979bd 100644
--- a/OVERVIEW.md
+++ b/OVERVIEW.md
@@ -62,7 +62,7 @@ y <- slow_sum(6:10)
 
 
 with_progress({
-  y <- slow_sum(1:3)
+  y <- slow_sum(1:5)
   y <- slow_sum(6:10)
 })
 

diff --git a/README.md b/README.md
index 4d2cdcd..6866c97 100644
--- a/README.md
+++ b/README.md
@@ -67,7 +67,7 @@ y <- slow_sum(6:10)
 
 
 with_progress({
-  y <- slow_sum(1:3)
+  y <- slow_sum(1:5)
   y <- slow_sum(6:10)
 })
 

diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md
index 3bb80d9..91ee208 100644
--- a/vignettes/progressr-intro.md
+++ b/vignettes/progressr-intro.md
@@ -71,7 +71,7 @@ y <- slow_sum(6:10)
 
 
 with_progress({
-  y <- slow_sum(1:3)
+  y <- slow_sum(1:5)
   y <- slow_sum(6:10)
 })
 


From 25d36f91575c708c92ea94c96ef75be63ef3fab3 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Mon, 7 Dec 2020 12:44:48 -0800
Subject: [PATCH 79/94] pbcol: explicitly flush.console() each time

---
 R/handler_pbcol.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R
index 39a0ebf..2b799ac 100644
--- a/R/handler_pbcol.R
+++ b/R/handler_pbcol.R
@@ -20,10 +20,12 @@
 #'
 #' @example incl/handler_pbcol.R
 #'
+#' @importFrom utils flush.console
 #' @export
 handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = "cyan", intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
   cat_ <- function(...) {
     cat(..., sep = "", collapse = "", file = stderr())
+    flush.console()
   }
   
   erase_progress_bar <- function() {

From 4449a2dff95b1340cfefd79d4c1cb059e2e6396d Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Mon, 7 Dec 2020 14:10:30 -0800
Subject: [PATCH 80/94] pbcol() would not work produce colors in RStudio
 Console or when output was buffered in the terminal (fixes #100)

---
 R/handler_pbcol.R | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R
index 2b799ac..4530a47 100644
--- a/R/handler_pbcol.R
+++ b/R/handler_pbcol.R
@@ -23,6 +23,9 @@
 #' @importFrom utils flush.console
 #' @export
 handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = "cyan", intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
+  crayon_enabled <- getOption("crayon.enabled", NA)
+  if (is.na(crayon_enabled)) crayon_enabled <- crayon::has_color()
+
   cat_ <- function(...) {
     cat(..., sep = "", collapse = "", file = stderr())
     flush.console()
@@ -34,6 +37,10 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col =
   
   redraw_progress_bar <- function(ratio, message, spin = " ") {
     stop_if_not(ratio >= 0, ratio <= 1)
+    if (crayon_enabled) {
+      options(crayon.enabled = TRUE)
+      on.exit(options(crayon.enabled = TRUE), add = TRUE)
+    }
     pbstr <- pbcol(
       fraction = ratio,
       msg = message,

From 81286572624bdd3aeefb7a756b5a5b655268611e Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Mon, 7 Dec 2020 14:19:12 -0800
Subject: [PATCH 81/94] handler_pbcol() gain argument 'text_col="white"'. Can't
 rely on the default foreground color being white, e.g. in the RStudio Console
 [ci skip]

---
 R/handler_pbcol.R    | 27 ++++++++++++++++++++++++---
 man/handler_pbcol.Rd |  1 +
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R
index 4530a47..b43b041 100644
--- a/R/handler_pbcol.R
+++ b/R/handler_pbcol.R
@@ -22,7 +22,7 @@
 #'
 #' @importFrom utils flush.console
 #' @export
-handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col = "cyan", intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
+handler_pbcol <- function(adjust = 0.0, pad = 1L, text_col = "white", done_col = "blue", todo_col = "cyan", intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
   crayon_enabled <- getOption("crayon.enabled", NA)
   if (is.na(crayon_enabled)) crayon_enabled <- crayon::has_color()
 
@@ -46,6 +46,7 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col =
       msg = message,
       adjust = adjust,
       pad = pad,
+      text_col = text_col,
       done_col = done_col,
       todo_col = todo_col,
       spin = spin,
@@ -93,7 +94,7 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, done_col = "blue", todo_col =
 
 
 
-pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOption("width") - 1L, done_col = "blue", todo_col = "cyan", spin = " ") {
+pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOption("width") - 1L, text_col = "white", done_col = "blue", todo_col = "cyan", spin = " ") {
   bgColor <- function(s, col) {
     bgFcn <- switch(col,
       black   = crayon::bgBlack,
@@ -109,6 +110,22 @@ pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOpt
     bgFcn(s)
   }
 
+  fgColor <- function(s, col) {
+    fgFcn <- switch(col,
+      black   = crayon::black,
+      blue    = crayon::blue,
+      cyan    = crayon::cyan,
+      green   = crayon::green,
+      magenta = crayon::magenta,
+      red     = crayon::red,
+      silver  = crayon::silver,
+      yellow  = crayon::yellow,
+      white   = crayon::white,
+      stop("Unknown 'crayon' foreground color: ", sQuote(col))
+    )
+    fgFcn(s)
+  }
+
   if (length(msg) == 0L) msg <- ""
   stop_if_not(length(msg) == 1L, is.character(msg))
 
@@ -146,5 +163,9 @@ pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOpt
   rmsg <- substr(pmsg, start = len + 1L, stop = nchar(pmsg))
   lmsg <- bgColor(lmsg, done_col)
   rmsg <- bgColor(rmsg, todo_col)
-  paste(lmsg, rmsg, sep = "")
+  lmsg <- fgColor(lmsg, text_col)
+  rmsg <- fgColor(rmsg, text_col)
+  bar <- paste(lmsg, rmsg, sep = "")
+  
+  bar
 }
diff --git a/man/handler_pbcol.Rd b/man/handler_pbcol.Rd
index 2ae2d5d..33f92e4 100644
--- a/man/handler_pbcol.Rd
+++ b/man/handler_pbcol.Rd
@@ -7,6 +7,7 @@
 handler_pbcol(
   adjust = 0,
   pad = 1L,
+  text_col = "white",
   done_col = "blue",
   todo_col = "cyan",
   intrusiveness = getOption("progressr.intrusiveness.terminal", 1),

From a61323ac70cdf6c6092ce6d8b6340493e7120263 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Mon, 7 Dec 2020 14:23:01 -0800
Subject: [PATCH 82/94] Forgot to document 'text_col' [ci skip]

---
 R/handler_pbcol.R    | 8 +++++---
 man/handler_pbcol.Rd | 8 +++++---
 2 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R
index b43b041..edcdc08 100644
--- a/R/handler_pbcol.R
+++ b/R/handler_pbcol.R
@@ -9,9 +9,11 @@
 #' @param pad (integer) Amount of padding on each side of the message,
 #' where padding is done by spaces.
 #'
-#' @param done_col,todo_col (character string) The \pkg{crayon} background
-#' colors used for the progress bar, where `done_col` is used for the part
-#' of the progress bar that is already done and `todo_col` for what remains.
+#' @param text_col,done_col,todo_col (character string) The \pkg{crayon}
+#' foreground and background colors used for the progress bar, where
+#' `text_col` is used for all of the progress bar, `done_col` is used for the
+#' part of the progress bar that is already done and `todo_col` for what
+#' remains.
 #' 
 #' @param \ldots Additional arguments passed to [make_progression_handler()].
 #'
diff --git a/man/handler_pbcol.Rd b/man/handler_pbcol.Rd
index 33f92e4..4fbd6df 100644
--- a/man/handler_pbcol.Rd
+++ b/man/handler_pbcol.Rd
@@ -23,9 +23,11 @@ where \code{adjust = 0} positions the message to the very left, and
 \item{pad}{(integer) Amount of padding on each side of the message,
 where padding is done by spaces.}
 
-\item{done_col, todo_col}{(character string) The \pkg{crayon} background
-colors used for the progress bar, where \code{done_col} is used for the part
-of the progress bar that is already done and \code{todo_col} for what remains.}
+\item{text_col, done_col, todo_col}{(character string) The \pkg{crayon}
+foreground and background colors used for the progress bar, where
+\code{text_col} is used for all of the progress bar, \code{done_col} is used for the
+part of the progress bar that is already done and \code{todo_col} for what
+remains.}
 
 \item{intrusiveness}{(numeric) A non-negative scalar on how intrusive
 (disruptive) the reporter to the user.}

From 9c18fddabfcddc4f756dfb190f4340b97dbe67fe Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Mon, 7 Dec 2020 14:48:12 -0800
Subject: [PATCH 83/94] pbcol: harmonize argument names with
 'progress::progress_bar()' and now take functions (typically 'crayon' ones)
 instead of strings for more flexibility

---
 R/handler_pbcol.R    | 62 ++++++++++----------------------------------
 man/handler_pbcol.Rd | 15 +++++------
 2 files changed, 21 insertions(+), 56 deletions(-)

diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R
index edcdc08..b1fb57a 100644
--- a/R/handler_pbcol.R
+++ b/R/handler_pbcol.R
@@ -9,11 +9,11 @@
 #' @param pad (integer) Amount of padding on each side of the message,
 #' where padding is done by spaces.
 #'
-#' @param text_col,done_col,todo_col (character string) The \pkg{crayon}
-#' foreground and background colors used for the progress bar, where
-#' `text_col` is used for all of the progress bar, `done_col` is used for the
-#' part of the progress bar that is already done and `todo_col` for what
-#' remains.
+#' @param complete,incomplete (function) Functions that take "complete" and
+#' "incomplete" strings that comprise the progress bar as input and annotate
+#' them to reflect their two different parts.  The default is to annotation
+#' them with two different background colors and the same foreground color
+#' using the \pkg{crayon} package.
 #' 
 #' @param \ldots Additional arguments passed to [make_progression_handler()].
 #'
@@ -24,9 +24,9 @@
 #'
 #' @importFrom utils flush.console
 #' @export
-handler_pbcol <- function(adjust = 0.0, pad = 1L, text_col = "white", done_col = "blue", todo_col = "cyan", intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
-  crayon_enabled <- getOption("crayon.enabled", NA)
-  if (is.na(crayon_enabled)) crayon_enabled <- crayon::has_color()
+handler_pbcol <- function(adjust = 0.0, pad = 1L, complete = function(s) crayon::bgBlue(crayon::white(s)), incomplete = function(s) crayon::bgCyan(crayon::white(s)), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
+  crayon_enabled <- getOption("crayon.enabled", NULL)
+  if (is.null(crayon_enabled)) crayon_enabled <- crayon::has_color()
 
   cat_ <- function(...) {
     cat(..., sep = "", collapse = "", file = stderr())
@@ -39,7 +39,7 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, text_col = "white", done_col =
   
   redraw_progress_bar <- function(ratio, message, spin = " ") {
     stop_if_not(ratio >= 0, ratio <= 1)
-    if (crayon_enabled) {
+    if (crayon_enabled && !is.null(getOption("crayon.enabled", NULL))) {
       options(crayon.enabled = TRUE)
       on.exit(options(crayon.enabled = TRUE), add = TRUE)
     }
@@ -48,9 +48,8 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, text_col = "white", done_col =
       msg = message,
       adjust = adjust,
       pad = pad,
-      text_col = text_col,
-      done_col = done_col,
-      todo_col = todo_col,
+      complete = complete,
+      incomplete = incomplete,
       spin = spin,
     )
     cat_("\r", pbstr)
@@ -96,38 +95,7 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, text_col = "white", done_col =
 
 
 
-pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOption("width") - 1L, text_col = "white", done_col = "blue", todo_col = "cyan", spin = " ") {
-  bgColor <- function(s, col) {
-    bgFcn <- switch(col,
-      black   = crayon::bgBlack,
-      blue    = crayon::bgBlue,
-      cyan    = crayon::bgCyan,
-      green   = crayon::bgGreen,
-      magenta = crayon::bgMagenta,
-      red     = crayon::bgRed,
-      yellow  = crayon::bgYellow,
-      white   = crayon::bgWhite,
-      stop("Unknown 'crayon' background color: ", sQuote(col))
-    )
-    bgFcn(s)
-  }
-
-  fgColor <- function(s, col) {
-    fgFcn <- switch(col,
-      black   = crayon::black,
-      blue    = crayon::blue,
-      cyan    = crayon::cyan,
-      green   = crayon::green,
-      magenta = crayon::magenta,
-      red     = crayon::red,
-      silver  = crayon::silver,
-      yellow  = crayon::yellow,
-      white   = crayon::white,
-      stop("Unknown 'crayon' foreground color: ", sQuote(col))
-    )
-    fgFcn(s)
-  }
-
+pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOption("width") - 1L, complete = function(s) crayon::bgBlue(crayon::white(s)), incomplete = function(s) crayon::bgCyan(crayon::white(s)), spin = " ") {
   if (length(msg) == 0L) msg <- ""
   stop_if_not(length(msg) == 1L, is.character(msg))
 
@@ -163,10 +131,8 @@ pbcol <- function(fraction = 0.0, msg = "", adjust = 0, pad = 1L, width = getOpt
   len <- round(fraction * nchar(pmsg), digits = 0L)
   lmsg <- substr(pmsg, start = 1L, stop = len)
   rmsg <- substr(pmsg, start = len + 1L, stop = nchar(pmsg))
-  lmsg <- bgColor(lmsg, done_col)
-  rmsg <- bgColor(rmsg, todo_col)
-  lmsg <- fgColor(lmsg, text_col)
-  rmsg <- fgColor(rmsg, text_col)
+  if (!is.null(complete)) lmsg <- complete(lmsg)
+  if (!is.null(incomplete)) rmsg <- incomplete(rmsg)
   bar <- paste(lmsg, rmsg, sep = "")
   
   bar
diff --git a/man/handler_pbcol.Rd b/man/handler_pbcol.Rd
index 4fbd6df..e18fc92 100644
--- a/man/handler_pbcol.Rd
+++ b/man/handler_pbcol.Rd
@@ -7,9 +7,8 @@
 handler_pbcol(
   adjust = 0,
   pad = 1L,
-  text_col = "white",
-  done_col = "blue",
-  todo_col = "cyan",
+  complete = function(s) crayon::bgBlue(crayon::white(s)),
+  incomplete = function(s) crayon::bgCyan(crayon::white(s)),
   intrusiveness = getOption("progressr.intrusiveness.terminal", 1),
   target = "terminal",
   ...
@@ -23,11 +22,11 @@ where \code{adjust = 0} positions the message to the very left, and
 \item{pad}{(integer) Amount of padding on each side of the message,
 where padding is done by spaces.}
 
-\item{text_col, done_col, todo_col}{(character string) The \pkg{crayon}
-foreground and background colors used for the progress bar, where
-\code{text_col} is used for all of the progress bar, \code{done_col} is used for the
-part of the progress bar that is already done and \code{todo_col} for what
-remains.}
+\item{complete, incomplete}{(function) Functions that take "complete" and
+"incomplete" strings that comprise the progress bar as input and annotate
+them to reflect their two different parts.  The default is to annotation
+them with two different background colors and the same foreground color
+using the \pkg{crayon} package.}
 
 \item{intrusiveness}{(numeric) A non-negative scalar on how intrusive
 (disruptive) the reporter to the user.}

From 1486356a56f766b18675ceae0e1a2a3104b27525 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Mon, 7 Dec 2020 17:42:47 -0800
Subject: [PATCH 84/94] typos + use handlers(global = TRUE) in all examples [ci
 skip]

---
 OVERVIEW.md                  | 23 ++++++++++++++++-------
 README.md                    | 23 ++++++++++++++++-------
 vignettes/progressr-intro.md | 23 ++++++++++++++++-------
 3 files changed, 48 insertions(+), 21 deletions(-)

diff --git a/OVERVIEW.md b/OVERVIEW.md
index 70979bd..ebbbd78 100644
--- a/OVERVIEW.md
+++ b/OVERVIEW.md
@@ -284,6 +284,7 @@ we will get:
 
 ```r
 > library(progressr)
+> handlers(global = TRUE)
 > handlers("progress")
 > y <- slow_sqrt(1:8)
 Calculating the square root of 1
@@ -306,6 +307,7 @@ Note that progression updates by **progressr** is designed to work out of the bo
 
 ```r
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -314,7 +316,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -326,6 +328,7 @@ my_fcn(1:5)
 ```r
 library(foreach)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -345,6 +348,7 @@ my_fcn(1:5)
 ```r
 library(purrr)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -353,7 +357,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -365,6 +369,7 @@ my_fcn(1:5)
 ```r
 library(plyr)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -373,7 +378,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -396,6 +401,7 @@ library(future.apply)
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -405,7 +411,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -422,6 +428,7 @@ registerDoFuture()
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -431,7 +438,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   }
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -447,6 +454,7 @@ library(furrr)
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -456,7 +464,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -476,6 +484,7 @@ registerDoFuture()
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -485,7 +494,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   }, .parallel = TRUE)
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
diff --git a/README.md b/README.md
index 6866c97..f88b2ce 100644
--- a/README.md
+++ b/README.md
@@ -289,6 +289,7 @@ we will get:
 
 ```r
 > library(progressr)
+> handlers(global = TRUE)
 > handlers("progress")
 > y <- slow_sqrt(1:8)
 Calculating the square root of 1
@@ -311,6 +312,7 @@ Note that progression updates by **progressr** is designed to work out of the bo
 
 ```r
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -319,7 +321,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -331,6 +333,7 @@ my_fcn(1:5)
 ```r
 library(foreach)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -350,6 +353,7 @@ my_fcn(1:5)
 ```r
 library(purrr)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -358,7 +362,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -370,6 +374,7 @@ my_fcn(1:5)
 ```r
 library(plyr)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -378,7 +383,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -401,6 +406,7 @@ library(future.apply)
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -410,7 +416,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -427,6 +433,7 @@ registerDoFuture()
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -436,7 +443,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   }
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -452,6 +459,7 @@ library(furrr)
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -461,7 +469,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -481,6 +489,7 @@ registerDoFuture()
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -490,7 +499,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   }, .parallel = TRUE)
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
diff --git a/vignettes/progressr-intro.md b/vignettes/progressr-intro.md
index 91ee208..8e65f80 100644
--- a/vignettes/progressr-intro.md
+++ b/vignettes/progressr-intro.md
@@ -293,6 +293,7 @@ we will get:
 
 ```r
 > library(progressr)
+> handlers(global = TRUE)
 > handlers("progress")
 > y <- slow_sqrt(1:8)
 Calculating the square root of 1
@@ -315,6 +316,7 @@ Note that progression updates by **progressr** is designed to work out of the bo
 
 ```r
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -323,7 +325,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -335,6 +337,7 @@ my_fcn(1:5)
 ```r
 library(foreach)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -354,6 +357,7 @@ my_fcn(1:5)
 ```r
 library(purrr)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -362,7 +366,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -374,6 +378,7 @@ my_fcn(1:5)
 ```r
 library(plyr)
 library(progressr)
+handlers(global = TRUE)
 
 my_fcn <- function(xs) {
   p <- progressor(along = xs)
@@ -382,7 +387,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 #  |====================                               |  40%
@@ -405,6 +410,7 @@ library(future.apply)
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -414,7 +420,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -431,6 +437,7 @@ registerDoFuture()
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -440,7 +447,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   }
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -456,6 +463,7 @@ library(furrr)
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -465,7 +473,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   })
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2
@@ -485,6 +493,7 @@ registerDoFuture()
 plan(multisession)
 
 library(progressr)
+handlers(global = TRUE)
 handlers("progress", "beepr")
 
 my_fcn <- function(xs) {
@@ -494,7 +503,7 @@ my_fcn <- function(xs) {
     p(sprintf("x=%g", x))
     sqrt(x)
   }, .parallel = TRUE)
-})
+}
 
 my_fcn(1:5)
 # / [================>-----------------------------]  40% x=2

From f56f602e07cdde2b1d41e78a0b085be39cb94221 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Mon, 7 Dec 2020 17:52:27 -0800
Subject: [PATCH 85/94] REVDEP: 22 reverse dependencies on CRAN [ci skip]

---
 revdep/README.md   | 12 ++++++------
 revdep/problems.md | 49 +++++++++++++++-------------------------------
 2 files changed, 22 insertions(+), 39 deletions(-)

diff --git a/revdep/README.md b/revdep/README.md
index 860188d..11a1997 100644
--- a/revdep/README.md
+++ b/revdep/README.md
@@ -10,7 +10,7 @@
 |collate  |en_US.UTF-8                  |
 |ctype    |en_US.UTF-8                  |
 |tz       |America/Los_Angeles          |
-|date     |2020-11-17                   |
+|date     |2020-12-07                   |
 
 # Dependencies
 
@@ -29,19 +29,19 @@
 |dipsaus                                             |0.1.1   |      |        |     |
 |econet                                              |0.1.92  |      |        |     |
 |[EFAtools](problems.md#efatools)                    |0.3.0   |      |        |2    |
-|[EpiNow2](problems.md#epinow2)                      |1.2.1   |      |        |2    |
+|[EpiNow2](problems.md#epinow2)                      |1.3.1   |      |        |2    |
 |epwshiftr                                           |0.1.1   |      |        |     |
 |fabletools                                          |0.2.1   |      |        |     |
-|[funGp](problems.md#fungp)                          |0.2.0   |      |        |1    |
+|funGp                                               |0.2.1   |      |        |     |
 |furrr                                               |0.2.1   |      |        |     |
 |gtfs2gps                                            |1.3-2   |      |        |     |
 |lightr                                              |1.3     |      |        |     |
 |[lmtp](problems.md#lmtp)                            |0.0.5   |      |        |2    |
-|mlr3                                                |0.8.0   |      |        |     |
-|[modeltime](problems.md#modeltime)                  |0.3.1   |1     |        |     |
+|mlr3                                                |0.9.0   |      |        |     |
+|[modeltime](problems.md#modeltime)                  |0.4.0   |1     |        |1    |
 |[modeltime.ensemble](problems.md#modeltimeensemble) |0.3.0   |      |        |1    |
 |[modeltime.resample](problems.md#modeltimeresample) |0.1.0   |      |        |1    |
-|nflfastR                                            |3.1.1   |      |        |     |
+|nflfastR                                            |3.2.0   |      |        |     |
 |nlrx                                                |0.4.2   |      |        |     |
 |[pavo](problems.md#pavo)                            |2.5.0   |      |1       |     |
 |poppr                                               |2.8.6   |      |        |     |
diff --git a/revdep/problems.md b/revdep/problems.md
index ce2f1c2..c92b05e 100644
--- a/revdep/problems.md
+++ b/revdep/problems.md
@@ -6,7 +6,7 @@
 * GitHub: https://github.com/M-E-Rademaker/cSEM
 * Source code: https://github.com/cran/cSEM
 * Date/Publication: 2020-10-12 16:40:03 UTC
-* Number of recursive dependencies: 120
+* Number of recursive dependencies: 119
 
 Run `revdep_details(, "cSEM")` for more info
 
@@ -54,11 +54,11 @@ Run `revdep_details(, "EFAtools")` for more info
 
 

 
-* Version: 1.2.1
+* Version: 1.3.1
 * GitHub: NA
 * Source code: https://github.com/cran/EpiNow2
-* Date/Publication: 2020-10-20 14:50:09 UTC
-* Number of recursive dependencies: 146
+* Date/Publication: 2020-11-22 14:20:05 UTC
+* Number of recursive dependencies: 149
 
 Run `revdep_details(, "EpiNow2")` for more info
 
@@ -73,32 +73,9 @@ Run `revdep_details(, "EpiNow2")` for more info
 
 *   checking installed package size ... NOTE
     ```
-      installed size is 107.4Mb
+      installed size is 137.8Mb
       sub-directories of 1Mb or more:
-        help    2.3Mb
-        libs  104.8Mb
-    ```
-
-# funGp
-
-

-
-* Version: 0.2.0
-* GitHub: NA
-* Source code: https://github.com/cran/funGp
-* Date/Publication: 2020-11-17 09:10:03 UTC
-* Number of recursive dependencies: 35
-
-Run `revdep_details(, "funGp")` for more info
-
-

-
-## In both
-
-*   checking dependencies in R code ... NOTE
-    ```
-    Namespace in Imports field not imported from: ‘plyr’
-      All declared Imports should be used.
+        libs  136.4Mb
     ```
 
 # lmtp
@@ -133,10 +110,10 @@ Run `revdep_details(, "lmtp")` for more info
 
 

 
-* Version: 0.3.1
+* Version: 0.4.0
 * GitHub: https://github.com/business-science/modeltime
 * Source code: https://github.com/cran/modeltime
-* Date/Publication: 2020-11-09 21:50:02 UTC
+* Date/Publication: 2020-11-23 08:50:05 UTC
 * Number of recursive dependencies: 195
 
 Run `revdep_details(, "modeltime")` for more info
@@ -166,11 +143,17 @@ Run `revdep_details(, "modeltime")` for more info
       ══ testthat results  ═══════════════════════════════════════════════════════════
       ERROR (test-results-forecast-plots.R:34:1): (code run outside of `test_that()`)
       
-      [ FAIL 1 | WARN 0 | SKIP 7 | PASS 465 ]
+      [ FAIL 1 | WARN 0 | SKIP 7 | PASS 473 ]
       Error: Test failures
       Execution halted
     ```
 
+*   checking dependencies in R code ... NOTE
+    ```
+    Namespace in Imports field not imported from: ‘slider’
+      All declared Imports should be used.
+    ```
+
 # modeltime.ensemble
 
 

@@ -225,7 +208,7 @@ Run `revdep_details(, "modeltime.resample")` for more info
 * GitHub: https://github.com/rmaia/pavo
 * Source code: https://github.com/cran/pavo
 * Date/Publication: 2020-11-12 09:00:02 UTC
-* Number of recursive dependencies: 100
+* Number of recursive dependencies: 101
 
 Run `revdep_details(, "pavo")` for more info
 

From 26ee9c0fd74dd14e2dec147b9516bc4bcfd55cd9 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Mon, 7 Dec 2020 18:38:41 -0800
Subject: [PATCH 86/94] NEWS: tweaks [ci skip]

---
 NEWS | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 662fee3..2002240 100644
--- a/NEWS
+++ b/NEWS
@@ -1,20 +1,17 @@
 Package: progressr
 ==================
 
-Version: 0.6.0-9000 [2020-12-06]
+Version: 0.6.0-9000 [2020-12-07]
 
 SIGNIFICANT CHANGES:
 
  * The user can how use handlers(global = TRUE) to enable progress reports
-   everywhere without having to use with_progress().  This works on in
-   R (>= 4.0.0) because it relies on global calling handlers.
+   everywhere without having to use with_progress().  This only works in
+   R (>= 4.0.0) because it requires global calling handlers.
 
  * with_progress() now reports on progress from multiple consecutive
    progressors, e.g. with_progress({ a <- slow_sum(1:3); b <- slow_sum(1:3) }).
 
- * Now with_progress() and without_progress() returns the value of the
-   evaluated expression.
-   
  * A progressor must not be created in the global environment unless wrapped
    in with_progress() or without_progress() call.  Ideally, a progressor is
    created within a function or a local() environment.
@@ -23,6 +20,9 @@ SIGNIFICANT CHANGES:
 
 NEW FEATURES:
 
+ * Now with_progress() and without_progress() returns the value of the
+   evaluated expression.
+   
  * The progression message can now be created dynamically based on the
    information in the 'progression' condition.  Specifically, if 'message' is
    a function, then that function will called with the 'progression' condition

From 5924d5d02bb39851517f4a03d93ed04d0559aa16 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Thu, 10 Dec 2020 10:20:37 -0800
Subject: [PATCH 87/94] progressor() gained argument 'enable' This is a very
 efficient (near-zero overhead) way to disable the progress framework (fixes
 #102)

---
 NEWS              | 12 +++++++++++-
 R/progressor.R    | 20 ++++++++++++++++++--
 man/progressor.Rd |  6 ++++++
 3 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/NEWS b/NEWS
index 2002240..ae4d5c8 100644
--- a/NEWS
+++ b/NEWS
@@ -1,7 +1,7 @@
 Package: progressr
 ==================
 
-Version: 0.6.0-9000 [2020-12-07]
+Version: 0.6.0-9000 [2020-12-10]
 
 SIGNIFICANT CHANGES:
 
@@ -20,6 +20,16 @@ SIGNIFICANT CHANGES:
 
 NEW FEATURES:
 
+ * progressor() gained argument 'enable' to control whether or not the
+   progressor signals 'progression' conditions.  It defaults to option
+   'progressr.enable' so that progress updates can be disabled globally.
+   The 'enable' argument makes it easy for package developers who already
+   provide a 'progress = TRUE/FALSE' argument in their functions to migrate
+   to the 'progressr' package without having to change their existing API,
+   e.g. the setup becomes 'p <- progressor(along = x, enabled = progress)'.
+   The p() function created by p <- progressor(..., enable = FALSE) is an
+   empty function with near-zero overhead.
+
  * Now with_progress() and without_progress() returns the value of the
    evaluated expression.
    
diff --git a/R/progressor.R b/R/progressor.R
index 4d387b5..769c8a3 100644
--- a/R/progressor.R
+++ b/R/progressor.R
@@ -22,6 +22,11 @@
 #' @param auto_finish (logical) If TRUE, then the progressor will signal a
 #' [progression] 'finish' condition as soon as the last step has been reached.
 #'
+#' @param enable (logical) If TRUE, [progression] conditions are signaled when
+#' calling the progressor function created by this function.
+#' If FALSE, no [progression] conditions is signaled because the progressor
+#' function is an empty function that does nothing.
+#'
 #' @param on_exit,envir (logical) If TRUE, then the created progressor will
 #' signal a [progression] 'finish' condition when the calling frame exits.
 #' This is ignored if the calling frame (`envir`) is the global environment.
@@ -31,8 +36,17 @@
 #' @export
 progressor <- local({
   progressor_count <- 0L
-  
-  function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), envir = parent.frame()) {
+
+  void_progressor <- function(...) NULL
+  environment(void_progressor)$enable <- FALSE
+  class(void_progressor) <- c("progressor", class(void_progressor))
+
+  function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), label = NA_character_, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), enable = getOption("progressr.enable", TRUE), envir = parent.frame()) {
+    stop_if_not(is.logical(enable), length(enable) == 1L, !is.na(enable))
+
+    ## Quickly return a moot progressor function?
+    if (!enable) return(void_progressor)
+    
     stop_if_not(!is.null(steps) || !is.null(along))
     stop_if_not(length(steps) == 1L, is.numeric(steps), !is.na(steps),
                 steps >= 0)
@@ -123,6 +137,8 @@ print.progressor <- function(x, ...) {
   s <- c(s, paste("- progression_index:", e$progression_index))
   owner_session_uuid <- e$owner_session_uuid
   s <- c(s, paste("- owner_session_uuid:", owner_session_uuid))
+  
+  s <- c(s, paste("- enable:", e$enable))
 
   s <- paste(s, collapse = "\n")
   cat(s, "\n", sep = "")
diff --git a/man/progressor.Rd b/man/progressor.Rd
index 771b97b..2c1ff61 100644
--- a/man/progressor.Rd
+++ b/man/progressor.Rd
@@ -15,6 +15,7 @@ progressor(
   initiate = TRUE,
   auto_finish = TRUE,
   on_exit = !identical(envir, globalenv()),
+  enable = getOption("progressr.enable", TRUE),
   envir = parent.frame()
 )
 }
@@ -48,6 +49,11 @@ first argument.}
 \item{on_exit, envir}{(logical) If TRUE, then the created progressor will
 signal a \link{progression} 'finish' condition when the calling frame exits.
 This is ignored if the calling frame (\code{envir}) is the global environment.}
+
+\item{enable}{(logical) If TRUE, \link{progression} conditions are signaled when
+calling the progressor function created by this function.
+If FALSE, no \link{progression} conditions is signaled because the progressor
+function is an empty function that does nothing.}
 }
 \value{
 A function of class \code{progressor}.

From 99256ee868fce220f14d4acc77b8bd4a3060b75d Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Thu, 10 Dec 2020 17:54:44 -0800
Subject: [PATCH 88/94] TESTS: Explicitly specify the 'handlers' argument in
 all tests [ci skip]

---
 tests/with_progress,delay.R |  4 ++--
 tests/with_progress.R       | 20 ++++++++++----------
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/tests/with_progress,delay.R b/tests/with_progress,delay.R
index 3470c8f..4cd2638 100644
--- a/tests/with_progress,delay.R
+++ b/tests/with_progress,delay.R
@@ -34,9 +34,9 @@ for (delay in c(FALSE, TRUE)) {
   message(sprintf("- with_progress() - delay = %s ...", delay))
   output <- record_output({
     with_progress({
-     y <- slow_sum(x, stdout=TRUE, message=TRUE)
+      y <- slow_sum(x, stdout=TRUE, message=TRUE)
     }, delay_stdout = delay,
-       delay_conditions = if (delay) "condition" else character(0L))
+      delay_conditions = if (delay) "condition" else character(0L))
   })
   stopifnot(identical(output$stdout, output_truth$stdout))
   stopifnot(identical(output$conditions, output_truth$conditions))
diff --git a/tests/with_progress.R b/tests/with_progress.R
index 7195620..a05d773 100644
--- a/tests/with_progress.R
+++ b/tests/with_progress.R
@@ -35,7 +35,7 @@ message("with_progress() - filesize ...")
 
 with_progress({
   sum <- slow_sum(x)
-}, handler_filesize())
+}, handlers = handler_filesize())
 print(sum)
 stopifnot(sum == truth)
 
@@ -47,7 +47,7 @@ message("with_progress() - utils::txtProgressBar() ...")
 if (requireNamespace("utils")) {
   with_progress({
     sum <- slow_sum(x)
-  }, handler_txtprogressbar(style = 2L))
+  }, handlers = handler_txtprogressbar(style = 2L))
   print(sum)
   stopifnot(sum == truth)
 }
@@ -59,7 +59,7 @@ message("with_progress() - tcltk::tkProgressBar() ...")
 
 with_progress({
   sum <- slow_sum(x)
-}, handler_tkprogressbar)
+}, handlers = handler_tkprogressbar)
 
 message("with_progress() - tcltk::tkProgressBar() ... done")
 
@@ -68,7 +68,7 @@ message("with_progress() - utils::winProgressBar() ...")
 
 with_progress({
   sum <- slow_sum(x)
-}, handler_winprogressbar)
+}, handlers = handler_winprogressbar)
 
 message("with_progress() - utils::winProgressBar() ... done")
 
@@ -79,7 +79,7 @@ if (requireNamespace("progress")) {
   ## Display progress using default handler
   with_progress({
     sum <- slow_sum(x)
-  }, handler_progress(clear = FALSE))
+  }, handlers = handler_progress(clear = FALSE))
   print(sum)
   stopifnot(sum == truth)
 }
@@ -91,7 +91,7 @@ message("with_progress() - pbmcapply::progressBar() ...")
 
 with_progress({
   sum <- slow_sum(x)
-}, handler_pbmcapply)
+}, handlers = handler_pbmcapply)
 
 message("with_progress() - pbmcapply::progressBar() ... done")
 
@@ -100,7 +100,7 @@ message("with_progress() - ascii_alert ...")
 
 with_progress({
   sum <- slow_sum(x)
-}, handler_ascii_alert())
+}, handlers = handler_ascii_alert())
 print(sum)
 stopifnot(sum == truth)
 
@@ -111,7 +111,7 @@ message("with_progress() - beepr::beep() ...")
 
 with_progress({
   sum <- slow_sum(x)
-}, handler_beepr)
+}, handlers = handler_beepr)
 print(sum)
 stopifnot(sum == truth)
 
@@ -122,7 +122,7 @@ message("with_progress() - notifier::notify() ...")
 
 with_progress({
   sum <- slow_sum(x)
-}, handler_notifier)
+}, handlers = handler_notifier)
 print(sum)
 stopifnot(sum == truth)
 
@@ -134,7 +134,7 @@ message("with_progress() - void ...")
 ## Mute progress updates
 with_progress({
   sum <- slow_sum(x)
-}, NULL)
+}, handlers = NULL)
 print(sum)
 stopifnot(sum == truth)
 

From 5ca2108deee5cbd687e64f6f58412fcb8fa017d5 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Thu, 10 Dec 2020 18:15:29 -0800
Subject: [PATCH 89/94] REVDEP: 22 reverse dependencies [ci skip]

---
 revdep/README.md   |  4 ++--
 revdep/problems.md | 26 ++++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/revdep/README.md b/revdep/README.md
index 11a1997..0c1e84a 100644
--- a/revdep/README.md
+++ b/revdep/README.md
@@ -10,7 +10,7 @@
 |collate  |en_US.UTF-8                  |
 |ctype    |en_US.UTF-8                  |
 |tz       |America/Los_Angeles          |
-|date     |2020-12-07                   |
+|date     |2020-12-10                   |
 
 # Dependencies
 
@@ -43,7 +43,7 @@
 |[modeltime.resample](problems.md#modeltimeresample) |0.1.0   |      |        |1    |
 |nflfastR                                            |3.2.0   |      |        |     |
 |nlrx                                                |0.4.2   |      |        |     |
-|[pavo](problems.md#pavo)                            |2.5.0   |      |1       |     |
+|[pavo](problems.md#pavo)                            |2.5.0   |1     |1       |     |
 |poppr                                               |2.8.6   |      |        |     |
 |rainette                                            |0.1.1   |      |        |     |
 |trundler                                            |0.1.19  |      |        |     |
diff --git a/revdep/problems.md b/revdep/problems.md
index c92b05e..0ebcf82 100644
--- a/revdep/problems.md
+++ b/revdep/problems.md
@@ -216,6 +216,32 @@ Run `revdep_details(, "pavo")` for more info
 
 ## In both
 
+*   checking tests ...
+    ```
+    ...
+      Warning (test-images.R:97:3): classify
+      Warning (test-images.R:102:3): classify
+      Warning (test-images.R:121:3): classify
+      Warning (test-images.R:149:3): classify
+      Warning (test-images.R:194:3): adjacency
+      Warning (test-images.R:195:3): adjacency
+      Warning (test-images.R:214:3): adjacency
+      Warning (test-images.R:225:3): adjacency
+      Warning (test-images.R:250:3): adjacency
+      Warning (test-images.R:272:3): adjacency
+      Warning (test-images.R:286:3): summary
+      Warning (test-images.R:288:3): summary
+      FAILURE (test-images.R:291:3): summary
+      Warning (test-processing.R:12:3): Procspec
+      Warning (test-processing.R:56:3): Aggregation
+      Warning (test-vismodel.R:12:3): Warnings
+      Warning (test-vismodel.R:67:3): sensdata()
+      
+      [ FAIL 1 | WARN 1069 | SKIP 6 | PASS 377 ]
+      Error: Test failures
+      Execution halted
+    ```
+
 *   checking whether package ‘pavo’ can be installed ... WARNING
     ```
     Found the following significant warnings:

From 96511d8dc302ef37bb3401a8e091b71e258a51cb Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Thu, 10 Dec 2020 19:26:42 -0800
Subject: [PATCH 90/94] Bump develop version in order to know if people are
 using a recent version

---
 DESCRIPTION | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 3bf1544..1c3f2dc 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: progressr
-Version: 0.6.0-9000
+Version: 0.6.0-9001
 Title: An Inclusive, Unifying API for Progress Updates
 Description: A minimal, unifying API for scripts and packages to report progress updates from anywhere including when using parallel processing.  The package is designed such that the developer can to focus on what progress should be reported on without having to worry about how to present it.  The end user has full control of 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::future_map(), and 'foreach' with 'doFuture'. The package is compatible with Shiny applications.
 Authors@R: c(
@@ -22,7 +22,7 @@ Suggests:
     foreach,
     plyr,
     doFuture,
-    future (>= 1.16.0),
+    future,
     future.apply,
     furrr,
     shiny,

From 3f5a75d66fb2787c59dfaa130bf74abc060467cd Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Thu, 10 Dec 2020 19:47:53 -0800
Subject: [PATCH 91/94] Ah... managed to disable 'pbcol' in RStudio again
 [#100] [ci skip]

---
 R/handler_pbcol.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/handler_pbcol.R b/R/handler_pbcol.R
index b1fb57a..dd9b66d 100644
--- a/R/handler_pbcol.R
+++ b/R/handler_pbcol.R
@@ -39,7 +39,7 @@ handler_pbcol <- function(adjust = 0.0, pad = 1L, complete = function(s) crayon:
   
   redraw_progress_bar <- function(ratio, message, spin = " ") {
     stop_if_not(ratio >= 0, ratio <= 1)
-    if (crayon_enabled && !is.null(getOption("crayon.enabled", NULL))) {
+    if (crayon_enabled) {
       options(crayon.enabled = TRUE)
       on.exit(options(crayon.enabled = TRUE), add = TRUE)
     }

From 3483519d33ffb1faeb4b2d49c66767760431db13 Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Fri, 11 Dec 2020 11:00:44 -0800
Subject: [PATCH 92/94] REVDEP: Add R_BASE_STARTUP script
 'revdep/test_with_global_handlers.R' [ci skip]

---
 revdep/test_with_global_handlers.R | 64 ++++++++++++++++++++++++++++++
 1 file changed, 64 insertions(+)
 create mode 100644 revdep/test_with_global_handlers.R

diff --git a/revdep/test_with_global_handlers.R b/revdep/test_with_global_handlers.R
new file mode 100644
index 0000000..924f9a7
--- /dev/null
+++ b/revdep/test_with_global_handlers.R
@@ -0,0 +1,64 @@
+#' Run Reverse Package Dependency Checks with the Global Progression Handler Enabled
+#'
+#' @usage
+#' R_BASE_STARTUP="$PWD/revdep/test_with_global_handlers.R" revdep/run.R
+#'
+#' @param R_BASE_STARTUP (environment variable) An absolute path to an R
+#' script that should be loaded when the \pkg{base} package is loaded.
+#'
+#' @details
+#' This script writes log output to the "${R_BASE_STARTUP}.log" file,
+#' unless "${R_BASE_STARTUP_FILE}" is set in case that is used instead.
+#'
+#' @section Requirements:
+#' For this to work, the \file{Rprofile} of the \pkg{base} package must
+#' be tweaked. Specifically, append:
+#'
+#' ```
+#' local(if(nzchar(f<-Sys.getenv("R_BASE_STARTUP"))) source(f))
+#' ```
+#' 
+#' to file:
+#'
+#' ```
+#' rprofile <- system.file(package = "base", "R", "Rprofile")
+#' ```
+#'
+#' This requires write permissions to that file.
+#'
+#' @examples
+#' R_BASE_STARTUP="$PWD/revdep/test_with_global_handlers.R" revdep/run.R
+#'
+#' @importFrom utils packageVersion
+#' @importFrom progressr handlers
+local({
+  log_ <- function(..., prefix = sprintf("[%s/%d]: ", Sys.time(), Sys.getpid()), newline = TRUE, tee = stdout(), logfile = Sys.getenv("R_BASE_STARTUP_FILE")) {
+    if (!nzchar(logfile)) {
+      logfile <- Sys.getenv("R_BASE_STARTUP")
+      logfile <- if (nzchar(logfile)) sprintf("%s.log", logfile) else NULL
+    }
+    msg <- sprintf(...)
+    if (newline) msg <- paste(msg, "\n", sep = "")
+    msg <- paste(prefix, msg, sep = "")
+    msg <- paste(msg, collapse="")
+    if (!is.null(tee)) cat(msg, file = tee, append = TRUE)
+    if (!is.null(logfile)) cat(msg, file = logfile, append = TRUE)
+  }
+
+  ## R CMD check package tests?
+  if (nzchar(testfile <- Sys.getenv("R_TESTS"))) {
+    log_("commandArgs()=%s", paste(commandArgs(), collapse = " "))
+    log_("R_LIBS_USER=%s", sQuote(Sys.getenv("R_LIBS_USER")))
+    log_("R_LIBS_SITE=%s", sQuote(Sys.getenv("R_LIBS_SITE")))
+    log_("R_LIBS=%s", sQuote(Sys.getenv("R_LIBS")))
+    log_(".libPaths()=%s", paste(.libPaths(), collapse = " "))
+    log_("R_TESTS=%s", sQuote(testfile))
+    log_("getwd()=%s", getwd())
+
+    ## Enable global progression handlers, if available
+    if (requireNamespace("progressr", quietly = TRUE) && utils::packageVersion("progressr") >= "0.6.0-9001") {
+      progressr::handlers(global = TRUE)
+      log_("progressr::handlers(global=NA)=%s", progressr::handlers(global=NA))
+    }
+  }
+})

From a94b6b8931bacc27845907238907a6651c7b70ed Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Fri, 11 Dec 2020 12:56:59 -0800
Subject: [PATCH 93/94] REVDEP: 22 packages with global handler enabled [#95]
 [ci skip]

---
 revdep/global_handler_checks/README.md        |  50 ++++
 revdep/global_handler_checks/cran.md          |   7 +
 revdep/global_handler_checks/failures.md      |   1 +
 .../inject.R}                                 |   5 +-
 revdep/global_handler_checks/problems.md      | 251 ++++++++++++++++++
 5 files changed, 310 insertions(+), 4 deletions(-)
 create mode 100644 revdep/global_handler_checks/README.md
 create mode 100644 revdep/global_handler_checks/cran.md
 create mode 100644 revdep/global_handler_checks/failures.md
 rename revdep/{test_with_global_handlers.R => global_handler_checks/inject.R} (93%)
 create mode 100644 revdep/global_handler_checks/problems.md

diff --git a/revdep/global_handler_checks/README.md b/revdep/global_handler_checks/README.md
new file mode 100644
index 0000000..3c889cd
--- /dev/null
+++ b/revdep/global_handler_checks/README.md
@@ -0,0 +1,50 @@
+# Platform
+
+|field    |value                        |
+|:--------|:----------------------------|
+|version  |R version 4.0.2 (2020-06-22) |
+|os       |CentOS Linux 7 (Core)        |
+|system   |x86_64, linux-gnu            |
+|ui       |X11                          |
+|language |en                           |
+|collate  |en_US.UTF-8                  |
+|ctype    |en_US.UTF-8                  |
+|tz       |America/Los_Angeles          |
+|date     |2020-12-11                   |
+
+# Dependencies
+
+|package   |old    |new        |Δ  |
+|:---------|:------|:----------|:--|
+|progressr |0.6.0  |0.6.0-9001 |*  |
+|digest    |0.6.27 |0.6.27     |   |
+
+# Revdeps
+
+## All (22)
+
+|package                                             |version |error |warning |note |
+|:---------------------------------------------------|:-------|:-----|:-------|:----|
+|[cSEM](problems.md#csem)                            |0.3.0   |      |        |1    |
+|dipsaus                                             |0.1.1   |      |        |     |
+|econet                                              |0.1.92  |      |        |     |
+|[EFAtools](problems.md#efatools)                    |0.3.0   |      |        |2    |
+|[EpiNow2](problems.md#epinow2)                      |1.3.1   |      |        |2    |
+|epwshiftr                                           |0.1.1   |      |        |     |
+|fabletools                                          |0.2.1   |      |        |     |
+|funGp                                               |0.2.1   |      |        |     |
+|furrr                                               |0.2.1   |      |        |     |
+|gtfs2gps                                            |1.3-2   |      |        |     |
+|lightr                                              |1.3     |      |        |     |
+|[lmtp](problems.md#lmtp)                            |0.0.5   |      |        |2    |
+|mlr3                                                |0.9.0   |      |        |     |
+|[modeltime](problems.md#modeltime)                  |0.4.0   |1     |        |1    |
+|[modeltime.ensemble](problems.md#modeltimeensemble) |0.3.0   |      |        |1    |
+|[modeltime.resample](problems.md#modeltimeresample) |0.1.0   |      |        |1    |
+|nflfastR                                            |3.2.0   |      |        |     |
+|nlrx                                                |0.4.2   |      |        |     |
+|[pavo](problems.md#pavo)                            |2.5.0   |1     |1       |     |
+|poppr                                               |2.8.6   |      |        |     |
+|rainette                                            |0.1.1   |      |        |     |
+|trundler                                            |0.1.19  |      |        |     |
+
diff --git a/revdep/global_handler_checks/cran.md b/revdep/global_handler_checks/cran.md
new file mode 100644
index 0000000..acb84fc
--- /dev/null
+++ b/revdep/global_handler_checks/cran.md
@@ -0,0 +1,7 @@
+## revdepcheck results
+
+We checked 22 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package.
+
+ * We saw 0 new problems
+ * We failed to check 0 packages
+
diff --git a/revdep/global_handler_checks/failures.md b/revdep/global_handler_checks/failures.md
new file mode 100644
index 0000000..9a20736
--- /dev/null
+++ b/revdep/global_handler_checks/failures.md
@@ -0,0 +1 @@
+*Wow, no problems at all. :)*
\ No newline at end of file
diff --git a/revdep/test_with_global_handlers.R b/revdep/global_handler_checks/inject.R
similarity index 93%
rename from revdep/test_with_global_handlers.R
rename to revdep/global_handler_checks/inject.R
index 9c37706..7ed0c6b 100644
--- a/revdep/test_with_global_handlers.R
+++ b/revdep/global_handler_checks/inject.R
@@ -1,7 +1,7 @@
 #' Run Reverse Package Dependency Checks with the Global Progression Handler Enabled
 #'
 #' @usage
-#' R_BASE_STARTUP="$PWD/revdep/test_with_global_handlers.R" revdep/run.R
+#' R_BASE_STARTUP="$PWD/revdep/global_handler_checks/inject.R" revdep/run.R
 #'
 #' @param R_BASE_STARTUP (environment variable) An absolute path to an R
 #' script that should be loaded when the \pkg{base} package is loaded.
@@ -26,9 +26,6 @@
 #'
 #' This requires write permissions to that file.
 #'
-#' @examples
-#' R_BASE_STARTUP="$PWD/revdep/test_with_global_handlers.R" revdep/run.R
-#'
 #' @importFrom utils packageVersion
 #' @importFrom progressr handlers
 local({
diff --git a/revdep/global_handler_checks/problems.md b/revdep/global_handler_checks/problems.md
new file mode 100644
index 0000000..0ebcf82
--- /dev/null
+++ b/revdep/global_handler_checks/problems.md
@@ -0,0 +1,251 @@
+# cSEM
+
+

+
+* Version: 0.3.0
+* GitHub: https://github.com/M-E-Rademaker/cSEM
+* Source code: https://github.com/cran/cSEM
+* Date/Publication: 2020-10-12 16:40:03 UTC
+* Number of recursive dependencies: 119
+
+Run `revdep_details(, "cSEM")` for more info
+
+

+
+## In both
+
+*   checking dependencies in R code ... NOTE
+    ```
+    Namespace in Imports field not imported from: ‘Rdpack’
+      All declared Imports should be used.
+    ```
+
+# EFAtools
+
+

+
+* Version: 0.3.0
+* GitHub: https://github.com/mdsteiner/EFAtools
+* Source code: https://github.com/cran/EFAtools
+* Date/Publication: 2020-11-04 18:00:02 UTC
+* Number of recursive dependencies: 88
+
+Run `revdep_details(, "EFAtools")` for more info
+
+

+
+## In both
+
+*   checking installed package size ... NOTE
+    ```
+      installed size is  7.4Mb
+      sub-directories of 1Mb or more:
+        doc    1.0Mb
+        libs   5.5Mb
+    ```
+
+*   checking dependencies in R code ... NOTE
+    ```
+    Namespace in Imports field not imported from: ‘progress’
+      All declared Imports should be used.
+    ```
+
+# EpiNow2
+
+

+
+* Version: 1.3.1
+* GitHub: NA
+* Source code: https://github.com/cran/EpiNow2
+* Date/Publication: 2020-11-22 14:20:05 UTC
+* Number of recursive dependencies: 149
+
+Run `revdep_details(, "EpiNow2")` for more info
+
+

+
+## In both
+
+*   checking package dependencies ... NOTE
+    ```
+    Package suggested but not available for checking: ‘EpiSoon’
+    ```
+
+*   checking installed package size ... NOTE
+    ```
+      installed size is 137.8Mb
+      sub-directories of 1Mb or more:
+        libs  136.4Mb
+    ```
+
+# lmtp
+
+

+
+* Version: 0.0.5
+* GitHub: NA
+* Source code: https://github.com/cran/lmtp
+* Date/Publication: 2020-07-18 09:10:02 UTC
+* Number of recursive dependencies: 86
+
+Run `revdep_details(, "lmtp")` for more info
+
+

+
+## In both
+
+*   checking package dependencies ... NOTE
+    ```
+    Package which this enhances but not available for checking: ‘sl3’
+    ```
+
+*   checking dependencies in R code ... NOTE
+    ```
+    Namespaces in Imports field not imported from:
+      ‘R6’ ‘nnls’ ‘utils’
+      All declared Imports should be used.
+    ```
+
+# modeltime
+
+

+
+* Version: 0.4.0
+* GitHub: https://github.com/business-science/modeltime
+* Source code: https://github.com/cran/modeltime
+* Date/Publication: 2020-11-23 08:50:05 UTC
+* Number of recursive dependencies: 195
+
+Run `revdep_details(, "modeltime")` for more info
+
+

+
+## In both
+
+*   checking tests ...
+    ```
+    ...
+      Error: unable to start device PNG
+      Backtrace:
+          █
+       1. ├─base::suppressWarnings(...) test-results-forecast-plots.R:34:0
+       2. │ └─base::withCallingHandlers(...)
+       3. ├─forecast_tbl %>% mutate_at(vars(.value:.conf_hi), exp) %>% plot_modeltime_forecast(.interactive = TRUE) test-results-forecast-plots.R:36:4
+       4. └─modeltime::plot_modeltime_forecast(., .interactive = TRUE)
+       5.   ├─plotly::ggplotly(g, dynamicTicks = TRUE)
+       6.   └─plotly:::ggplotly.ggplot(g, dynamicTicks = TRUE)
+       7.     └─plotly::gg2list(...)
+       8.       └─grDevices:::dev_fun(...)
+      
+      ── Skipped tests  ──────────────────────────────────────────────────────────────
+      ● On CRAN (7)
+      
+      ══ testthat results  ═══════════════════════════════════════════════════════════
+      ERROR (test-results-forecast-plots.R:34:1): (code run outside of `test_that()`)
+      
+      [ FAIL 1 | WARN 0 | SKIP 7 | PASS 473 ]
+      Error: Test failures
+      Execution halted
+    ```
+
+*   checking dependencies in R code ... NOTE
+    ```
+    Namespace in Imports field not imported from: ‘slider’
+      All declared Imports should be used.
+    ```
+
+# modeltime.ensemble
+
+

+
+* Version: 0.3.0
+* GitHub: https://github.com/business-science/modeltime.ensemble
+* Source code: https://github.com/cran/modeltime.ensemble
+* Date/Publication: 2020-11-06 18:00:02 UTC
+* Number of recursive dependencies: 190
+
+Run `revdep_details(, "modeltime.ensemble")` for more info
+
+

+
+## In both
+
+*   checking dependencies in R code ... NOTE
+    ```
+    Namespaces in Imports field not imported from:
+      ‘crayon’ ‘dials’ ‘glmnet’ ‘parsnip’ ‘progressr’ ‘utils’
+      All declared Imports should be used.
+    ```
+
+# modeltime.resample
+
+

+
+* Version: 0.1.0
+* GitHub: https://github.com/business-science/modeltime.resample
+* Source code: https://github.com/cran/modeltime.resample
+* Date/Publication: 2020-11-05 07:40:09 UTC
+* Number of recursive dependencies: 194
+
+Run `revdep_details(, "modeltime.resample")` for more info
+
+

+
+## In both
+
+*   checking dependencies in R code ... NOTE
+    ```
+    Namespaces in Imports field not imported from:
+      ‘crayon’ ‘dials’ ‘glue’ ‘parsnip’
+      All declared Imports should be used.
+    ```
+
+# pavo
+
+

+
+* Version: 2.5.0
+* GitHub: https://github.com/rmaia/pavo
+* Source code: https://github.com/cran/pavo
+* Date/Publication: 2020-11-12 09:00:02 UTC
+* Number of recursive dependencies: 101
+
+Run `revdep_details(, "pavo")` for more info
+
+

+
+## In both
+
+*   checking tests ...
+    ```
+    ...
+      Warning (test-images.R:97:3): classify
+      Warning (test-images.R:102:3): classify
+      Warning (test-images.R:121:3): classify
+      Warning (test-images.R:149:3): classify
+      Warning (test-images.R:194:3): adjacency
+      Warning (test-images.R:195:3): adjacency
+      Warning (test-images.R:214:3): adjacency
+      Warning (test-images.R:225:3): adjacency
+      Warning (test-images.R:250:3): adjacency
+      Warning (test-images.R:272:3): adjacency
+      Warning (test-images.R:286:3): summary
+      Warning (test-images.R:288:3): summary
+      FAILURE (test-images.R:291:3): summary
+      Warning (test-processing.R:12:3): Procspec
+      Warning (test-processing.R:56:3): Aggregation
+      Warning (test-vismodel.R:12:3): Warnings
+      Warning (test-vismodel.R:67:3): sensdata()
+      
+      [ FAIL 1 | WARN 1069 | SKIP 6 | PASS 377 ]
+      Error: Test failures
+      Execution halted
+    ```
+
+*   checking whether package ‘pavo’ can be installed ... WARNING
+    ```
+    Found the following significant warnings:
+      Warning: no DISPLAY variable so Tk is not available
+    See ‘/c4/home/henrik/repositories/progressr/revdep/checks/pavo/new/pavo.Rcheck/00install.out’ for details.
+    ```
+

From f73e6818d184e04fff9590cdda6d6a4abf2624bd Mon Sep 17 00:00:00 2001
From: Henrik Bengtsson 
Date: Fri, 11 Dec 2020 13:44:54 -0800
Subject: [PATCH 94/94] progressr 0.7.0

---
 DESCRIPTION      |  2 +-
 NEWS             |  2 +-
 cran-comments.md | 24 ++++++++++++------------
 3 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 1c3f2dc..41ed34e 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: progressr
-Version: 0.6.0-9001
+Version: 0.7.0
 Title: An Inclusive, Unifying API for Progress Updates
 Description: A minimal, unifying API for scripts and packages to report progress updates from anywhere including when using parallel processing.  The package is designed such that the developer can to focus on what progress should be reported on without having to worry about how to present it.  The end user has full control of 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::future_map(), and 'foreach' with 'doFuture'. The package is compatible with Shiny applications.
 Authors@R: c(
diff --git a/NEWS b/NEWS
index ae4d5c8..8378e16 100644
--- a/NEWS
+++ b/NEWS
@@ -1,7 +1,7 @@
 Package: progressr
 ==================
 
-Version: 0.6.0-9000 [2020-12-10]
+Version: 0.7.0 [2020-12-11]
 
 SIGNIFICANT CHANGES:
 
diff --git a/cran-comments.md b/cran-comments.md
index 91f7ab3..370299a 100644
--- a/cran-comments.md
+++ b/cran-comments.md
@@ -1,10 +1,10 @@
-# CRAN submission progressr 0.6.0
+# CRAN submission progressr 0.7.0
 
-on 2020-05-18
+on 2020-12-11
 
-I've verified that this submission does not cause issues for the 6 reverse package dependency available on CRAN.
+I've verified this submission have no negative impact on any of the 22 reverse package dependencies available on CRAN and Bioconductor.
 
-Thanks in advance
+Thank you
 
 
 ## Notes not sent to CRAN
@@ -13,12 +13,12 @@ Thanks in advance
 
 The package has been verified using `R CMD check --as-cran` on:
 
-| R version          | GitHub Actions | Travis CI | AppVeyor CI | Rhub      | Win-builder | Other  |
-| ------------------ | -------------- | --------- | ----------- | --------- | ----------- | ------ |
-| 3.4.4              | L              |           |             |           |             |        |
-| 3.5.3              | L, M, W        |           |             |           |             |        |
-| 3.6.3              | L, M, W        | L, M      | W           | L         |             |        |
-| 4.0.0              | L, M, W        | L, M      | W           | S (32)    | W           |        |
-| devel              |    M  W        | L         | W (32 & 64) | L, W      | W           |        |
+| R version | GitHub Actions | Travis | AppVeyor  | R-hub    | win-builder |
+| --------- | -------------- | ------ | --------- | -------- | ----------- |
+| 3.4.x     | L              |        |           |          |             |
+| 3.5.x     | L M W          |        |           |          |             |
+| 3.6.x     | L M W          | L M    |           |          |             |
+| 4.0.x     | L M W          | L      | W         |        S | W           |
+| devel     |   M W          | L      | W (32&64) |          | W           |
 
-*Legend: OS: L = Linux, S = Solaris, M = macOS, W = Windows.  Architecture: 32 = 32-bit, 64 = 64-bit*
+*Legend: OS: L = Linux S = Solaris M = macOS W = Windows*