progressr/0000755000175000017500000000000014157525752012447 5ustar nileshnileshprogressr/demo/0000755000175000017500000000000014122707130013353 5ustar nileshnileshprogressr/demo/00Index0000644000175000017500000000011314122707130014500 0ustar nileshnileshmandelbrot Produce Mandelbrot Set Images in Parallel with Progress Updates progressr/demo/mandelbrot.R0000644000175000017500000000513714122707130015633 0ustar nileshnileshlibrary(progressr) library(future) library(graphics) p <- function(...) NULL plot_what_is_done <- function(counts) { done <- 0L for (kk in seq_along(counts)) { f <- counts[[kk]] ## Already plotted? if (!inherits(f, "Future")) { done <- done + 1L next } ## Not resolved? ## NOTE: This will block, if all workers are busy! if (runif(1) < 0.8*(1-(done/length(counts))) || !resolved(f)) next message(sprintf("Plotting tile #%d of %d ...", kk, n)) counts[[kk]] <- value(f) screen(kk) plot(counts[[kk]]) done <- done + 1L } counts } ## Options region <- getOption("future.demo.mandelbrot.region", 1L) if (!is.list(region)) { if (region == 1L) { region <- list(xmid = -0.75, ymid = 0.0, side = 3.0) } else if (region == 2L) { region <- list(xmid = 0.283, ymid = -0.0095, side = 0.00026) } else if (region == 3L) { region <- list(xmid = 0.282989, ymid = -0.01, side = 3e-8) } } nrow <- getOption("future.demo.mandelbrot.nrow", 5L) resolution <- getOption("future.demo.mandelbrot.resolution", 1024L) delay <- getOption("future.demo.mandelbrot.delay", interactive()) if (isTRUE(delay)) { delay <- function(counts) Sys.sleep(runif(1L, min=0.5, max=5)) } else if (!is.function(delay)) { delay <- function(counts) {} } ## Generate Mandelbrot tiles to be computed Cs <- mandelbrot_tiles(xmid = region$xmid, ymid = region$ymid, side = region$side, nrow = nrow, resolution = resolution) message("Tiles: ", paste(dim(Cs), collapse = " by ")) if (interactive()) { dev.new() plot.new() split.screen(dim(Cs)) for (ii in seq_along(Cs)) { screen(ii) par(mar = c(0, 0, 0, 0)) text(x = 1 / 2, y = 1 / 2, sprintf("Future #%d\nunresolved", ii), cex = 2) } } else { split.screen(dim(Cs)) } ## Create all Mandelbrot tiles via lazy futures n <- length(Cs) message(sprintf("* Creating %d Mandelbrot tiles", n)) with_progress({ p <- progressor(along = Cs) counts <- lapply(seq_along(Cs), FUN=function(ii) { C <- Cs[[ii]] future({ message(sprintf("Calculating tile #%d of %d ...", ii, n), appendLF = FALSE) fit <- mandelbrot(C) ## Emulate slowness delay(fit) p(sprintf("Tile #%d by %d", ii, Sys.getpid())) message(" done") fit }, lazy = TRUE) }) str(counts) pp <- 0L while (any(sapply(counts, FUN = inherits, "Future"))) { counts <- plot_what_is_done(counts) } }) close.screen() message("SUGGESTION: Try to rerun this demo after changing strategy for how futures are resolved, e.g. plan(multisession).\n") progressr/MD50000644000175000017500000001430314157525752012760 0ustar nileshnileshf303a2e640e7498ce41ece013a4b2ac0 *DESCRIPTION b5eaa1648514ef4d38fd8bea0ac5d674 *NAMESPACE 16e3773d79d767290b94777f433a0bdd *NEWS ca4e68b5ea80bd70b2724fa4329ea11c *R/control_progression.R cc260e236c304a71497fd71481494cc5 *R/delays.R 291e0993695eec7e163cddd049cc9b0b *R/global_progression_handler.R 508a0ae3339cf6b288a7895d80b8fb18 *R/handler_ascii_alert.R e318880a6a7d6a4d20ad5dfb2557fe2b *R/handler_beepr.R eb0511049f73efaccede298394a9ffce *R/handler_debug.R 6da01ecfac6bedb883d5661d027be817 *R/handler_filesize.R e5d91658f210d66db0b0e84d84f669db *R/handler_newline.R 255f39d243223a4cc2ef48f82e615522 *R/handler_notifier.R 191eb9f1c63464a1be4756ef94390bd5 *R/handler_pbcol.R 622c79f65b9300b656374e6cc72ecc8d *R/handler_pbmcapply.R 3fc0ba5144b4761698f360094ec6d23f *R/handler_progress.R ff9fc66c7c1e9754f71c53cb90ab9122 *R/handler_rstudio.R 82e54fcb3d4296c21e17baaeffbbeba4 *R/handler_shiny.R 16bb697bb8b17f90c092af3ccbab7436 *R/handler_tkprogressbar.R bc59c48229e849423cbf57d9b28b984f *R/handler_txtprogressbar.R bae4ae516c64eabbbf241e5e80617474 *R/handler_void.R 42c1361dbd0be9a44c23cc60026982a5 *R/handler_winprogressbar.R 7b8847256bc6e019a1f0c4977a46ab0a *R/handlers.R e99316c74489ef48fe9ec4ca2dae5aae *R/make_calling_handler.R ad69285abe7b39084c0ca68af9f38f8c *R/make_progression_handler.R 62c826126fc5a51dd2aa42d3678e8429 *R/options.R b0c7a75a229ea2edc04aca48a732a5ef *R/plyr_progress_progressr.R 86775a75375a856a36d0d1bd3261ac62 *R/progress.R 2030e8c3145f09fbec7b19e5446de169 *R/progress_aggregator.R 21d29e39cb15c263117b7b3ae55597c3 *R/progression.R eca0dab1769e8cb24bdb80602d656bd3 *R/progressor.R 5a540a38cc1bc3dc3eaecf3bed90bc7c *R/progressr-package.R fd7f3168b7da574f470d5b1889781af9 *R/slow_sum.R a9d42c053369ac4cafd8bc6f651269e8 *R/utils.R ae88bc828f20ebb863643b1e06d848c2 *R/uuid.R f076f30584783a7e8cd6c62789c01eab *R/vignette_engine.R 7a60e236626d1927c6d29e29183e25c9 *R/withProgressShiny.R 370dd1972cae729251e6f6b045e44a29 *R/with_progress.R 007cfeed173d40dd2a556faf5c429c7f *R/without_progress.R 8eae6b0df854b1378a129a3319b3b693 *R/zzz.R b6532df4713a6b88f4a10c915beee5c7 *build/vignette.rds d56c68ebdab92d0f077908f65c87ada0 *demo/00Index d4fa53ea06e99a2353c843499d8720d2 *demo/mandelbrot.R bf20ab209a8398badf943482d88c8fa6 *inst/WORDLIST 685c88cceeec3eeac5c2a16b6705a4c5 *inst/doc/progressr-intro.html 42ca58a83483babee4d60ba749842c5f *inst/doc/progressr-intro.md 952b59dc07b171b97d5d982924244f61 *man/figures/lifecycle-maturing-blue.svg 966494846ce67a38414451e1d54e74a5 *man/global_progression_handler.Rd ac94f6f5e701ee6014d6230ce282d7fc *man/handler_ascii_alert.Rd 72eb682359475518af4aba2c84369d37 *man/handler_beepr.Rd acceebb4c07bd149e93fd6614c97fc37 *man/handler_debug.Rd 28dae4355e53364cce6f20cbd6fa9805 *man/handler_filesize.Rd 0d98283c2f148f8bfdd36e4e60888e91 *man/handler_newline.Rd 118fe9a47f22b954b7cc00295d94a96e *man/handler_notifier.Rd 9290bfdfecbb721e41efa5e3a57f6e76 *man/handler_pbcol.Rd a81212fbc7be8105969e2429495b2738 *man/handler_pbmcapply.Rd dffc427c4fa8e5b900a8f9118737bced *man/handler_progress.Rd aef8897714945ebac9768d69e4f3e66f *man/handler_rstudio.Rd 76f446a661545767cb2a2bca7c9ec0bb *man/handler_shiny.Rd 8e3a6d334f29e44073faaaf2f053dae0 *man/handler_tkprogressbar.Rd c5d352a489e3fe23fd4254556b13bbc1 *man/handler_txtprogressbar.Rd a61771f17d296e0e62e3e477b67c45ee *man/handler_void.Rd 0d70e0911808ab9ed51e24c2c855220a *man/handler_winprogressbar.Rd 94341f3b3a916b3b2f7fe19791c286d2 *man/handlers.Rd e1c9d47481a8c55bcd461037332b5d16 *man/make_progression_handler.Rd 80c5f37eed410fc22ab60c0271308de6 *man/progress.Rd 31a3604ef1f7843bd3c617d04877a64d *man/progress_aggregator.Rd fd19d84dd20db252fde2428f52a0a0e4 *man/progress_progressr.Rd 610e4efc1e01198e9e0eff2f517a0970 *man/progression.Rd 718c0a14c43550a500c898dda705f003 *man/progressor.Rd 3c2a6713d022ee562e615169a8b2fb99 *man/progressr.Rd 3b5292f9bc93d2d1fcf415e3a1e419c0 *man/progressr.options.Rd 980b91430fca12e6d5d4158f86f6362b *man/register_global_progression_handler.Rd 4cbba14ee67278717a389a1bb7734590 *man/slow_sum.Rd 527963d0e29c5c09cd40c6acbba1deb0 *man/withProgressShiny.Rd 44ccb10ee17e05407f9719e1e80ba366 *man/with_progress.Rd 1d17fb5e6992e02da4ad13e2d0054f27 *tests/debug.R 3f26e0fd0fe95dbac5d103fe32091c65 *tests/demo.R e77349394a20962ef248c90525385cb3 *tests/exceptions.R bfde3b6f330aeb18e4df205bac6b1e63 *tests/globals,relay.R fd3c27701d6e1ba9dcc3a4375fae493d *tests/handler_make_progression.R 96a869bc3c8db8e294b1d6c72f8c6c99 *tests/handler_pbmcapply.R 3f45106f41f04c53e8eb4aa7db528f43 *tests/handler_progress.R 18f04ac17ca4e55b8b191153530d9104 *tests/handler_rstudio.R 3b78ed6be2a4fa155856bd6d4f747508 *tests/handler_shiny.R bf9db10a7ba4d8e330be1cf2ace85411 *tests/handler_tkprogressbar.R 17ae8bc6b9c5a42bf3f006b087b0ea53 *tests/handler_txtprogressbar.R 895c2e0fb23725c90b454c102030459a *tests/handlers.R de96a98bbdd939c26009df32797ffa39 *tests/incl/end.R 08b1e7e727d984b0bcb425c1e73588cd *tests/incl/start,load-only.R 9f50fddf238c62b09154f45afc05d00f *tests/incl/start.R 36416eef18b28f65a0584dfd4e236135 *tests/progress_aggregator.R 7e7d808ff33330f00e940b601534cdef *tests/progression.R 6587925717eb326ce06af3dc7363d079 *tests/progressor.R bc6d7afb4ebcd2b44779f4ff07d9c294 *tests/utils.R 195952eca2ce9f258364c56e597071a1 *tests/with_progress,delay.R 547b21ed1e0fa897d67e83d9fabd3c27 *tests/with_progress,relay.R 0f942541052b4826a666f5a4abbc0316 *tests/with_progress.R 0fe40b0cde26913f1dcacdf7fa95c777 *tests/without_progress.R 14343570efcab65bf1934457e9f4afb5 *tests/zzz,doFuture.R fe912601e651eb68837fe1ce7baaef04 *tests/zzz,foreach_do.R ce63b44621aed285dea0257572977e95 *tests/zzz,furrr.R c8395f82b2a74348ce3ab4a7cb2ea6b8 *tests/zzz,future.apply.R ef09cb5c2f7aa2eb916c65e9ee7f3af8 *tests/zzz,plyr.R 02d2faa99aa3a0a5ce25b0e31e223180 *tests/zzz,purrr.R afd95434deb4b30934ef3f4c9e823631 *tests/zzz,shiny.R b5e41bbd860248a5689abfbc1eafd529 *vignettes/imgs/3steps-beepr.svg e36d09d504ca54f01455af2ce2efa119 *vignettes/imgs/3steps.svg bbcac3e7987ce407012c6e4547479671 *vignettes/imgs/Makefile 952b59dc07b171b97d5d982924244f61 *vignettes/imgs/lifecycle-maturing-blue.svg 6cc2f0842bacb282f5802897adaf449c *vignettes/imgs/slow_sum.svg ea6227b1a9ee30152c5f4ae07f3bdf1b *vignettes/imgs/three_in_chinese.gif 6359b734e1ac2816edd85302efc5fc04 *vignettes/incl/clean.css 42ca58a83483babee4d60ba749842c5f *vignettes/progressr-intro.md progressr/DESCRIPTION0000644000175000017500000000404314157525752014156 0ustar nileshnileshPackage: progressr Version: 0.10.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 API:s 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"), email = "henrikb@braju.com")) License: GPL (>= 3) Depends: R (>= 3.5.0) Imports: digest, utils Suggests: graphics, tcltk, beepr, crayon, pbmcapply, progress, purrr, foreach, plyr, doFuture, future, future.apply, furrr, rstudioapi, shiny, commonmark, base64enc, tools VignetteBuilder: progressr URL: https://progressr.futureverse.org, https://github.com/HenrikBengtsson/progressr BugReports: https://github.com/HenrikBengtsson/progressr/issues RoxygenNote: 7.1.2 NeedsCompilation: no Packaged: 2021-12-19 02:09:26 UTC; hb Author: Henrik Bengtsson [aut, cre, cph] Maintainer: Henrik Bengtsson Repository: CRAN Date/Publication: 2021-12-19 03:50:02 UTC progressr/man/0000755000175000017500000000000014123360236013205 5ustar nileshnileshprogressr/man/global_progression_handler.Rd0000644000175000017500000000107414122707130021062 0ustar nileshnilesh% 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(condition) } \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} progressr/man/handler_shiny.Rd0000644000175000017500000000332214122707130016320 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_shiny.R \name{handler_shiny} \alias{handler_shiny} \title{Progression Handler: Progress Reported via 'shiny' Widgets (GUI) in the HTML Browser} \usage{ handler_shiny( intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", inputs = list(message = NULL, detail = "message"), ... ) } \arguments{ \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{inputs}{(named list) Specifies from what sources the Shiny progress elements 'message' and 'detail' should be updated. Valid sources are \code{"message"}, \code{"sticky_message"} and \code{"non_sticky_message"}, where \code{"message"} is short for \code{c("non_sticky_message", "sticky_message")}. For example, \code{inputs = list(message = "sticky-message", detail = "message")} will update the Shiny 'message' component from sticky messages only, whereas the 'detail' component is updated using any message.} \item{\ldots}{Additional arguments passed to \code{\link[=make_progression_handler]{make_progression_handler()}}.} } \description{ A progression handler for \pkg{shiny} and \code{\link[shiny:withProgress]{shiny::withProgress()}}. } \details{ For most Shiny application there is little need to use this Shiny handler directly. Instead, it is sufficient to use \code{\link[=withProgressShiny]{withProgressShiny()}}. } \section{Requirements}{ This progression handler requires the \pkg{shiny} package. } \examples{ \donttest{\dontrun{ handlers(handler_shiny()) with_progress(y <- slow_sum(1:100)) }} } \keyword{internal} progressr/man/handler_filesize.Rd0000644000175000017500000000270014122707130016777 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_filesize.R \name{handler_filesize} \alias{handler_filesize} \title{Progression Handler: Progress Reported as the Size of a File on the File System} \usage{ handler_filesize( file = "default.progress", intrusiveness = getOption("progressr.intrusiveness.file", 5), target = "file", ... ) } \arguments{ \item{file}{(character) A filename.} \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 the Size of a File on the File System } \details{ This progression handler reports progress by updating the size of a file on the file system. This provides a convenient way for an R script running in batch mode to report on the progress such that the user can peek at the file size (by default in 0-100 bytes) to assess the amount of the progress made, e.g. \verb{ls -l -- *.progress}. If the \file{*.progress} file is accessible via for instance SSH, SFTP, FTPS, HTTPS, etc., then progress can be assessed from a remote location. } \examples{ \donttest{\dontrun{ handlers(handler_filesize(file = "myscript.progress")) with_progress(y <- slow_sum(1:100)) print(y) }} } progressr/man/progressor.Rd0000644000175000017500000000445314123360236015707 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/progressor.R \name{progressor} \alias{progressor} \title{Create a Progressor Function that Signals Progress Updates} \usage{ progressor( steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), label = NA_character_, trace = FALSE, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), enable = getOption("progressr.enable", TRUE), envir = parent.frame() ) } \arguments{ \item{steps}{(integer) Number of progressing steps.} \item{along}{(vector; alternative) Alternative that sets \code{steps = length(along)}.} \item{offset, scale}{(integer; optional) scale and offset applying transform \code{steps <- scale * steps + offset}.} \item{transform}{(function; optional) A function that takes the effective number of \code{steps} as input and returns another finite and non-negative number of steps.} \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.} \item{trace}{(logical) If TRUE, then the call stack is recorded, otherwise not.} \item{initiate}{(logical) If TRUE, the progressor will signal a \link{progression} 'initiate' condition when created.} \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.} \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}. } \description{ Create a Progressor Function that Signals Progress Updates } progressr/man/make_progression_handler.Rd0000644000175000017500000000471514122707130020544 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make_progression_handler.R \name{make_progression_handler} \alias{make_progression_handler} \title{Creates a Progression Calling Handler} \usage{ make_progression_handler( name, reporter = list(), handler = NULL, enable = getOption("progressr.enable", interactive()), enable_after = getOption("progressr.enable_after", 0), times = getOption("progressr.times", +Inf), interval = getOption("progressr.interval", 0), intrusiveness = 1, clear = getOption("progressr.clear", TRUE), target = "terminal", ... ) } \arguments{ \item{name}{(character) Name of progression handler.} \item{reporter}{(environment) A reporter environment.} \item{handler}{(function) Function take a \link{progression} condition as the first argument.} \item{enable}{(logical) If FALSE, then progress is not reported.} \item{enable_after}{(numeric) Delay (in seconds) before progression updates are reported.} \item{times}{(numeric) The maximum number of times this handler should report progression updates. If zero, then progress is not reported.} \item{interval}{(numeric) The minimum time (in seconds) between successive progression updates from this handler.} \item{intrusiveness}{(numeric) A non-negative scalar on how intrusive (disruptive) the reporter to the user.} \item{clear}{(logical) If TRUE, any output, typically visual, produced by a reporter will be cleared/removed upon completion, if possible.} \item{target}{(character vector) Specifies where progression updates are rendered.} \item{\ldots}{Additional arguments passed to \code{\link[=make_progression_handler]{make_progression_handler()}} or not used.} } \value{ 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:conditions]{base::condition} as its first argument and that can be use together with \code{\link[base:conditions]{base::withCallingHandlers()}}. This function helps creating such progression calling handler functions. } \details{ The inner details of progression handlers and how to use this function are still to be documented. Until then, see the source code of existing handlers for how it is used, e.g. \code{progressr::handler_txtprogressbar}. Please use with care as things might change. } \seealso{ \code{\link[base:conditions]{base::withCallingHandlers()}}. } \keyword{internal} progressr/man/register_global_progression_handler.Rd0000644000175000017500000000250014122707130022761 0ustar nileshnilesh% 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" && !is.element("pkgdown", loadedNamespaces()))} handlers(global = TRUE) ## 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, stdout = TRUE, message = TRUE) print(y) } \dontshow{if (getRversion() >= "4.0.0" && !is.element("pkgdown", loadedNamespaces()))} handlers(global = FALSE) } \keyword{internal} progressr/man/handler_notifier.Rd0000644000175000017500000000230514122707130017005 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_notifier.R \name{handler_notifier} \alias{handler_notifier} \title{Progression Handler: Progress Reported via the Operating-System Notification Framework (GUI, Text)} \usage{ handler_notifier( intrusiveness = getOption("progressr.intrusiveness.notifier", 10), target = "gui", ... ) } \arguments{ \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{ A progression handler for \code{notify()} of the \pkg{notifier} package. } \section{Requirements}{ This progression handler requires the \pkg{notifier} package, which is only available from \url{https://github.com/gaborcsardi/notifier}. This can be installed as \code{remotes::install_github("gaborcsardi/notifier@62d484")}. } \examples{ pkg <- "notifier" if (requireNamespace(pkg, quietly = TRUE)) { handlers("notifier") with_progress({ y <- slow_sum(1:10) }) print(y) } } \keyword{internal} progressr/man/progress_aggregator.Rd0000644000175000017500000000133614122707130017542 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/progress_aggregator.R \name{progress_aggregator} \alias{progress_aggregator} \title{Aggregate Progression Conditions} \usage{ progress_aggregator(progress) } \arguments{ \item{progress}{A \link{progressor} function.} } \value{ A function of class \code{progress_aggregator}. } \description{ Aggregate Progression Conditions } \examples{ library(progressr) message("progress_aggregator() ...") with_progress({ progress <- progressor(steps = 4L) relay_progress <- progress_aggregator(progress) progress() relay_progress(slow_sum(1:3)) relay_progress(slow_sum(1:10)) progress() }) message("progress_aggregator() ... done") } \keyword{internal} progressr/man/progressr.options.Rd0000644000175000017500000001303214157465426017231 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/options.R \name{progressr.options} \alias{progressr.options} \alias{progressr.clear} \alias{progressr.debug} \alias{progressr.demo.delay} \alias{progressr.delay_stdout} \alias{progressr.delay_conditions} \alias{progressr.enable} \alias{progressr.enable_after} \alias{progressr.interrupts} \alias{progressr.interval} \alias{progressr.intrusiveness} \alias{progressr.intrusiveness.auditory} \alias{progressr.intrusiveness.debug} \alias{progressr.intrusiveness.file} \alias{progressr.intrusiveness.gui} \alias{progressr.intrusiveness.notifier} \alias{progressr.intrusiveness.terminal} \alias{progressr.handlers} \alias{progressr.times} \title{Options and environment variables used by the 'progressr' packages} \description{ Below are environment variables and \R options that are used by the \pkg{progressr} package. Below are all \R options that are currently used by the \pkg{progressr} package.\cr \cr \emph{WARNING: Note that the names and the default values of these options may change in future versions of the package. Please use with care until further notice.} } \section{Options for controlling progression reporting}{ \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[=handlers]{handlers()}}. (Default: NULL) } } } \section{Options for controlling progression handlers}{ \describe{ \item{\option{progressr.clear}:}{ (logical) If TRUE, any output, typically visual, produced by a reporter will be cleared/removed upon completion, if possible. (Default: TRUE) } \item{\option{progressr.enable}:}{ (logical) If FALSE, then progress is not reported. (Default: TRUE) } \item{\option{progressr.enable_after}:}{ (numeric) Delay (in seconds) before progression updates are reported. (Default: \code{0.0}) } \item{\option{progressr.times}:}{ (numeric) The maximum number of times a handler should report progression updates. If zero, then progress is not reported. (Default: \code{+Inf}) } \item{\option{progressr.interval}:}{ (numeric) The minimum time (in seconds) between successive progression updates from this handler. (Default: \code{0.0}) } \item{\option{progressr.intrusiveness}:}{ (numeric) A non-negative scalar on how intrusive (disruptive) the reporter to the user. This multiplicative scalar applies to the \emph{interval} and \emph{times} parameters. (Default: \code{1.0})\cr\preformatted{\\describe\{ \\item\{\option{progressr.intrusiveness.auditory}:\}\{(numeric) intrusiveness for auditory progress handlers (Default: `5.0`)\} \\item\{\option{progressr.intrusiveness.file}:\}\{(numeric) intrusiveness for file-based progress handlers (Default: `5.0`)\} \\item\{\option{progressr.intrusiveness.gui}:\}\{(numeric) intrusiveness for graphical-user-interface progress handlers (Default: `1.0`)\} \\item\{\option{progressr.intrusiveness.notifier}:\}\{(numeric) intrusiveness for progress handlers that creates notifications (Default: `10.0`)\} \\item\{\option{progressr.intrusiveness.terminal}:\}\{(numeric) intrusiveness for progress handlers that outputs to the terminal (Default: `1.0`)\} \\item\{\option{progressr.intrusiveness.debug}:\}\{(numeric) intrusiveness for "debug" progress handlers (Default: `0.0`)\} \} } } } } \section{Options for controlling how standard output and conditions are relayed}{ \describe{ \item{\option{progressr.delay_conditions}:}{ (character vector) condition classes to be captured and relayed at the end after any captured standard output is relayed. (Default: \code{c("condition")}) } \item{\option{progressr.delay_stdout}:}{ (logical) If TRUE, standard output is captured and relayed at the end just before any captured conditions are relayed. (Default: TRUE) } } } \section{Options for controlling interrupts}{ \describe{ \item{\option{progressr.interrupts}:}{ (logical) Controls whether interrupts should be detected or not. If FALSE, then interrupts are not detected and progress information is generated. (Default: \code{TRUE}) } \item{\option{progressr.delay_stdout}:}{ (logical) If TRUE, standard output is captured and relayed at the end just before any captured conditions are relayed. (Default: TRUE) } } } \section{Options for debugging progression updates}{ \describe{ \item{\option{progressr.debug}:}{(logical) If TRUE, extensive debug messages are generated. (Default: FALSE)} } } \section{Options for progressr examples and demos}{ \describe{ \item{\option{progressr.demo.delay}:}{(numeric) Delay (in seconds) between each iteration of \code{\link[=slow_sum]{slow_sum()}}. (Default: \code{1.0})} } } \section{Environment variables that set R options}{ Some of the above \R \option{progressr.*} options can be set by corresponding environment variable \env{R_PROGRESSR_*} \emph{when the \pkg{progressr} package is loaded}. For example, if \code{R_PROGRESSR_ENABLE = "true"}, then option \option{progressr.enable} is set to \code{TRUE} (logical). For example, if \code{R_PROGRESSR_ENABLE_AFTER = "2.0"}, then option \option{progressr.enable_after} is set to \code{2.0} (numeric). } \seealso{ To set \R options when \R starts (even before the \pkg{progressr} package is loaded), see the \link[base]{Startup} help page. The \href{https://cran.r-project.org/package=startup}{\pkg{startup}} package provides a friendly mechanism for configuring \R at startup. } \keyword{internal} progressr/man/progress.Rd0000644000175000017500000000131414124007051015331 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/progress.R \name{progress} \alias{progress} \title{Creates and Signals a Progression Condition} \usage{ progress(..., call = sys.call()) } \arguments{ \item{call}{(expression) A call expression.} \item{\ldots}{Arguments pass to \code{\link[=progression]{progression()}}.} } \value{ A \link[base:conditions]{base::condition} of class \code{progression}. } \description{ \emph{WARNING:} \code{progress()} is defunct - don't use. } \seealso{ To create a progression condition, use \code{\link[=progression]{progression()}}. To signal a progression condition, use \code{\link[base:conditions]{base::signalCondition()}}. } \keyword{internal} progressr/man/handler_txtprogressbar.Rd0000644000175000017500000000420214123360236020260 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_txtprogressbar.R \name{handler_txtprogressbar} \alias{handler_txtprogressbar} \title{Progression Handler: Progress Reported as Plain Progress Bars (Text) in the Terminal} \usage{ handler_txtprogressbar( style = 3L, file = stderr(), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ... ) } \arguments{ \item{style}{(integer) The progress-bar style according to \code{\link[utils:txtProgressBar]{utils::txtProgressBar()}}.} \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.} \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{ A progression handler for \code{\link[utils:txtProgressBar]{utils::txtProgressBar()}}. } \section{Appearance}{ Below is how this progress handler renders at 0\%, 30\% and 99\% progress for the three different \code{style} values that \code{\link[utils:txtProgressBar]{utils::txtProgressBar()}} supports. With \code{handlers(handler_txtprogressbar(style = 1L))}:\if{html}{\out{
}}\preformatted{ ==================================== ========================================================== }\if{html}{\out{
}} With \code{handlers(handler_txtprogressbar(style = 2L))}:\if{html}{\out{
}}\preformatted{ ==================================== ========================================================== }\if{html}{\out{
}} With \code{handlers(handler_txtprogressbar(style = 3L))}:\if{html}{\out{
}}\preformatted{ | | 0\% |=============== | 30\% |=================================================| 99\% }\if{html}{\out{
}} } \examples{ handlers("txtprogressbar") with_progress({ y <- slow_sum(1:10) }) print(y) } progressr/man/progression.Rd0000644000175000017500000000446614122707130016055 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/progression.R \name{progression} \alias{progression} \title{A Progression Condition} \usage{ progression( message = character(0L), amount = 1, 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 ) } \arguments{ \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.} \item{step}{(numeric) The step completed. If specified, \code{amount} is ignored. \emph{WARNING: Argument \code{step} should only be used when in full control of the order when this progression condition is signaled.} For example, it must not be signaled as one of many parallel progress updates signaled concurrently, because then we cannot guarantee the order these progressions arrive.} \item{time}{(POSIXct) A timestamp.} \item{type}{Type of progression made.} \item{class}{(character) Zero or more class names to prepend.} \item{progressor_uuid}{(character string) A character string that is unique for the current progressor and the current \R session.} \item{progression_index}{(integer) A non-negative integer that is incremented by one for each progression condition created.} \item{progression_time}{(POSIXct or character string) A timestamp specifying when the progression condition was created.} \item{call}{(expression) A call expression.} \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.} \item{\ldots}{Additional named elements.} } \value{ 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:conditions]{base::signalCondition()}}. } \keyword{internal} progressr/man/handler_newline.Rd0000644000175000017500000000207514122707130016633 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_newline.R \name{handler_newline} \alias{handler_newline} \title{Progression Handler: Progress Reported as a New Line (Text) in the Terminal} \usage{ handler_newline( symbol = "\\n", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", ... ) } \arguments{ \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: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.} \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 a New Line (Text) in the Terminal } \keyword{internal} progressr/man/handler_pbmcapply.Rd0000644000175000017500000000411214123360236017156 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_pbmcapply.R \name{handler_pbmcapply} \alias{handler_pbmcapply} \title{Progression Handler: Progress Reported via 'pbmcapply' Progress Bars (Text) in the Terminal} \usage{ handler_pbmcapply( substyle = 3L, style = "ETA", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ... ) } \arguments{ \item{substyle}{(integer) The progress-bar substyle according to \code{\link[pbmcapply:progressBar]{pbmcapply::progressBar()}}.} \item{style}{(character) The progress-bar style according to \code{\link[pbmcapply:progressBar]{pbmcapply::progressBar()}}.} \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.} \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{ A progression handler for \code{\link[pbmcapply:progressBar]{pbmcapply::progressBar()}}. } \section{Requirements}{ This progression handler requires the \pkg{pbmcapply} package. } \section{Appearance}{ Since \code{style = "txt"} corresponds to using \code{\link[=handler_txtprogressbar]{handler_txtprogressbar()}} with \code{style = substyle}, the main usage of this handler is with \code{style = "ETA"} (default) for which \code{substyle} is ignored. Below is how this progress handler renders by default at 0\%, 30\% and 99\% progress: With \code{handlers(handler_pbmcapply())}:\if{html}{\out{
}}\preformatted{ | | 0\%, ETA NA |=========== | 30\%, ETA 01:32 |======================================| 99\%, ETA 00:01 }\if{html}{\out{
}} } \examples{ if (requireNamespace("pbmcapply", quietly = TRUE)) { handlers("pbmcapply") with_progress({ y <- slow_sum(1:10) }) print(y) } } progressr/man/slow_sum.Rd0000644000175000017500000000134614122707130015345 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/slow_sum.R \name{slow_sum} \alias{slow_sum} \title{Slowly Calculate Sum of Elements} \usage{ slow_sum( x, delay = getOption("progressr.demo.delay", 1), stdout = FALSE, message = TRUE ) } \arguments{ \item{x}{Numeric vector to sum} \item{delay}{Delay in seconds after each addition.} \item{stdout}{If TRUE, then a text is outputted to the standard output per element.} \item{message}{If TRUE, then a message is outputted per element.} } \value{ The sum of all elements in \code{x}. } \description{ Slowly Calculate Sum of Elements } \section{Progress updates}{ This function signals \link{progression} conditions as it progresses. } \keyword{internal} progressr/man/progress_progressr.Rd0000644000175000017500000000235314122707130017446 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plyr_progress_progressr.R \name{progress_progressr} \alias{progress_progressr} \title{Use Progressr with Plyr Map-Reduce Functions} \usage{ progress_progressr(...) } \arguments{ \item{\ldots}{Not used.} } \value{ A named \link[base:list]{base::list} that can be passed as argument \code{.progress} to any of \pkg{plyr} function accepting that argument. } \description{ A "progress bar" for \pkg{plyr}'s \code{.progress} argument. } \section{Limitations}{ One can use use \code{\link[doFuture:registerDoFuture]{doFuture::registerDoFuture()}} to run \pkg{plyr} functions in parallel, e.g. \code{plyr::l_ply(..., .parallel = TRUE)}. Unfortunately, using \code{.parallel = TRUE} disables progress updates because, internally, \pkg{plyr} forces \code{.progress = "none"} whenever \code{.parallel = TRUE}. Thus, despite the \pkg{future} ecosystem and \pkg{progressr} would support it, it is not possible to run \pkg{dplyr} in parallel \emph{and} get progress updates at the same time. } \examples{ if (requireNamespace("plyr", quietly=TRUE)) { with_progress({ y <- plyr::llply(1:10, function(x) { Sys.sleep(0.1) sqrt(x) }, .progress = "progressr") }) } } progressr/man/handler_progress.Rd0000644000175000017500000000401414123360236017034 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_progress.R \name{handler_progress} \alias{handler_progress} \title{Progression Handler: Progress Reported via 'progress' Progress Bars (Text) in the Terminal} \usage{ handler_progress( format = ":spin [:bar] :percent :message", show_after = 0, intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ... ) } \arguments{ \item{format}{(character string) The format of the progress bar.} \item{show_after}{(numeric) Number of seconds to wait before displaying the progress bar.} \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{ A progression handler for \code{\link[progress:progress_bar]{progress::progress_bar()}}. } \section{Requirements}{ This progression handler requires the \pkg{progress} package. } \section{Appearance}{ 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\% }\if{html}{\out{
}} If the progression updates have messages, they will appear like:\if{html}{\out{
}}\preformatted{- [-----------------------------------------] 0\% Starting \\ [===========>----------------------------] 30\% Importing | [=====================================>] 99\% Summarizing }\if{html}{\out{
}} } \examples{ if (requireNamespace("progress", quietly = TRUE)) { handlers(handler_progress(format = ":spin [:bar] :percent :message")) with_progress({ y <- slow_sum(1:10) }) print(y) } } progressr/man/with_progress.Rd0000644000175000017500000001106514157465776016424 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/with_progress.R, R/without_progress.R \name{with_progress} \alias{with_progress} \alias{without_progress} \title{Report on Progress while Evaluating an R Expression} \usage{ with_progress( expr, handlers = progressr::handlers(), cleanup = TRUE, delay_terminal = NULL, delay_stdout = NULL, delay_conditions = NULL, interrupts = getOption("progressr.interrupts", TRUE), interval = NULL, enable = NULL ) without_progress(expr) } \arguments{ \item{expr}{An \R expression to evaluate.} \item{handlers}{A progression handler or a list of them. If NULL or an empty list, progress updates are ignored.} \item{cleanup}{If TRUE, all progression handlers will be shutdown at the end regardless of the progression is complete or not.} \item{delay_terminal}{If TRUE, output and conditions that may end up in 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:conditions]{base::condition} classes to be captured and relayed at the end after any captured standard output is relayed.} \item{interrupts}{Controls whether interrupts should be detected or not. If TRUE and a interrupt is signaled, progress handlers are asked to report on the current amount progress when the evaluation was terminated by the interrupt, e.g. when a user pressed Ctrl-C in an interactive session, or a batch process was interrupted because it ran out of time.} \item{interval}{(numeric) The minimum time (in seconds) between successive progression updates from handlers.} \item{enable}{(logical) If FALSE, then progress is not reported. The default is to report progress in interactive mode but not batch mode. See below for more details.} } \value{ Returns the value of the expression. } \description{ Report on Progress while Evaluating an R Expression } \details{ \emph{IMPORTANT: This function is meant for end users only. It should not be used by R packages, which only task is to \emph{signal} progress updates, not to decide if, when, and how progress should be reported.} \code{without_progress()} evaluates an expression while ignoring all progress updates. } \section{Progression handler functions}{ Formally, progression handlers are calling handlers that are called when a \link{progression} condition is signaled. These handlers are functions that takes one argument which is the \link{progression} condition. } \section{Progress updates in batch mode}{ When running R from the command line, R runs in a non-interactive mode (\code{interactive()} returns \code{FALSE}). The default behavior of \code{with_progress()} is to \emph{not} report on progress in non-interactive mode. To have progress being reported on also then, set R options \option{progressr.enable} or environment variable \env{R_PROGRESSR_ENABLE} to \code{TRUE}. Alternatively, one can set argument \code{enable=TRUE} when calling \code{with_progress()}. For example,\if{html}{\out{
}}\preformatted{$ Rscript -e "library(progressr)" -e "with_progress(slow_sum(1:5))" }\if{html}{\out{
}} will \emph{not} report on progress, whereas:\if{html}{\out{
}}\preformatted{$ export R_PROGRESSR_ENABLE=TRUE $ Rscript -e "library(progressr)" -e "with_progress(slow_sum(1:5))" }\if{html}{\out{
}} will. } \examples{ ## The slow_sum() example function slow_sum <- progressr::slow_sum print(slow_sum) x <- 1:10 ## Without progress updates y <- slow_sum(x) ## Progress reported via txtProgressBar (default) handlers("txtprogressbar") ## default with_progress({ y <- slow_sum(x) }) ## Progress reported via tcltk::tkProgressBar if (capabilities("tcltk") && requireNamespace("tcltk", quietly = TRUE)) { handlers("tkprogressbar") with_progress({ y <- slow_sum(x) }) } ## Progress reported via progress::progress_bar) if (requireNamespace("progress", quietly = TRUE)) { handlers("progress") with_progress({ y <- slow_sum(x) }) } ## Progress reported via txtProgressBar and beepr::beep if (requireNamespace("beepr", quietly = TRUE)) { handlers("beepr", "txtprogressbar") with_progress({ y <- slow_sum(x) }) } ## Progress reported via customized utils::txtProgressBar and beepr::beep, ## if available. handlers(handler_txtprogressbar(style = 3L)) if (requireNamespace("beepr", quietly = TRUE)) { handlers("beepr", append = TRUE) } with_progress({ y <- slow_sum(1:30) }) } \seealso{ \code{\link[base:conditions]{base::withCallingHandlers()}} } progressr/man/handler_beepr.Rd0000644000175000017500000000227414122707130016270 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_beepr.R \name{handler_beepr} \alias{handler_beepr} \title{Progression Handler: Progress Reported as 'beepr' Sounds (Audio)} \usage{ handler_beepr( initiate = 2L, update = 10L, finish = 11L, intrusiveness = getOption("progressr.intrusiveness.auditory", 5), target = "audio", ... ) } \arguments{ \item{initiate, update, finish}{(integer) Indices of \code{\link[beepr:beep]{beepr::beep()}} sounds to play when progress starts, is updated, and completes. For silence, use \code{NA_integer_}.} \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{ A progression handler for \code{\link[beepr:beep]{beepr::beep()}}. } \section{Requirements}{ This progression handler requires the \pkg{beepr} package. } \examples{ if (requireNamespace("beepr", quietly = TRUE)) { handlers("beepr") with_progress({ y <- slow_sum(1:10) }) print(y) } } progressr/man/handler_tkprogressbar.Rd0000644000175000017500000000216014122707130020055 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_tkprogressbar.R \name{handler_tkprogressbar} \alias{handler_tkprogressbar} \title{Progression Handler: Progress Reported as a Tcl/Tk Progress Bars in the GUI} \usage{ handler_tkprogressbar( intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "terminal", ... ) } \arguments{ \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{ A progression handler for \code{\link[tcltk:tkProgressBar]{tcltk::tkProgressBar()}}. } \section{Requirements}{ This progression handler requires the \pkg{tcltk} package and that the current R session supports Tcl/Tk (\code{capabilities("tcltk")}). } \examples{ if (capabilities("tcltk") && requireNamespace("tcltk", quietly = TRUE)) { handlers("tkprogressbar") with_progress({ y <- slow_sum(1:10) }) print(y) } } progressr/man/handler_winprogressbar.Rd0000644000175000017500000000154414122707130020241 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_winprogressbar.R \name{handler_winprogressbar} \alias{handler_winprogressbar} \title{Progression Handler: Progress Reported as a MS Windows Progress Bars in the GUI} \usage{ handler_winprogressbar( intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", ... ) } \arguments{ \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{ A progression handler for \code{winProgressBar()} in the \pkg{utils} package. } \section{Requirements}{ This progression handler requires MS Windows. } progressr/man/handler_debug.Rd0000644000175000017500000000354414123360236016265 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_debug.R \name{handler_debug} \alias{handler_debug} \title{Progression Handler: Progress Reported as Debug Information (Text) in the Terminal} \usage{ handler_debug( interval = getOption("progressr.interval", 0), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", uuid = FALSE, ... ) } \arguments{ \item{interval}{(numeric) The minimum time (in seconds) between successive progression updates from this handler.} \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{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{ Progression Handler: Progress Reported as Debug Information (Text) in the Terminal } \section{Appearance}{ Below is how this progress handler renders by default at 0\%, 30\% and 99\% progress: With \code{handlers(handler_debug())}:\if{html}{\out{
}}\preformatted{[21:27:11.236] (0.000s => +0.001s) initiate: 0/100 (+0) '' \{clear=TRUE, enabled=TRUE, status=\} [21:27:11.237] (0.001s => +0.000s) update: 0/100 (+0) 'Starting' \{clear=TRUE, enabled=TRUE, status=\} [21:27:14.240] (3.004s => +0.002s) update: 30/100 (+30) 'Importing' \{clear=TRUE, enabled=TRUE, status=\} [21:27:16.245] (5.009s => +0.001s) update: 100/100 (+70) 'Summarizing' \{clear=TRUE, enabled=TRUE, status=\} [21:27:16.246] (5.010s => +0.003s) update: 100/100 (+0) 'Summarizing' \{clear=TRIE, enabled=TRUE, status=\} }\if{html}{\out{
}} } \examples{ handlers("debug") with_progress({ y <- slow_sum(1:10) }) print(y) } progressr/man/handler_void.Rd0000644000175000017500000000160514122707130016131 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_void.R \name{handler_void} \alias{handler_void} \title{Progression Handler: No Progress Report} \usage{ handler_void(intrusiveness = 0, target = "void", enable = FALSE, ...) } \arguments{ \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{enable}{(logical) If FALSE, then progress is not reported.} \item{\ldots}{Additional arguments passed to \code{\link[=make_progression_handler]{make_progression_handler()}}.} } \description{ Progression Handler: No Progress Report } \details{ This progression handler gives not output - it is invisible and silent. } \examples{ \donttest{\dontrun{ handlers(handler_void()) with_progress(y <- slow_sum(1:100)) print(y) }} } progressr/man/handlers.Rd0000644000175000017500000000662714123360236015307 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handlers.R \name{handlers} \alias{handlers} \title{Control How Progress is Reported} \usage{ handlers( ..., append = FALSE, on_missing = c("error", "warning", "ignore"), default = handler_txtprogressbar, global = NULL ) } \arguments{ \item{\dots}{One or more progression handlers. Alternatively, this functions accepts also a single vector of progression handlers as input. If this vector is empty, then an empty set of progression handlers will be set.} \item{append}{(logical) If FALSE, the specified progression handlers replace the current ones, otherwise appended to them.} \item{on_missing}{(character) If \code{"error"}, an error is thrown if one of the progression handlers does not exists. If \code{"warning"}, a warning is produces and the missing handlers is ignored. If \code{"ignore"}, the 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 } \details{ This function provides a convenient alternative for getting and setting option \option{progressr.handlers}. \emph{IMPORTANT: Setting progression handlers is a privilege that should be left to the end user. It should not be used by R packages, which only task is to \emph{signal} progress updates, not to decide if, when, and how progress should be reported.} } \section{Configuring progression handling during R startup}{ A convenient place to configure the default progression handler and to enable global progression reporting by default is in the \file{~/.Rprofile} startup file. For example, the following will (i) cause your interactive R session to use global progression handler by default, and (ii) report progress via the \pkg{progress} package when in the terminal and via the RStudio Jobs progress bar when in the RStudio Console. \link{handler_txtprogressbar}, other whenever using the RStudio Console, add the following to your \file{~/.Rprofile} startup file:\if{html}{\out{
}}\preformatted{if (interactive() && requireNamespace("progressr", quietly = TRUE)) \{ ## Enable global progression updates if (getRversion() >= 4) progressr::handlers(global = TRUE) ## In RStudio Console, or not? if (Sys.getenv("RSTUDIO") == "1" && !nzchar(Sys.getenv("RSTUDIO_TERM"))) \{ options(progressr.handlers = progressr::handler_rstudio) \} else \{ options(progressr.handlers = progressr::handler_progress) \} \} }\if{html}{\out{
}} } \examples{ handlers("txtprogressbar") if (requireNamespace("beepr", quietly = TRUE)) handlers("beepr", append = TRUE) with_progress({ y <- slow_sum(1:5) }) print(y) if (getRversion() >= "4.0.0") { \dontshow{if (!is.element("pkgdown", loadedNamespaces()))} handlers(global = TRUE) y <- slow_sum(1:4) z <- slow_sum(6:9) \dontshow{if (!is.element("pkgdown", loadedNamespaces()))} handlers(global = FALSE) } } progressr/man/handler_pbcol.Rd0000644000175000017500000000326514122707130016273 0ustar nileshnilesh% 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, complete = function(s) crayon::bgBlue(crayon::white(s)), incomplete = function(s) crayon::bgCyan(crayon::white(s)), 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{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.} \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. } \examples{ handlers(handler_pbcol) with_progress({ y <- slow_sum(1:10) }) print(y) } progressr/man/handler_rstudio.Rd0000644000175000017500000000332014123360236016660 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_rstudio.R \name{handler_rstudio} \alias{handler_rstudio} \title{Progression Handler: Progress Reported in the RStudio Console} \usage{ handler_rstudio( intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", title = function() format(Sys.time(), "Console \%X"), ... ) } \arguments{ \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{title}{(character or a function) The "name" of the progressor, which is displayed in front of the progress bar. If a function, then the name is created dynamically by calling the function when the progressor is created.} \item{\ldots}{Additional arguments passed to \code{\link[=make_progression_handler]{make_progression_handler()}}.} } \description{ Progression Handler: Progress Reported in the RStudio Console } \section{Requirements}{ This progression handler works only in the RStudio Console. } \section{Use this progression handler by default}{ To use this handler by default whenever using the RStudio Console, add the following to your \file{~/.Rprofile} startup file:\if{html}{\out{
}}\preformatted{if (requireNamespace("progressr", quietly = TRUE)) \{ if (Sys.getenv("RSTUDIO") == "1" && !nzchar(Sys.getenv("RSTUDIO_TERM"))) \{ options(progressr.handlers = progressr::handler_rstudio) \} \} }\if{html}{\out{
}} } \examples{ if (requireNamespace("rstudioapi", quietly = TRUE) && rstudioapi::isAvailable()) { handlers("rstudio") with_progress({ y <- slow_sum(1:10) }) print(y) } } progressr/man/withProgressShiny.Rd0000644000175000017500000000471714122707130017215 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/withProgressShiny.R \name{withProgressShiny} \alias{withProgressShiny} \title{Use Progressr in Shiny Apps: Plug-in Backward Compatibility Replacement for shiny::withProgress()} \usage{ withProgressShiny( expr, ..., message = NULL, detail = NULL, inputs = list(message = NULL, detail = "message"), env = parent.frame(), quoted = FALSE, handlers = c(shiny = handler_shiny, progressr::handlers(default = NULL)) ) } \arguments{ \item{expr, \ldots, env, quoted}{Arguments passed to \link[shiny:withProgress]{shiny::withProgress} as is.} \item{message, detail}{(character string) The message and the detail message to be passed to \code{\link[shiny:withProgress]{shiny::withProgress()}}.} \item{inputs}{(named list) Specifies from what sources the Shiny progress elements 'message' and 'detail' should be updated. Valid sources are \code{"message"}, \code{"sticky_message"} and \code{"non_sticky_message"}, where \code{"message"} is short for \code{c("non_sticky_message", "sticky_message")}. For example, \code{inputs = list(message = "sticky-message", detail = "message")} will update the Shiny 'message' component from sticky messages only, whereas the 'detail' component is updated using any message.} \item{handlers}{Zero or more progression handlers used to report on progress.} } \value{ The value of \link[shiny:withProgress]{shiny::withProgress}. } \description{ Use Progressr in Shiny Apps: Plug-in Backward Compatibility Replacement for shiny::withProgress() } \section{Requirements}{ This function requires the \pkg{shiny} package and will use the \code{\link[=handler_shiny]{handler_shiny()}} \strong{progressr} handler internally to report on updates. } \examples{ library(shiny) library(progressr) app <- shinyApp( ui = fluidPage( plotOutput("plot") ), server = function(input, output) { output$plot <- renderPlot({ X <- 1:15 withProgressShiny(message = "Calculation in progress", detail = "Starting ...", value = 0, { p <- progressor(along = X) y <- lapply(X, FUN=function(x) { Sys.sleep(0.25) p(sprintf("x=\%d", x)) }) }) plot(cars) ## Terminate the Shiny app Sys.sleep(1.0) stopApp(returnValue = invisible()) }) } ) local({ oopts <- options(device.ask.default = FALSE) on.exit(options(oopts)) if (interactive()) print(app) }) } progressr/man/progressr.Rd0000644000175000017500000000557114122707130015527 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/progressr-package.R \docType{package} \name{progressr} \alias{progressr} \alias{progressr-package} \title{progressr: A Unifying API for Progress Updates} \description{ The \pkg{progressr} package provides a minimal, unifying API for scripts and packages to report progress updates from anywhere including when using parallel processing. } \details{ The package is designed such that \emph{the developer} can to focus on \emph{what} progress should be reported on without having to worry about \emph{how} to present it. The \emph{end user} has full control of \emph{how}, \emph{where}, and \emph{when} to render these progress updates. For instance, they can chose to report progress in the terminal using \code{\link[utils:txtProgressBar]{utils::txtProgressBar()}} or \code{\link[progress:progress_bar]{progress::progress_bar()}} or via the graphical user interface (GUI) using \code{utils::winProgressBar()} or \code{\link[tcltk:tkProgressBar]{tcltk::tkProgressBar()}}. An alternative to above visual rendering of progress, is to report it using \code{\link[beepr:beep]{beepr::beep()}} sounds. It is possible to use a combination of above progression handlers, e.g. a progress bar in the terminal together with audio updates. Besides the existing handlers, it is possible to develop custom progression handlers. The \pkg{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 \code{\link[=lapply]{lapply()}} family of functions, \pkg{purrr}, \pkg{plyr}, and \pkg{foreach}. The \pkg{progressr} package will also work with parallel processing via the \pkg{future} framework, e.g. \code{\link[future.apply:future_lapply]{future.apply::future_lapply()}}, \code{\link[furrr:future_map]{furrr::future_map()}}, and \code{\link[foreach:foreach]{foreach::foreach()}} with \pkg{doFuture}. The \pkg{progressr} package is compatible with Shiny applications. } \section{Progression Handlers}{ 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} \item \link{handler_debug} } In a graphical user interface (GUI): \itemize{ \item \link{handler_rstudio} \item \link{handler_tkprogressbar} \item \link{handler_winprogressbar} } As sound: \itemize{ \item \link{handler_beepr} \item \link{handler_ascii_alert} } Via the file system: \itemize{ \item \link{handler_filesize} } In Shiny: \itemize{ \item \link{withProgressShiny} } } \examples{ library(progressr) 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) }) }) } \keyword{iteration} \keyword{programming} progressr/man/figures/0000755000175000017500000000000014122707130014646 5ustar nileshnileshprogressr/man/figures/lifecycle-maturing-blue.svg0000644000175000017500000000170614122707130022103 0ustar nileshnileshlifecyclelifecyclematuringmaturing progressr/man/handler_ascii_alert.Rd0000644000175000017500000000224514122707130017450 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/handler_ascii_alert.R \name{handler_ascii_alert} \alias{handler_ascii_alert} \title{Progression Handler: Progress Reported as ASCII BEL Symbols (Audio or Blink) in the Terminal} \usage{ handler_ascii_alert( symbol = "\\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.auditory", 5), target = c("terminal", "audio"), ... ) } \arguments{ \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: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.} \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{ A progression handler based on \code{cat("\\a", file=stderr())}. } \examples{ handlers("ascii_alert") with_progress({ y <- slow_sum(1:10) }) print(y) } progressr/vignettes/0000755000175000017500000000000014157512126014446 5ustar nileshnileshprogressr/vignettes/imgs/0000755000175000017500000000000014157512126015405 5ustar nileshnileshprogressr/vignettes/imgs/lifecycle-maturing-blue.svg0000644000175000017500000000170614122707130022633 0ustar nileshnileshlifecyclelifecyclematuringmaturing progressr/vignettes/imgs/3steps.svg0000644000175000017500000002307614122707130017350 0ustar nileshnilesh p <- progressor(3) a <- 1 b <- 2 p(message = 'init') c <- a+b p(message = 'sum') d <- sqrt(c) p(message = 'sqrt') R controlled the code DEVELOPER by progression progression progression progression signaled conditions [---------] 0% [==>------] 33% init [=====>---] 66% sum [========>] 100% sqrt progression handler controlled the END USER by progressr/vignettes/imgs/Makefile0000644000175000017500000000017414157512126017047 0ustar nileshnileshall: slow_sum.svg %.svg: %.bob svgbob --font-family=monospace --output $@ < $< %.png: %.svg inkscape -z -d 192 -e $@ $< progressr/vignettes/imgs/three_in_chinese.gif0000644000175000017500000001563614122707130021373 0ustar nileshnileshGIF89add÷ """&&&***...222555888;;;===@@@BBBEEEGGGIIIKKKMMMOOOQQQSSSUUUVVVXXXZZZ\\\]]]___```bbbccceeefffhhhiiijjjlllmmmnnnpppqqqrrrsssuuuvvvwwwxxxyyyzzz|||}}}~~~€€€‚‚‚ƒƒƒ„„„………†††‡‡‡ˆˆˆ‰‰‰ŠŠŠ‹‹‹ŒŒŒŽŽŽ‘‘‘’’’“““”””•••–––———˜˜˜™™™ššš›››œœœžžžŸŸŸ   ¡¡¡¢¢¢£££¤¤¤¥¥¥¦¦¦§§§¨¨¨©©©ªªª«««¬¬¬­­­®®®¯¯¯°°°±±±²²²³³³´´´µµµ¶¶¶···¸¸¸¹¹¹ººº»»»¼¼¼½½½¾¾¾¿¿¿ÀÀÀÁÁÁÂÂÂÃÃÃÄÄÄÅÅÅÆÆÆÇÇÇÈÈÈÉÉÉÊÊÊËËËÌÌÌÍÍÍÎÎÎÏÏÏÐÐÐÑÑÑÒÒÒÓÓÓÔÔÔÕÕÕÖÖÖ×××ØØØÙÙÙÚÚÚÛÛÛÜÜÜÝÝÝÞÞÞßßßàààáááâââãããäääåååæææçççèèèéééêêêëëëìììíííîîîïïïðððñññòòòóóóôôôõõõööö÷÷÷øøøùùùúúúûûûüüüýýýþþþÿÿÿ!ÿ NETSCAPE2.0!ùd,ddÿm H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§Ï…­ ªë'GZœìô )‚)˜ŒVl%INM³j€ã’T†´H5’ã¤ÃÖ³[$úJ°–©Hx²¼@€¶.ÚF[mB‡Ê‹vו°è&­T›ñ9óä…ÁÑHqF’,™µ]Éa‚B€È ÏøÐDN¤V6W1 ÍZÀ‡#hizÅ3k»J“§¨Ë_‰-Á…1wiRU‹mÂP†âˆÁRåŠ4t5Òd ¸óïàËÿO¾¼ùóèÓ«_Ͼ½û÷ðã³%5ˆ$XòÒú(‹Ù¬P‘I{ªTÒÇ4Л (Ø‘ Ü”H%K)–"‡=hð™…gU‘,‡À1†B¨‰‘†)9 cdt€‹ ÂÓ,BܨUð Šx‚ŸT³°Q!Ž¼°DubI)³”'Ë%~¬áÅUdxI'¨d™ßšl¶éæ›pÆ)çœtÖiçqÖ¢Š*lÆòI"n4a‚M•ÀÆ'êÁ2 %„Ä¡ŒhW w¬¢á*¥l !vœQÅ&`u#xÐ-¬ˆr‰Pvx E1ˆá B‚–Ÿ$mxI"z¤Áâ Pë°Z€F³¸rÊ'—0\ѤÄV[— ™’†6Ìð‚ %|p´Zk®…W4¹µA! à 8ìЃ>ôÀÃ9Ü@ƒ /°pÂd0A$@ LôQC\°«Õ˜PƒTŒi ˆ@r‰'¤¨òJs.ÕÂÇB ‚\Ä!$œò°T®ÄAh!F“˜bêy²"ÄjY ÂzTbi|¬(âÆ}\BžTWmõÕXg­õÖ\wíõ×`‡-¶B!ùK,ddÿH° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§Ï…²H}:Eë'ÇZª6!Âs§ižG¨ŒV”e*Ó¢=M³j½s(ªÔ…µ\‘ÊÔÐÖ³gE}%hëU)N åAKí!£²T‰Êô¨žº€éòu³,U¤:UrTkàÇhU2U4¦-P ê¹3]@2™’e3SϨïZd ”ªY<9¥¦›GТIœH±ª,uT Ï|1¢´IT*X¶Ö&d*Ó$H I²¤é©T¯x+ßν»÷ïàËÿO¾¼ùóèÓ«_ϾýWW :™‚í@-VŸ ™Íú4UzX§t"‰!s†ˆ*àÑ )›Dbˆc¨áqŠT´¸‚ (™D‚ȳÑõHN³4GÉ#Š ÂG‡2‰+9‚bg€0rÉ(¯ðT‹"/nå"‘h2Ê*ÚùTË%>ÖG!ŒL¢I(¨¸$w´ âÉ%’@É$—pJ)«ÀRK}`†)æ˜d–iæ™h¦©æšl¢ K,aβŠ(˜4"Èi‚\²Šy³´r †úñØ ›Ài-±¸¢J) lRÉ#‰RälzpòåKµÄÒ *BmB¥#‰§åøØ!†ŽT!*¢pb $%r¼fê¬ZBFµÈò +œz’‰$‰pHë°UÒ+–(rˆ!… " ~ìQ*±Ô¢IC¿U›c|øÈ „r"ˆ$Bî¹Ë2Kˆ @ËÇyèÑÇ tòäA‘h«U~bÈ"`¹É'¢”‚Ê*®ÄBŸK¶t2ijx¢ˆ$™|Âå+ 㕉¬F&B‰|®\*-¡(2íx  '§¤ºž,£`RI'¨dÜæÍ8ç¬óÎ<÷ìóÏ@-ôÐD}P@!ù >,ddÿ}H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ JÔǦGƒðرSâ+R›(5”ÇN:têÔYÚô`ªMŽø¨©¢C„ TÌÄÙjkV®MaÉa‚Bx àIÀ¸¡³Ôêœ9l›®·±c JᲆðR:rä¼íšÇ±gˆ¢E âËqàÔ ¤¨«F">çà /s-š$•kƒ¡Åƒ¥Ê/hèŠôiÕïçУKŸN½ºõëسkßν»÷ïàËCO¾©ŸòèÓ«_Ͼ½û÷ðãËŸO¿¾ýûøóë—¯é; wÀÅ”xîgà&¨à‚ 6èàƒF(á„Vhá…†!ù ,ddÿ+H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ:T¤G(FUŸ*-úc§iS£MEÂÓåG XÒÌqj§Ž¨ [mJ§Ê‹ÒP a†“1p¼6• và(/¤ÝË@€Pé†Î×®^ë ì˘¯€ |`Q³µ⯊6îÁ†UÎÈ©Sá¢JRe^¼™oƒgYµa_ .˜ˆ¹£H“ªÚ 9ÒdjðãÈ“+_μ¹óçУKŸN½ºõëسkßν»÷ïàË-O¾¼ùóèÓ«_Ͼ½û÷ðãËŸO¿¾ýûøóëßÏ¿¿ÿÿ(à€hà@!ù ,,ddÿYH° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ-Qe:tèÆV•ö©†Í;F+’r$çɇdád œ:P£>Ôò€³hX È6tŠm˜¶.€6踢&î\‡vÓH°‡•4~ÿÒ |W‡VÔôa¤x±] žÌDJVå‡J “Ç(ÏŸS«^ͺµë×°cËžM»¶íÛ¸sëÞÍ»·ïßÀƒ N¼¸ñãÈ“+_μ¹óçУKŸN½ºõëسkßν»÷ïàË O¾¼ùóèÓ«W!ù2,ddéH° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§Ï…­ ªëgGNvz ÀLF-N’S„Ó«Xà€¢‡¬`³ PÔUbس7ÊF< V#µÙâŒ$Ypãb ðÁ‰I­òNü€Í M°+^̸±ãÇ#KžL¹²å˘3kÞ̹³çÏ C‹Mº´éÓ¨S«^ͺµë×°cËžM»¶íÛ¸sëÞÍ»·ïßÀƒ N¼¸ñãÈ“+_Îœx@!ù !,ddÿCH° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯`Ê+ÐŽ©³Jaj$ˆ;tΔ;×,Ý°Ác…ˆ ( 0"G”1nâB´{7ç #C0Á„<ªœ‰SâE–|Î"Y2åX$“¸1ÓYm”†,à€Dº°¡Ãgª¬KÖx¹R%Ë8~q:õŠ¬óçУKŸN½ºõëسkßN¤C}êˆAwMÕìxÆä‡î±Óy ãºfCØ]zÖu|øbÓsßÏ¿¿ÐDwÈeÖ‚p‹(—ø§à‚ 6èàƒF(á„Vh¡F!ù 2,ddùeH° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯`Êí* ”£à€ZÚdÖ9@…RÚÊdªj6x Eê„ŠÖØÛ¸sëÞÍ»·ïßÀƒ N¼¸ñãÈ“+_μ¹óçУKŸN½ºõëسk!ù ·,ddÿo H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯` ¦Â”©ÔVZŸ…¹A£I˜6vQ]UÉÏ(À€ (dàÔ±óÔŽ (^¬8À€ zhYC‡pSƘ18€¡4s,_ÎœY€‚8ª¤ •4fLPÑ#ITTÒ2ôØB‡(YU_0 Sç¥R³Â*_μ¹óçУKŸN½ºõëسkßν»÷ïàËO¾¼ùóèÓ«_Ͼ½û÷!ù2,ddÑ#H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯` ’ÄgR,®‚´tÀ*™²¶;—Ç&¹t稄7/[+}é‚c oJØ,JÅu‘§³a#KžL¹²å˘3kÞ̹³çÏ C‹Mº´éÓ¨S«^ͺµë×°cËžM»¶íÏ!ù ·,ddÿo H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯`ÊK¶¬Ù³hÓª]˶­Û·pãÊK·®Ýžv°fŠ„ÈÏ¿w¤n:¸0à £niª©‘À@|ðü½e§0å‚–ëLt‹:Ÿëˆ¦:ï-Í'D½2–«U·cjh'4iÑ -i*Í3b´`Á¢…ŒG² ‰SÚôÂÚŸéÜ.]±vȲg0À $l,„ù†të ¡Ó‘3ç6zŠ‡nÅ8H£íøXpÅ+hÈÑÜ{Ù~’ˆ#<õñ~ÛÐ@38!ƨ”+sPaTÀ_¸a·L"•,ˆ1€v@€Bƒ`bJV¬,âÆdË]@)äDiä‘H&©ä’LZ!ù \,ddÿ¹H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯`ÊK¶¬Ù³hÓª]˶­Û·pãÊK·®Ý»xóÆœUJS$E‡ ´§ÃL]út© 8]†t@À‡Mļ©Ã1Ñ*Jx¸à€€Ó¨SŸC‹#]ØÌé\‡Î¢ªsëp€ !ZÔÌîŒT·ñÓ"”’e Îwôô9z\7Zî4ÚDJUÓよ!ñ3É”ÕÕ)²è©ÄŠ«ŸK°ôÊŸO¿¾ýûøóëßÏ¿ÿÜ€!ù H,ddÿ‘H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯`ÊK¶¬Ù³hÓª]˶­Û·pãÊK·®Ý»x£²u©!j»v€TÙ²&xðáH‹8pÁD$YÔìQdé)$ª˜A„KœA:’•·½û÷ðãËŸO¿¾ýûøóëß/0 !ù ·,ddÿo H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯`ÊK¶¬Ù³hÓª]˶­Û·pãÊK·®]žwêØ¡ÊÊÔ-LÚÑ{tÖªR› º“ÆË•*YƼÑk§òÞ‚–/ëdg)Bbˆ@ €éR H€¡’.lèÔ™mÙ`mž©sëÞ»@A²¨‘3›²íÛ;y+×]@B‰XÒÌ)^Y°fË—0@áD,j¦Ï<¾UݶÏì» @ЀbG”1tþ:D?)’*aØؤÒ%O¤¨Ë]hà&¨à‚ 6èàƒF(a]!ù ¢,ddÿE H° Áƒ*\È°¡Ã‡#JœH±¢Å‹3jÜȱ£Ç CŠI²¤É“(Sª\ɲ¥Ë—0cÊœI³¦Í›8sêÜɳ§ÏŸ@ƒ J´¨Ñ£H“*]Ê´©Ó§P£JJµªÕ«X³jÝʵ«×¯`ÊK¶¬Ù³hÓª]˶­Û·pãÊK·îÓW°¶Æú¤HN—&L¼°ùc)*¬Q” ÅÑÒ#C 0¸ÀBI˜7uì(µsÆ  ˆM:€ 4Ü°¢fŽæ¡¤’žM[t€Z<1#çµÒÚÀE x°‚ ™8¾“N` (¼“]^;@9¬¤q½4C.fà-ØÑÇôÀÃ9Ü@ƒ /°pÂd0A$@ LôQC\°«Õ˜PƒTŒi ˆ@r‰'¤¨òJs.ÕÂÇB ‚\Ä!$œò°T®ÄAh!F“˜bêy²"ÄjY ÂzTbi|¬(âÆ}\BžTWmõÕXg­õÖ\wíõ×`‡-¶B;progressr/vignettes/imgs/3steps-beepr.svg0000644000175000017500000002436014122707130020440 0ustar nileshnilesh p <- progressor(3) a <- 1 b <- 2 p(message = 'init') c <- a+b p(message = 'sum') d <- sqrt(c) p(message = 'sqrt') R controlled the code DEVELOPER by progression progression progression progression signaled conditions [---------] 0% ♫ [==>------] 33% init ð…¡ [=====>---] 66% sum ð…¡ [========>] 100% sqrt ♫ progression handler controlled the END USER by progressr/vignettes/imgs/slow_sum.svg0000644000175000017500000002717214122707130020000 0ustar nileshnilesh library(progressr) handlers('progress', 'beepr') y <- with_progress({ }) R slow_sum(1:10) code p <- progressor(10) sum <- 0 sum <- sum + x[1] p('Added 1') sum <- sum + x[2] p('Added 2') sum <- sum + x[10] p('Added 10') return(sum) controlled the DEVELOPER by progression progression progression progression signaled conditions [---------] ♫ [>--------] ð…¡ [=>-------] ð…¡ [========>] 100% Added 10 ♫ progression handler controlled the END USER 10% Added 1 20% Added 2 0% by progressr/vignettes/progressr-intro.md0000644000175000017500000006015714157511644020164 0ustar nileshnilesh The **[progressr]** package provides a minimal API for reporting progress updates in [R](https://www.r-project.org/). The design is to separate the representation of progress updates from how they are presented. What type of progress to signal is controlled by the developer. How these progress updates are rendered is controlled by the end user. For instance, some users may prefer visual feedback such as a horizontal progress bar in the terminal, whereas others may prefer auditory feedback. Three strokes writing three in Chinese 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 - One For Developers and One For End-Users
Developer'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
    
End-user's API

1a. Subscribe to progress updates from everywhere: 

handlers(global = TRUE)

y <- slow_sum(1:5)
y <- slow_sum(6:10)

1b. Subscribe to a specific expression: 

with_progress({
  y <- slow_sum(1:5)
  y <- slow_sum(6:10)
})

2. Configure how progress is presented: 

handlers("progress")
handlers("txtprogressbar", "beepr")
handlers(handler_pbcol(enable_after = 3.0))
handlers(handler_progress(complete = "#"))
## A simple example Assume that we have a function `slow_sum()` for adding up the values in a vector. It is so slow, that we like to provide progress updates to whoever might be interested in it. With the **progressr** package, this can be done as: ```r slow_sum <- function(x) { p <- progressr::progressor(along = x) sum <- 0 for (kk in seq_along(x)) { Sys.sleep(0.1) sum <- sum + x[kk] p(message = sprintf("Added %g", x[kk])) } sum } ``` 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 on progress When calling this function as in: ```r > y <- slow_sum(1:10) > y [1] 55 > ``` it will behave as any function and there will be no progress updates displayed. ### Reporting on progress If we are only interested in progress for a particular call, we can do: ```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 The default is to present progress via `utils::txtProgressBar()`, which is available on all R installations. To change the default, to, say, `progress_bar()` by the **[progress]** package, set: ```r handlers("progress") ``` This progress handler will present itself as: ```r > y <- slow_sum(1:10) / [================>--------------------------] 40% Added 4 ``` To set the default progress handler, or handlers, in all your R sessions, call `progressr::handlers(...)` in your ~/.Rprofile file. ### Auditory progress updates Progress updates do not have to be presented visually. They can equally well be communicated via audio. For example, using: ```r 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 > y <- slow_sum(1:10) > y [1] 55 > ``` ### Concurrent auditory and visual progress updates It is possible to have multiple progress handlers presenting progress updates at the same time. For example, to get both visual and auditory updates, use: ```r handlers("txtprogressbar", "beepr") ``` ### Silence all progress To silence all progress updates, use: ```r handlers("void") ``` ### Further configuration of progress handlers Above we have seen examples where the `handlers()` takes one or more strings as input, e.g. `handlers(c("progress", "beepr"))`. This is short for a more flexible specification where we can pass a list of handler functions, e.g. ```r handlers(list( handler_progress(), handler_beepr() )) ``` With this construct, we can make adjustments to the default behavior of these progress handlers. For example, we can configure the `format`, `width`, and `complete` arguments of `progress::progress_bar$new()`, and tell **beepr** to use a different `finish` sound and generate sounds at most every two seconds by setting: ```r handlers(list( handler_progress( format = ":spin :current/:total (:message) [:bar] :percent in :elapsed ETA: :eta", width = 60, complete = "+" ), handler_beepr( finish = "wilhelm", interval = 2.0 ) )) ``` ## Sticky messages As seen above, some progress handlers present the progress message as part of its output, e.g. the "progress" handler will display the message as part of the progress bar. It is also possible to "push" the message up together with other terminal output. This can be done by adding class attribute `"sticky"` to the progression signaled. This works for several progress handlers that output to the terminal. For example, with: ```r slow_sum <- function(x) { p <- progressr::progressor(along = x) sum <- 0 for (kk in seq_along(x)) { Sys.sleep(0.1) sum <- sum + x[kk] p(sprintf("Step %d", kk), class = if (kk %% 5 == 0) "sticky", amount = 0) p(message = sprintf("Added %g", x[kk])) } sum } ``` we get ```r > handlers("txtprogressbar") > y <- slow_sum(1:30) Step 5 Step 10 |==================== | 43% ``` and ```r > handlers("progress") > y <- slow_sum(1:30) Step 5 Step 10 / [===============>--------------------------] 43% Added 13 ``` ## Use regular output as usual alongside progress updates In contrast to other progress-bar frameworks, output from `message()`, `cat()`, `print()` and so on, will _not_ interfere with progress reported via **progressr**. For example, say we have: ```r slow_sqrt <- function(xs) { p <- progressor(along = xs) lapply(xs, function(x) { message("Calculating the square root of ", x) Sys.sleep(2) p(sprintf("x=%g", x)) sqrt(x) }) } ``` we will get: ```r > library(progressr) > handlers(global = TRUE) > handlers("progress") > y <- slow_sqrt(1:8) Calculating the square root of 1 Calculating the square root of 2 - [===========>-----------------------------------] 25% x=2 ``` 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. ## Support for progressr elsewhere Note that progression updates by **progressr** is designed to work out of the box for any iterator framework in R. Below is an set of examples for the most common ones. ### Base R Apply Functions ```r library(progressr) handlers(global = TRUE) my_fcn <- function(xs) { p <- progressor(along = xs) y <- lapply(xs, function(x) { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # |==================== | 40% ``` ### The foreach package ```r library(foreach) library(progressr) handlers(global = TRUE) 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% ``` ### The purrr package ```r library(purrr) library(progressr) handlers(global = TRUE) my_fcn <- function(xs) { p <- progressor(along = xs) y <- map(xs, function(x) { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # |==================== | 40% ``` ### The plyr package ```r library(plyr) library(progressr) handlers(global = TRUE) my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # |==================== | 40% ``` _Note:_ This solution does not involved the `.progress = TRUE` argument that **plyr** implements. Because **progressr** is more flexible, and because `.progress` is automatically disabled when running in parallel (see below), I recommend to use the above **progressr** approach instead. Having said this, as proof-of-concept, the **progressr** package implements support `.progress = "progressr"` if you still prefer the **plyr** way of doing it. ## Parallel processing and progress updates The **[future]** framework, which provides a unified API for parallel and distributed processing in R, has built-in support for the kind of progression updates produced by the **progressr** package. This means that you can use it with for instance **[future.apply]**, **[furrr]**, and **[foreach]** with **[doFuture]**, and **[plyr]** or **[BiocParallel]** with **doFuture**. In contrast, _non-future_ parallelization methods such as **parallel**'s `mclapply()` and, `parallel::parLapply()`, and **foreach** adapters like **doParallel** do _not_ support progress reports via **progressr**. ### future_lapply() - parallel lapply() Here is an example that uses `future_lapply()` of the **[future.apply]** package to parallelize on the local machine while at the same time signaling progression updates: ```r library(future.apply) plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_lapply(xs, function(x, ...) { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` ### foreach() with doFuture Here is an example that uses `foreach()` of the **[foreach]** package to parallelize on the local machine (via **[doFuture]**) while at the same time signaling progression updates: ```r library(doFuture) registerDoFuture() ## %dopar% parallelizes via future plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- foreach(x = xs) %dopar% { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) } } my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` ### future_map() - parallel purrr::map() Here is an example that uses `future_map()` of the **[furrr]** package to parallelize on the local machine while at the same time signaling progression updates: ```r library(furrr) plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_map(xs, function(x) { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # / [================>-----------------------------] 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 supports certain future backends and produces errors on non-supported backends, I recommended to stop using `.progress = TRUE` and use the **progressr** package instead. ### BiocParallel::bplapply() - parallel lapply() Here is an example that uses `bplapply()` of the **[BiocParallel]** package to parallelize on the local machine while at the same time signaling progression updates: ```r library(BiocParallel) library(doFuture) register(DoparParam()) ## BiocParallel parallelizes via %dopar% registerDoFuture() ## %dopar% parallelizes via future plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- bplapply(xs, function(x) { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` ### plyr::llply(..., .parallel = TRUE) with doFuture Here is an example that uses `llply()` of the **[plyr]** package to parallelize on the local machine while at the same time signaling progression updates: ```r library(plyr) library(doFuture) registerDoFuture() ## %dopar% parallelizes via future plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) }, .parallel = TRUE) } my_fcn(1:5) # / [================>-----------------------------] 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. ### Near-live versus buffered progress updates with futures As of November 2020, there are four types of **future** backends that are known(*) to provide near-live progress updates: 1. `sequential`, 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 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. ## Note of caution - sending progress updates too frequently Signaling progress updates comes with some overhead. In situation where we use progress updates, this overhead is typically much smaller than the task we are processing in each step. However, if the task we iterate over is quick, then the extra time induced by the progress updates might end up dominating the overall processing time. If that is the case, a simple solution is to only signal progress updates every n:th step. Here is a version of `slow_sum()` that signals progress every 10:th iteration: ``` slow_sum <- function(x) { p <- progressr::progressor(length(x) / 10) sum <- 0 for (kk in seq_along(x)) { Sys.sleep(0.1) sum <- sum + x[kk] if (kk %% 10 == 0) p(message = sprintf("Added %g", x[kk])) } sum } ``` The overhead of progress signaling may depend on context. For example, in parallel processing with near-live progress updates via 'multisession' futures, each progress update is communicated via a socket connections back to the main R session. These connections might become clogged up if progress updates are too frequent. ## 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 **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, ```sh $ Rscript -e "library(progressr)" -e "with_progress(y <- slow_sum(1:10))" ``` will _not_ report on progress, whereas ```sh $ export R_PROGRESSR_ENABLE=TRUE $ Rscript -e "library(progressr)" -e "with_progress(y <- slow_sum(1:10))" ``` will. ## Roadmap 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: * [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)` * [ ] Make it possible to create a progressor also in the global environment (see 'Known issues' below) * [ ] Add support for nested progress updates * [ ] 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. Alternatively, create it 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. (\*) The `immediateCondition` class of conditions are relayed as soon as possible by the **[future]** framework, which means that progression updates produced in parallel workers are reported to the end user as soon as the main R session have received them. ![](imgs/slow_sum.svg) _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 To debug progress updates, use: ```r > handlers("debug") > 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} ``` [progressr]: https://cran.r-project.org/package=progressr [beepr]: https://cran.r-project.org/package=beepr [progress]: https://cran.r-project.org/package=progress [purrr]: https://cran.r-project.org/package=purrr [future]: https://cran.r-project.org/package=future [foreach]: https://cran.r-project.org/package=foreach [future.apply]: https://cran.r-project.org/package=future.apply [doParallel]: https://cran.r-project.org/package=doParallel [doFuture]: https://cran.r-project.org/package=doFuture [furrr]: https://cran.r-project.org/package=furrr [pbapply]: https://cran.r-project.org/package=pbapply [pbmcapply]: https://cran.r-project.org/package=pbmcapply [plyr]: https://cran.r-project.org/package=plyr [BiocParallel]: https://www.bioconductor.org/packages/BiocParallel/ progressr/vignettes/incl/0000755000175000017500000000000014122707130015364 5ustar nileshnileshprogressr/vignettes/incl/clean.css0000644000175000017500000000152214122707130017160 0ustar nileshnileshbody { font-family: sans-serif; line-height: 1.6; padding-left: 3ex; padding-right: 3ex; background-color: white; color: black; } a { color: #4183C4; text-decoration: none; } h1, h2, h3 { margin: 2ex 0 1ex; padding: 0; font-weight: bold; -webkit-font-smoothing: antialiased; cursor: text; position: relative; } h2 { border-bottom: 1px solid #cccccc; } code { margin: 0 2px; padding: 0 5px; white-space: nowrap; border: 1px solid #eaeaea; background-color: #f8f8f8; border-radius: 3px; } pre code { margin: 0; padding: 0; white-space: pre; border: none; background: transparent; } pre { background-color: #f8f8f8; border: 1px solid #cccccc; line-height: 2.5x; overflow: auto; padding: 0.6ex 1ex; border-radius: 3px; } pre code { background-color: transparent; border: none; } progressr/build/0000755000175000017500000000000014157512126013535 5ustar nileshnileshprogressr/build/vignette.rds0000644000175000017500000000037114157512126016075 0ustar nileshnilesh‹eË Â0EÓ—/ĺråØp'ˆ n¤¸pÚXƒmRÒ¨¸óË­m«I{“3“›{BlâZ6±øu|X:0G0-â’>|ǹ’‰bE¡æ\h%ƒ,FÄ´!³¥˜m _"Í¥@ä÷:é,EŒ±ä¿õg†kÿœ{‚f¬@EÝË™ˆÍöÕ{b…5›ÓèLVÉÞ•'‚iÝèLyúÕL\¹2o1>¬]ÝÛ²ûMªúîÓ©wýíçí¹n„³[­ÿüÕoùëßÊ¡¯ä-¨³šÔ°”0p`QJ Ø ¦šGõÆ÷ œr©p progressr/tests/0000755000175000017500000000000014122707130013571 5ustar nileshnileshprogressr/tests/debug.R0000644000175000017500000000103114122707130014775 0ustar nileshnileshsource("incl/start.R") message("with_progress() - progressr.debug = TRUE ...") options(progressr.debug = TRUE) with_progress({ y <- slow_sum(1:10) }) with_progress({ progress <- progressor(steps = 1 + 2 + 1) relay_progress <- progress_aggregator(progress) p <- progress() progressr::progress(p) ## duplicated - will be ignored relay_progress(slow_sum(1:2)) progress(type = "finish") progress() ## one too many - will be ignored }) message("with_progress() - progressr.debug = TRUE ... done") source("incl/end.R") progressr/tests/with_progress,delay.R0000644000175000017500000000270314122707130017710 0ustar nileshnileshsource("incl/start.R") options(progressr.tests.fake_handlers = c("handler_beepr", "handler_notifier", "handler_pbmcapply", "handler_tkprogressbar", "handler_winprogressbar")) options(progressr.clear = FALSE) options(progressr.enable_after = NULL) options(progressr.debug = FALSE) options(progressr.times = NULL) record_output <- function(expr, envir = parent.frame()) { conditions <- list() stdout <- utils::capture.output({ withCallingHandlers( expr, condition = function(c) { if (inherits(c, c("progression", "error"))) return() conditions[[length(conditions) + 1L]] <<- c } ) }, split = TRUE) list(stdout = stdout, conditions = conditions) } message("*** with_progress() - delaying output ...") x <- 1:5 ## Record truth output_truth <- record_output({ y_truth <- slow_sum(x, stdout=TRUE, message=TRUE) }) 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) }, delay_stdout = delay, delay_conditions = if (delay) "condition" else character(0L)) }) stopifnot(identical(output$stdout, output_truth$stdout)) stopifnot(identical(output$conditions, output_truth$conditions)) stopifnot(identical(y, y_truth)) message(sprintf("- with_progress() - delay = %s ... DONE", delay)) } message("*** with_progress() - delaying output ... DONE") source("incl/end.R") progressr/tests/zzz,doFuture.R0000644000175000017500000000137014122707130016344 0ustar nileshnileshsource("incl/start.R") if (requireNamespace("doFuture", quietly = TRUE)) { library("doFuture", character.only = TRUE) registerDoFuture() for (strategy in c("sequential", "multisession", "multicore")) { future::plan(strategy) print(future::plan()) message("* with_progress()") with_progress({ p <- progressor(4) y <- foreach(n = 3:6) %dopar% { p() slow_sum(1:n, stdout=TRUE, message=TRUE) } }) message("* global progression handler") handlers(global = TRUE) local({ p <- progressor(4) y <- foreach(n = 3:6) %dopar% { p() slow_sum(1:n, stdout=TRUE, message=TRUE) } }) handlers(global = FALSE) } } source("incl/end.R") progressr/tests/zzz,purrr.R0000644000175000017500000000101614122707130015716 0ustar nileshnileshsource("incl/start.R") if (requireNamespace("purrr", quietly = TRUE)) { message("* with_progress()") with_progress({ p <- progressor(4) y <- purrr::map(3:6, function(n) { p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) message("* global progression handler") handlers(global = TRUE) local({ p <- progressor(4) y <- purrr::map(3:6, function(n) { p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) handlers(global = FALSE) } source("incl/end.R") progressr/tests/handler_pbmcapply.R0000644000175000017500000000040614122707130017400 0ustar nileshnileshsource("incl/start.R") if (requireNamespace("pbmcapply", quietly = TRUE)) { handlers("pbmcapply") for (x in list(1:10, 1L, integer(0))) { message("length(x): ", length(x)) with_progress({ y <- slow_sum(x) }) print(y) } } source("incl/end.R") progressr/tests/exceptions.R0000644000175000017500000000141114122707130016072 0ustar nileshnileshsource("incl/start.R") message("Exceptions ...") message("- with_progress()") invalid <- progression(type = "unknown", session_uuid = "dummy", progressor_uuid = "dummy", progression_index = 0L) print(invalid) res <- tryCatch(with_progress({ signalCondition(invalid) }, handlers = handler_debug), error = identity) str(res) stopifnot(inherits(res, "error")) message("- progress_aggregator()") invalid <- progression(type = "unknown", session_uuid = "dummy", progressor_uuid = "dummy", progression_index = 0L) print(invalid) local({ progress <- progress_aggregator(progressor(2L)) res <- tryCatch(progress({ signalCondition(invalid) }), error = identity) str(res) stopifnot(inherits(res, "error")) }) message("Exceptions ... done") source("incl/end.R") progressr/tests/progressor.R0000644000175000017500000000120514122707130016117 0ustar nileshnileshsource("incl/start.R") message("progressor() ...") message("- basic") local({ p <- progressor(3L) print(p) p() p("A message") }) message("- default message") local({ p <- progressor(along = 1:3, message = "A default message") print(p) p() p("A message") }) message("- zero length") local({ p <- progressor(0L) print(p) p() p("A message") }) message("- multiple consequtive progressors") local({ message("Progressor #1") p <- progressor(2L) for (kk in 1:2) p() message("Progressor #2") p <- progressor(3L) for (kk in 1:3) p() message("Done") }) message("progressor() ... DONE") source("incl/end.R") progressr/tests/progress_aggregator.R0000644000175000017500000000251514122707130017765 0ustar nileshnileshsource("incl/start.R") message("progress_aggregator() ...") with_progress({ progress <- progressor(steps = 1 + 3 + 10 + 1) relay_progress <- progress_aggregator(progress) progress() relay_progress(slow_sum(1:3)) relay_progress(slow_sum(1:10)) progress() }) message("- Stray progressions from unknown sources") slow_prod <- function(x, delay = getOption("progressr.demo.delay", 0.05)) { progress <- progressor(2*length(x)) res <- 0 for (kk in seq_along(x)) { progress(message = sprintf("Multiplying %g", kk)) Sys.sleep(0.8*delay) res <- res * x[kk] progress(message = "...") Sys.sleep(0.2*delay) } res } ## This will only show progress for the *first* of the three ## functions that report progress. Any progression updates from ## the second and third will be ignored, because they are from ## a different source with_progress({ x <- 1:10 a <- slow_sum(x) b <- slow_prod(x) c <- slow_sum(-x) }) ## To get progression from all of them, we need to know how many ## steps they report on and then use a gather-and-relay handler with_progress({ x <- 1:10 progress <- progressor(3*length(x)) relay_progress <- progress_aggregator(progress) relay_progress({ a <- slow_sum(x) b <- slow_prod(x) c <- slow_sum(-x) }) }) message("progress_aggregator() ... done") source("incl/end.R") progressr/tests/handlers.R0000644000175000017500000000166514122707130015524 0ustar nileshnileshsource("incl/start.R") message("handlers() ...") hs <- handlers() print(hs) for (kk in seq_along(hs)) { h <- hs[[kk]] print(h) handler <- h() print(handler) } hs <- handlers("txtprogressbar") print(hs) for (kk in seq_along(hs)) { h <- hs[[kk]] print(h) handler <- h() print(handler) } hs <- handlers("handler_txtprogressbar") print(hs) message("handlers() - exceptions ...") ## Will as a side-effect set an empty list of handlers() res <- handlers("non-existing-handler", on_missing = "ignore") res <- handlers() stopifnot(is.list(res), length(res) == 0L) res <- tryCatch({ handlers("non-existing-handler", on_missing = "warning") }, warning = identity) stopifnot(inherits(res, "warning")) res <- tryCatch({ handlers("non-existing-handler", on_missing = "error") }, error = identity) stopifnot(inherits(res, "error")) message("handlers() - exceptions ... DONE") message("handlers() ... DONE") source("incl/end.R") progressr/tests/zzz,shiny.R0000644000175000017500000000072514122707130015704 0ustar nileshnileshsource("incl/start.R") if (requireNamespace("shiny", quietly = TRUE)) { ## This will generate: ## Error in shiny::withProgress(expr, ..., env = env, quoted = TRUE) : ## 'session' is not a ShinySession object. res <- tryCatch({ withProgressShiny({ p <- progressor(3L) y <- lapply(1:3, function(n) { p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) y }) }, error = identity) print(res) } source("incl/end.R") progressr/tests/with_progress.R0000644000175000017500000000761714122707130016626 0ustar nileshnileshsource("incl/start.R") options(progressr.demo.delay = 0.001) options(progressr.interval = 0.0) options(progressr.clear = FALSE) message("with_progress() ...") x <- 1:100 truth <- sum(x) message("with_progress() - default ...") if (requireNamespace("utils")) { with_progress({ sum <- slow_sum(x) }) print(sum) stopifnot(sum == truth) with_progress({ cat("This stdout output will be delayed") message("This message will be delayed") warning("This warning will be delayed") signalCondition(simpleCondition("This simpleCondition will be delayed")) sum <- slow_sum(x) }, interval = 0.1, enable = TRUE, delay_conditions = "condition") print(sum) stopifnot(sum == truth) } message("with_progress() - default ... done") message("with_progress() - filesize ...") with_progress({ sum <- slow_sum(x) }, handlers = handler_filesize()) print(sum) stopifnot(sum == truth) message("with_progress() - filesize ... done") message("with_progress() - utils::txtProgressBar() ...") if (requireNamespace("utils")) { with_progress({ sum <- slow_sum(x) }, handlers = handler_txtprogressbar(style = 2L)) print(sum) stopifnot(sum == truth) } message("with_progress() - utils::txtProgressBar() ... done") message("with_progress() - tcltk::tkProgressBar() ...") with_progress({ sum <- slow_sum(x) }, handlers = handler_tkprogressbar) message("with_progress() - tcltk::tkProgressBar() ... done") message("with_progress() - utils::winProgressBar() ...") with_progress({ sum <- slow_sum(x) }, handlers = handler_winprogressbar) message("with_progress() - utils::winProgressBar() ... done") message("with_progress() - progress::progress_bar() ...") if (requireNamespace("progress")) { ## Display progress using default handler with_progress({ sum <- slow_sum(x) }, handlers = handler_progress(clear = FALSE)) print(sum) stopifnot(sum == truth) } message("with_progress() - progress::progress_bar() ... done") message("with_progress() - pbmcapply::progressBar() ...") with_progress({ sum <- slow_sum(x) }, handlers = handler_pbmcapply) message("with_progress() - pbmcapply::progressBar() ... done") message("with_progress() - ascii_alert ...") with_progress({ sum <- slow_sum(x) }, handlers = handler_ascii_alert()) print(sum) stopifnot(sum == truth) message("with_progress() - ascii_alert ... done") message("with_progress() - beepr::beep() ...") with_progress({ sum <- slow_sum(x) }, handlers = handler_beepr) print(sum) stopifnot(sum == truth) message("with_progress() - beepr::beep() ... done") message("with_progress() - notifier::notify() ...") with_progress({ sum <- slow_sum(x) }, handlers = handler_notifier) print(sum) stopifnot(sum == truth) message("with_progress() - notifier::notify() ... done") message("with_progress() - void ...") ## Mute progress updates with_progress({ sum <- slow_sum(x) }, handlers = NULL) print(sum) stopifnot(sum == truth) message(" - via option") ## NOTE: Set it to NULL, will use the default utils::txtProgressBar() options(progressr.handlers = list()) with_progress({ sum <- slow_sum(x) }) print(sum) stopifnot(sum == truth) message("with_progress() - void ... done") message("with_progress() - multiple handlers ...") if (requireNamespace("utils", quietly = TRUE)) { handlers <- list(handler_txtprogressbar, handler_newline, handler_debug) options(progressr.handlers = handlers) with_progress({ sum <- slow_sum(x) }) print(sum) stopifnot(sum == truth) } 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") progressr/tests/zzz,furrr.R0000644000175000017500000000127614122707130015714 0ustar nileshnileshsource("incl/start.R") 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) { p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) message("* global progression handler") handlers(global = TRUE) local({ p <- progressor(4) y <- furrr::future_map(3:6, function(n) { p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) handlers(global = FALSE) } } source("incl/end.R") progressr/tests/handler_shiny.R0000644000175000017500000000025714122707130016547 0ustar nileshnileshsource("incl/start.R") options(progressr.clear = FALSE) message("handler_shiny ...") h <- handler_shiny() print(h) message("handler_shiny ... done") source("incl/end.R") progressr/tests/progression.R0000644000175000017500000000100714122707130016264 0ustar nileshnileshsource("incl/start.R") message("progression() ...") p <- progression() print(p) stopifnot(inherits(p, "progression")) p <- progress() print(p) stopifnot(inherits(p, "progression")) p2 <- progress(p) print(p2) stopifnot(identical(p2, p)) res <- tryCatch(progress(p), progression = function(p) TRUE) print(res) stopifnot(isTRUE(res)) res <- FALSE withCallingHandlers(progress(p), progression = function(p) { res <<- TRUE }) print(res) stopifnot(isTRUE(res)) message("progression() ... done") source("incl/end.R") progressr/tests/demo.R0000644000175000017500000000201514122707130014636 0ustar nileshnileshsource("incl/start.R") library(future) supportedStrategies <- function(...) future:::supportedStrategies() isWin32 <- FALSE availCores <- 2L message("*** Demos ...") message("*** Mandelbrot demo ...") if (!isWin32) { options(future.demo.mandelbrot.nrow = 2L) options(future.demo.mandelbrot.resolution = 50L) options(future.demo.mandelbrot.delay = FALSE) for (cores in 1:availCores) { message(sprintf("Testing with %d cores ...", cores)) options(mc.cores = cores) for (strategy in supportedStrategies(cores)) { message(sprintf("- plan('%s') ...", strategy)) plan(strategy) demo("mandelbrot", package = "progressr", ask = FALSE) message(sprintf("- plan('%s') ... DONE", strategy)) } message(sprintf("Testing with %d cores ... DONE", cores)) } ## for (cores ...) } else { message(" - This demo requires R (>= 3.2.0). Skipping test. (Skipping also on Win32 i386 for speed)") } message("*** Mandelbrot demo ... DONE") message("*** Demos ... DONE") source("incl/end.R") progressr/tests/with_progress,relay.R0000644000175000017500000000327714122707130017735 0ustar nileshnileshsource("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)) 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))) } message("with_progress() - standard output, messages, warnings ... done") source("incl/end.R") progressr/tests/without_progress.R0000644000175000017500000000116714122707130017350 0ustar nileshnileshsource("incl/start.R") message("without_progress() ...") x <- 1:10 y0 <- slow_sum(x) with_progress(y <- slow_sum(x)) without_progress(y <- slow_sum(x)) 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") progressr/tests/handler_make_progression.R0000644000175000017500000000107614122707130020764 0ustar nileshnileshsource("incl/start.R") options(progressr.debug = TRUE) message("make_progression_handler() ...") my_handler <- function(symbol = "*", file = stderr(), target = "terminal", ...) { reporter <- local({ list( update = function(config, state, progression, ...) { if (state$enabled && progression$amount != 0) cat(file = file, symbol) } ) }) make_progression_handler("my_handler", reporter, ...) } h1 <- my_handler() print(h1) h2 <- my_handler(enable = FALSE) print(h2) message("make_progression_handler() ... done") source("incl/end.R") progressr/tests/handler_progress.R0000644000175000017500000000105714122707130017260 0ustar nileshnileshsource("incl/start.R") options(progressr.clear = FALSE) if (requireNamespace("progress", quietly = TRUE)) { options(progressr.handlers = handler_progress) } message("handler_progress() ...") for (x in list(1:10, 1L, integer(0))) { message("length(x): ", length(x)) with_progress({ progress <- progressor(along = x) for (ii in x) { Sys.sleep(getOption("progressr.demo.delay", 0.1)) progress(message = sprintf("(%s)", paste(letters[1:ii], collapse=""))) } }) } message("handler_progress() ... done") source("incl/end.R") progressr/tests/zzz,foreach_do.R0000644000175000017500000000077514122707130016650 0ustar nileshnileshsource("incl/start.R") if (require("foreach", quietly = TRUE)) { message("* with_progress()") with_progress({ p <- progressor(4) y <- foreach(n = 3:6) %do% { p() slow_sum(1:n, stdout=TRUE, message=TRUE) } }) message("* global progression handler") handlers(global = TRUE) local({ p <- progressor(4) y <- foreach(n = 3:6) %do% { p() slow_sum(1:n, stdout=TRUE, message=TRUE) } }) handlers(global = FALSE) } source("incl/end.R") progressr/tests/globals,relay.R0000644000175000017500000000645014122707130016455 0ustar nileshnileshif (getRversion() >= "4.0.0") { source("incl/start.R") nsinks0 <- sink.number(type = "output") options(progressr.clear = FALSE) delay <- getOption("progressr.demo.delay", 0.1) message("- delay: ", delay, " seconds") handlers("txtprogressbar") handlers <- supported_progress_handlers() handlers(global = FALSE) stopifnot(sink.number(type = "output") == nsinks0) handlers(global = TRUE) stopifnot(sink.number(type = "output") == nsinks0) 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)) for (delta in c(0L, +1L, -1L)) { message(sprintf(" - delta = %+d", delta)) handlers(global = FALSE) stopifnot(sink.number(type = "output") == nsinks0) handlers(global = TRUE) stopifnot(sink.number(type = "output") == nsinks0) status <- progressr:::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) ) nsinks <- sink.number(type = "output") stopifnot(nsinks == nsinks0) truth <- c() relay <- record_relay(local({ 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) ) ## Assert sinks are balanced stopifnot(sink.number(type = "output") == nsinks) cat(paste(c(relay$stdout, ""), collapse = "\n")) message(relay$message, append = FALSE) status <- progressr:::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 ...) message(sprintf("* Handler %d ('%s') of %d ... done", kk, name, length(handlers))) } message("global progress handlers - standard output, messages, warnings ... done") handlers(global = FALSE) source("incl/end.R") } ## if (getRversion() >= "4.0.0") progressr/tests/incl/0000755000175000017500000000000014122707130014516 5ustar nileshnileshprogressr/tests/incl/start,load-only.R0000644000175000017500000000775114122707130017703 0ustar nileshnilesh## Record original state ovars <- ls() oenvs <- oenvs0 <- Sys.getenv() oopts0 <- options() ## Default options for tests oopts <- options() check_full <- isTRUE(as.logical(Sys.getenv("R_CHECK_FULL", "FALSE"))) ## Private `%||%` <- progressr:::`%||%` hpaste <- progressr:::hpaste mdebug <- progressr:::mdebug mprint <- progressr:::mprint mprintf <- progressr:::mprintf mstr <- progressr:::mstr query_r_cmd_check <- progressr:::query_r_cmd_check in_r_cmd_check <- progressr:::in_r_cmd_check stop_if_not <- progressr:::stop_if_not printf <- function(...) cat(sprintf(...)) known_progression_handlers <- progressr:::known_progression_handlers is_rstudio_console <- function() { (Sys.getenv("RSTUDIO") == "1") && !nzchar(Sys.getenv("RSTUDIO_TERM")) } non_supported_progression_handlers <- function() { names <- character(0L) for (pkg in c("beepr", "notifier", "pbmcapply", "progress", "shiny")) { if (!requireNamespace(pkg, quietly = TRUE)) names <- c(names, pkg) } if (!"tcltk" %in% capabilities()) { names <- c(names, "tkprogressbar") } if (.Platform$OS.type != "windows") { names <- c(names, "winprogressbar") } if (!is_rstudio_console()) { names <- c(names, "rstudio") } if (!check_full) { names <- c(names, "notifier") names <- c(names, "shiny") } names <- unique(names) sprintf("handler_%s", names) } 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) options(progressr.demo.delay = 0.0) options(progressr.enable = TRUE) options(progressr.enable_after = 0.0) options(progressr.interval = 0.1) options(progressr.times = +Inf) options(progressr.tests.fake_handlers = c(non_supported_progression_handlers(), "handler_beepr", "handler_notifier", "handler_progress")) ## WORKAROUND: Make sure tests also work with 'covr' package covr <- ("covr" %in% loadedNamespaces()) if (covr) { globalenv <- function() parent.frame() baseenv <- function() environment(base::sample) } 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) } ## Adopted from R.utils::cmsg() console_msg <- function(..., collapse = "\n", sep = "\n", appendLF = TRUE) { fh <- tempfile() on.exit(file.remove(fh)) cat(..., collapse = sep, sep = sep, 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() } progressr/tests/incl/end.R0000644000175000017500000000217314122707130015412 0ustar nileshnilesh## Undo options ## (a) Added added <- setdiff(names(options()), names(oopts0)) opts <- vector("list", length = length(added)) names(opts) <- added options(opts) ## (b) Modified options(oopts) ## (c) Removed, e.g. future.plan=NULL removed <- setdiff(names(oopts0), names(options())) opts <- oopts0[removed] options(opts) ## (d) Assert that everything was undone stopifnot(identical(options(), oopts0)) ## Undo system environment variables ## (a) Added cenvs <- Sys.getenv() added <- setdiff(names(cenvs), names(oenvs0)) for (name in added) Sys.unsetenv(name) ## (b) Missing missing <- setdiff(names(oenvs0), names(cenvs)) if (length(missing) > 0) do.call(Sys.setenv, as.list(oenvs0[missing])) ## (c) Modified? for (name in intersect(names(cenvs), names(oenvs0))) { ## WORKAROUND: On Linux Wine, base::Sys.getenv() may ## return elements with empty names. /HB 2016-10-06 if (nchar(name) == 0) next if (!identical(cenvs[[name]], oenvs0[[name]])) { do.call(Sys.setenv, as.list(oenvs0[name])) } } ## (d) Assert that everything was undone stopifnot(identical(Sys.getenv(), oenvs0)) ## Undo variables rm(list = c(setdiff(ls(), ovars))) progressr/tests/incl/start.R0000644000175000017500000000006614122707130016000 0ustar nileshnileshlibrary("progressr") source("incl/start,load-only.R") progressr/tests/zzz,future.apply.R0000644000175000017500000000133514122707130017206 0ustar nileshnileshsource("incl/start.R") 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) y <- future.apply::future_lapply(3:6, function(n) { p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) message("* global progression handler") handlers(global = TRUE) local({ p <- progressor(4) y <- future.apply::future_lapply(3:6, function(n) { p() slow_sum(1:n, stdout=TRUE, message=TRUE) }) }) handlers(global = FALSE) } } source("incl/end.R") progressr/tests/utils.R0000644000175000017500000000467614122707130015071 0ustar nileshnileshsource("incl/start.R") message("*** utils ...") message("*** hpaste() ...") # Some vectors x <- 1:6 y <- 10:1 z <- LETTERS[x] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Abbreviation of output vector # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - printf("x = %s.\n", hpaste(x)) ## x = 1, 2, 3, ..., 6. printf("x = %s.\n", hpaste(x, maxHead = 2)) ## x = 1, 2, ..., 6. printf("x = %s.\n", hpaste(x, maxHead = 3)) # Default ## x = 1, 2, 3, ..., 6. # It will never output 1, 2, 3, 4, ..., 6 printf("x = %s.\n", hpaste(x, maxHead = 4)) ## x = 1, 2, 3, 4, 5 and 6. # Showing the tail printf("x = %s.\n", hpaste(x, maxHead = 1, maxTail = 2)) ## x = 1, ..., 5, 6. # Turning off abbreviation printf("y = %s.\n", hpaste(y, maxHead = Inf)) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ## ...or simply printf("y = %s.\n", paste(y, collapse = ", ")) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 # Change last separator printf("x = %s.\n", hpaste(x, lastCollapse = " and ")) ## x = 1, 2, 3, 4, 5 and 6. # No collapse stopifnot(all(hpaste(x, collapse = NULL) == x)) # Empty input stopifnot(identical(hpaste(character(0)), character(0))) message("*** hpaste() ... DONE") message("*** mdebug() ...") mdebug("Hello #", 1) mprint(1:3) mprintf("Hello #%d", 1) mstr(1:3) options(progressr.debug = TRUE) mdebug("Hello #", 2) mprint(1:3) mprintf("Hello #%d", 2) mstr(1:3) options(progressr.debug = FALSE) mdebug("Hello #", 3) mprint(1:3) mprintf("Hello #%d", 3) mstr(1:3) message("*** mdebug() ... DONE") message("*** stop_if_not() ...") stop_if_not() tryCatch(stop_if_not(c(1,2,3,4,5,6,7,8,9,10,1,2,3,4,5,6,7,8,9,10,1,2,3,4,5,6,7,8,9,10,1,2,3,4,5,6,7,8,9,10)), error = identity) message("*** stop_if_not() ... done") message("*** %||% ...") print(NULL %||% TRUE) print(TRUE %||% FALSE) message("*** %||% ... done") message("*** query_r_cmd_check() ...") print(query_r_cmd_check()) cat("Command line arguments:\n") args <- commandArgs() print(args) cat("Working directory:\n") pwd <- getwd() print(pwd) message("*** query_r_cmd_check() ... done") message("*** in_r_cmd_check() ...") print(in_r_cmd_check()) message("*** in_r_cmd_check() ... done") message("*** .onLoad() ...") progressr:::.onLoad(pkgname = "progressr") message("*** .onLoad() ... done") message("*** known_progression_handlers() ...") res <- known_progression_handlers() str(res) message("*** known_progression_handlers() ... done") message("*** utils ... DONE") source("incl/end.R") progressr/tests/zzz,plyr.R0000644000175000017500000000101314122707130015527 0ustar nileshnileshsource("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") handlers(global = TRUE) local({ y <- plyr::llply(3:6, function(n, ...) { slow_sum(1:n, stdout=TRUE, message=TRUE) }, .progress = "progressr") }) handlers(global = FALSE) } source("incl/end.R") progressr/tests/handler_tkprogressbar.R0000644000175000017500000000111314122707130020275 0ustar nileshnileshsource("incl/start.R") options(progressr.clear = FALSE) if (capabilities("tcltk") && requireNamespace("tcltk", quietly = TRUE)) { options(progressr.handlers = handler_tkprogressbar) } message("handler_progress() ...") for (x in list(1:10, 1L, integer(0))) { message("length(x): ", length(x)) with_progress({ progress <- progressor(along = x) for (ii in x) { Sys.sleep(getOption("progressr.demo.delay", 0.1)) progress(message = sprintf("(%s)", paste(letters[1:ii], collapse=""))) } }) } message("handler_progress() ... done") source("incl/end.R") progressr/tests/handler_rstudio.R0000644000175000017500000000111314122707130017076 0ustar nileshnileshsource("incl/start.R") options(progressr.clear = FALSE) if (requireNamespace("rstudioapi", quietly = TRUE) && rstudioapi::isAvailable()) { options(progressr.handlers = handler_rstudio) } message("handler_rstudio() ...") for (x in list(1:10, 1L, integer(0))) { message("length(x): ", length(x)) with_progress({ progress <- progressor(along = x) for (ii in x) { Sys.sleep(getOption("progressr.demo.delay", 0.1)) progress(message = sprintf("(%s)", paste(letters[1:ii], collapse=""))) } }) } message("handler_rstudio() ... done") source("incl/end.R") progressr/tests/handler_txtprogressbar.R0000644000175000017500000000120114122707130020474 0ustar nileshnileshsource("incl/start.R") options(progressr.clear = FALSE) message("txtprogressbar ...") for (style in 1:3) { message(sprintf("- style = %d ...", style)) handlers(handler_txtprogressbar(style = style)) for (x in list(1:10, 1L, integer(0))) { message("length(x): ", length(x)) with_progress({ progress <- progressor(along = x) for (ii in x) { Sys.sleep(getOption("progressr.demo.delay", 0.1)) progress(message = sprintf("(%s)", paste(letters[1:ii], collapse=""))) } }) } message(sprintf("- style = %d ... done", style)) } message("txtprogressbar ... done") source("incl/end.R") progressr/R/0000755000175000017500000000000014157465763012655 5ustar nileshnileshprogressr/R/handler_ascii_alert.R0000644000175000017500000000251314157457501016744 0ustar nileshnilesh#' Progression Handler: Progress Reported as ASCII BEL Symbols (Audio or Blink) in the Terminal #' #' A progression handler based on `cat("\a", file=stderr())`. #' #' @inheritParams make_progression_handler #' #' @param symbol (character string) The character symbol to be outputted, #' which by default is the ASCII BEL character (`'\a'` = `'\007'`) character. #' #' @param file (connection) A [base::connection] to where output should be sent. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @example incl/handler_ascii_alert.R #' #' @export handler_ascii_alert <- function(symbol = "\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), target = c("terminal", "audio"), ...) { reporter <- local({ list( hide = function(...) NULL, unhide = function(...) NULL, interrupt = function(config, state, progression, ...) { msg <- getOption("progressr.interrupt.message", "interrupt detected") msg <- paste(c("", msg, ""), collapse = "\n") cat(msg, file = file) }, update = function(config, state, progression, ...) { if (state$enabled && progression$amount != 0) cat(file = file, symbol) } ) }) make_progression_handler("ascii_alert", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/options.R0000644000175000017500000002314414157465405014470 0ustar nileshnilesh#' Options and environment variables used by the 'progressr' packages #' #' Below are environment variables and \R options that are used by the #' \pkg{progressr} package. # #' Below are all \R options that are currently used by the \pkg{progressr} package.\cr #' \cr #' \emph{WARNING: Note that the names and the default values of these options may change in future versions of the package. Please use with care until further notice.} #' #' #' @section Options for controlling progression reporting: #' #' \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 (`handler_txtprogressbar`) progression handlers is used. The recommended way to set this option is via [progressr::handlers()]. (Default: NULL) #' } #' } #' #' #' @section Options for controlling progression handlers: #' #' \describe{ #' \item{\option{progressr.clear}:}{ #' (logical) #' If TRUE, any output, typically visual, produced by a reporter will be cleared/removed upon completion, if possible. (Default: TRUE) #' } #' #' \item{\option{progressr.enable}:}{ #' (logical) #' If FALSE, then progress is not reported. #' (Default: TRUE) #' } #' #' \item{\option{progressr.enable_after}:}{ #' (numeric) #' Delay (in seconds) before progression updates are reported. #' (Default: `0.0`) #' } #' #' \item{\option{progressr.times}:}{ #' (numeric) #' The maximum number of times a handler should report progression updates. If zero, then progress is not reported. #' (Default: `+Inf`) #' } #' #' \item{\option{progressr.interval}:}{ #' (numeric) #' The minimum time (in seconds) between successive progression updates from this handler. #' (Default: `0.0`) #' } #' #' \item{\option{progressr.intrusiveness}:}{ #' (numeric) #' A non-negative scalar on how intrusive (disruptive) the reporter to the user. This multiplicative scalar applies to the _interval_ and _times_ parameters. (Default: `1.0`)\cr #' #' \describe{ #' \item{\option{progressr.intrusiveness.auditory}:}{(numeric) intrusiveness for auditory progress handlers (Default: `5.0`)} #' \item{\option{progressr.intrusiveness.file}:}{(numeric) intrusiveness for file-based progress handlers (Default: `5.0`)} #' \item{\option{progressr.intrusiveness.gui}:}{(numeric) intrusiveness for graphical-user-interface progress handlers (Default: `1.0`)} #' \item{\option{progressr.intrusiveness.notifier}:}{(numeric) intrusiveness for progress handlers that creates notifications (Default: `10.0`)} #' \item{\option{progressr.intrusiveness.terminal}:}{(numeric) intrusiveness for progress handlers that outputs to the terminal (Default: `1.0`)} #' \item{\option{progressr.intrusiveness.debug}:}{(numeric) intrusiveness for "debug" progress handlers (Default: `0.0`)} #' } #' } #' } #' #' @section Options for controlling how standard output and conditions are relayed: #' #' \describe{ #' \item{\option{progressr.delay_conditions}:}{ #' (character vector) #' condition classes to be captured and relayed at the end after any captured standard output is relayed. (Default: `c("condition")`) #' } #' #' \item{\option{progressr.delay_stdout}:}{ #' (logical) #' If TRUE, standard output is captured and relayed at the end just before any captured conditions are relayed. (Default: TRUE) #' } #' } #' #' @section Options for controlling interrupts: #' #' \describe{ #' \item{\option{progressr.interrupts}:}{ #' (logical) #' Controls whether interrupts should be detected or not. #' If FALSE, then interrupts are not detected and progress information #' is generated. (Default: `TRUE`) #' } #' #' \item{\option{progressr.delay_stdout}:}{ #' (logical) #' If TRUE, standard output is captured and relayed at the end just before any captured conditions are relayed. (Default: TRUE) #' } #' } #' #' #' @section Options for debugging progression updates: #' #' \describe{ #' \item{\option{progressr.debug}:}{(logical) If TRUE, extensive debug messages are generated. (Default: FALSE)} #' } #' #' #' @section Options for progressr examples and demos: #' #' \describe{ #' \item{\option{progressr.demo.delay}:}{(numeric) Delay (in seconds) between each iteration of [slow_sum()]. (Default: `1.0`)} #' } #' #' @section Environment variables that set R options: #' Some of the above \R \option{progressr.*} options can be set by corresponding #' environment variable \env{R_PROGRESSR_*} _when the \pkg{progressr} package #' is loaded_. #' For example, if `R_PROGRESSR_ENABLE = "true"`, then option #' \option{progressr.enable} is set to `TRUE` (logical). #' For example, if `R_PROGRESSR_ENABLE_AFTER = "2.0"`, then option #' \option{progressr.enable_after} is set to `2.0` (numeric). #' #' @seealso #' To set \R options when \R starts (even before the \pkg{progressr} package is loaded), see the \link[base]{Startup} help page. The \href{https://cran.r-project.org/package=startup}{\pkg{startup}} package provides a friendly mechanism for configuring \R at startup. #' #' @aliases #' progressr.clear #' progressr.debug #' progressr.demo.delay #' progressr.delay_stdout progressr.delay_conditions #' progressr.enable progressr.enable_after #' progressr.interrupts #' progressr.interval #' progressr.intrusiveness #' progressr.intrusiveness.auditory #' progressr.intrusiveness.debug #' progressr.intrusiveness.file #' progressr.intrusiveness.gui #' progressr.intrusiveness.notifier #' progressr.intrusiveness.terminal #' progressr.handlers #' progressr.times #' #' @keywords internal #' @name progressr.options NULL get_package_option <- function(name, default = NULL, package = .packageName) { if (!is.null(package)) { name <- paste(package, name, sep = ".") } getOption(name, default = default) } # Set an R option from an environment variable update_package_option <- function(name, mode = "character", default = NULL, package = .packageName, split = NULL, trim = TRUE, disallow = c("NA"), force = FALSE, debug = FALSE) { if (!is.null(package)) { name <- paste(package, name, sep = ".") } mdebugf("Set package option %s", sQuote(name)) ## Already set? Nothing to do? value <- getOption(name, NULL) if (!force && !is.null(value)) { mdebugf("Already set: %s", sQuote(value)) return(getOption(name)) } ## name="Pkg.foo.Bar" => env="R_PKG_FOO_BAR" env <- gsub(".", "_", toupper(name), fixed = TRUE) env <- paste("R_", env, sep = "") env_value <- value <- Sys.getenv(env, unset = NA_character_) if (is.na(value)) { if (debug) mdebugf("Environment variable %s not set", sQuote(env)) ## Nothing more to do? if (is.null(default)) return(getOption(name)) if (debug) mdebugf("Use argument 'default': ", sQuote(default)) value <- default } if (debug) mdebugf("%s=%s", env, sQuote(value)) ## Trim? if (trim) value <- trim(value) ## Nothing to do? if (!nzchar(value)) return(getOption(name, default = default)) ## Split? if (!is.null(split)) { value <- strsplit(value, split = split, fixed = TRUE) value <- unlist(value, use.names = FALSE) if (trim) value <- trim(value) } ## Coerce? mode0 <- storage.mode(value) if (mode0 != mode) { suppressWarnings({ storage.mode(value) <- mode }) if (debug) { mdebugf("Coercing from %s to %s: %s", mode0, mode, commaq(value)) } } if (length(disallow) > 0) { if ("NA" %in% disallow) { if (any(is.na(value))) { stop(sprintf("Coercing environment variable %s=%s to %s would result in missing values for option %s: %s", sQuote(env), sQuote(env_value), sQuote(mode), sQuote(name), commaq(value))) } } if (is.numeric(value)) { if ("non-positive" %in% disallow) { if (any(value <= 0, na.rm = TRUE)) { stop(sprintf("Environment variable %s=%s specifies a non-positive value for option %s: %s", sQuote(env), sQuote(env_value), sQuote(name), commaq(value))) } } if ("negative" %in% disallow) { if (any(value < 0, na.rm = TRUE)) { stop(sprintf("Environment variable %s=%s specifies a negative value for option %s: %s", sQuote(env), sQuote(env_value), sQuote(name), commaq(value))) } } } } if (debug) { mdebugf("=> options(%s = %s) [n=%d, mode=%s]", dQuote(name), commaq(value), length(value), storage.mode(value)) } do.call(options, args = structure(list(value), names = name)) getOption(name, default = default) } ## Set package options based on environment variables update_package_options <- function(debug = FALSE) { update_package_option("demo.delay", mode = "numeric", debug = debug) ## make_progression_handler() arguments update_package_option("clear", mode = "logical", default = TRUE, debug = debug) update_package_option("enable", mode = "logical", default = interactive(), debug = debug) update_package_option("enable_after", mode = "numeric", default = 0.0, debug = debug) update_package_option("interval", mode = "numeric", default = 0.0, debug = debug) update_package_option("times", mode = "numeric", default = +Inf, debug = debug) update_package_option("interrupts", mode = "logical", default = TRUE, debug = debug) update_package_option("interrupt.message", mode = "character", default = "interrupt detected", debug = debug) ## Life-cycle, e.g. deprecation an defunct update_package_option("lifecycle.progress", mode = "character", default = "deprecated", debug = debug) ## However, not used update_package_option("global.handler", mode = "logical", debug = debug) } progressr/R/handler_pbmcapply.R0000644000175000017500000001157414157457430016464 0ustar nileshnilesh#' Progression Handler: Progress Reported via 'pbmcapply' Progress Bars (Text) in the Terminal #' #' A progression handler for [pbmcapply::progressBar()]. #' #' @inheritParams make_progression_handler #' #' @param style (character) The progress-bar style according to [pbmcapply::progressBar()]. #' #' @param substyle (integer) The progress-bar substyle according to [pbmcapply::progressBar()]. #' #' @param file (connection) A [base::connection] to where output should be sent. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @section Requirements: #' This progression handler requires the \pkg{pbmcapply} package. #' #' @section Appearance: #' Since `style = "txt"` corresponds to using [handler_txtprogressbar()] #' with `style = substyle`, the main usage of this handler is with #' `style = "ETA"` (default) for which `substyle` is ignored. #' Below is how this progress handler renders by default at 0%, 30% and 99% #' progress: #' #' With `handlers(handler_pbmcapply())`: #' ```r #' | | 0%, ETA NA #' |=========== | 30%, ETA 01:32 #' |======================================| 99%, ETA 00:01 #' ``` #' #' @example incl/handler_pbmcapply.R #' #' @importFrom utils file_test flush.console txtProgressBar setTxtProgressBar #' @export handler_pbmcapply <- function(substyle = 3L, style = "ETA", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) { ## Additional arguments passed to the progress-handler backend backend_args <- handler_backend_args(...) if (!is_fake("handler_pbmcapply")) { progressBar <- pbmcapply::progressBar eraseTxtProgressBar <- function(pb) { pb_env <- environment(pb$getVal) with(pb_env, { style_eta <- exists(".time0", inherits = FALSE) if (!style_eta) { if (style == 1L || style == 2L) { n <- .nb } else if (style == 3L) { n <- 3L + nw * width + 6L } } else { ## FIXME: Seems to work; if not, see pbmcapply:::txtProgressBarETA() n <- width } cat("\r", strrep(" ", times = n), "\r", sep = "", file = file) .nb <- 0L flush.console() }) } } else { progressBar <- function(..., style, substyle) txtProgressBar(..., style = substyle) setTxtProgressBar <- function(...) NULL eraseTxtProgressBar <- function(pb) NULL redrawTxtProgressBar <- function(pb) NULL } reporter <- local({ ## Import functions pb <- NULL make_pb <- function(max, ...) { if (!is.null(pb)) return(pb) ## SPECIAL CASE: pbmcapply::progressBar() does not support max == min ## if (max == 0) { pb <<- voidProgressBar() } else { args <- c(list(...), backend_args) pb <<- do.call(progressBar, args = args) } pb } list( reset = function(...) { pb <<- NULL }, hide = function(...) { if (is.null(pb)) return() eraseTxtProgressBar(pb) }, unhide = function(...) { if (is.null(pb)) return() redrawTxtProgressBar(pb) }, interrupt = function(config, state, progression, ...) { msg <- getOption("progressr.interrupt.message", "interrupt detected") msg <- paste(c("", msg, ""), collapse = "\n") cat(msg, file = file) }, initiate = function(config, state, progression, ...) { if (!state$enabled || config$times == 1L) return() stop_if_not(is.null(pb)) make_pb(max = config$max_steps, style = style, substyle = substyle, file = file) }, update = function(config, state, progression, ...) { if (!state$enabled || config$times <= 2L) return() make_pb(max = config$max_steps, style = style, substyle = substyle, file = file) if (inherits(progression, "sticky")) { eraseTxtProgressBar(pb) message(paste0(state$message, "")) redrawTxtProgressBar(pb) } if (progression$amount == 0) return() setTxtProgressBar(pb, value = state$step) }, finish = function(config, state, progression, ...) { ## Already finished? if (is.null(pb)) return() if (!state$enabled) return() if (config$clear) { eraseTxtProgressBar(pb) ## Suppress newline outputted by close() pb_env <- environment(pb$getVal) file <- pb_env$file pb_env$file <- tempfile() on.exit({ if (file_test("-f", pb_env$file)) file.remove(pb_env$file) pb_env$file <- file }) } else { setTxtProgressBar(pb, value = state$step) } close(pb) pb <<- NULL } ) }) make_progression_handler("pbmcapply", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/handler_newline.R0000644000175000017500000000235114157457446016136 0ustar nileshnilesh#' Progression Handler: Progress Reported as a New Line (Text) in the Terminal #' #' @inheritParams make_progression_handler #' #' @param symbol (character string) The character symbol to be outputted, #' which by default is the ASCII NL character (`'\n'` = `'\013'`) character. #' #' @param file (connection) A [base::connection] to where output should be sent. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @keywords internal #' @export handler_newline <- function(symbol = "\n", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", ...) { reporter <- local({ list( hide = function(...) NULL, unhide = function(...) NULL, interrupt = function(config, state, progression, ...) { msg <- getOption("progressr.interrupt.message", "interrupt detected") msg <- paste(c("", msg, ""), collapse = "\n") cat(msg, file = file) }, initiate = function(...) cat(file = file, symbol), update = function(...) cat(file = file, symbol), finish = function(...) cat(file = file, symbol) ) }) make_progression_handler("newline", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/make_calling_handler.R0000644000175000017500000000054314157452700017070 0ustar nileshnileshmake_calling_handler <- function(handlers) { if (length(handlers) > 1L) { calling_handler <- function(p) { finished <- FALSE for (kk in seq_along(handlers)) { handler <- handlers[[kk]] finished <- finished || handler(p) } finished } } else { calling_handler <- handlers[[1]] } calling_handler } progressr/R/progressor.R0000644000175000017500000001700314156754213015174 0ustar nileshnilesh#' Create a Progressor Function that Signals Progress Updates #' #' @inheritParams progression #' #' @param steps (integer) Number of progressing steps. #' #' @param along (vector; alternative) Alternative that sets #' `steps = length(along)`. #' #' @param offset,scale (integer; optional) scale and offset applying transform #' `steps <- scale * steps + offset`. #' #' @param transform (function; optional) A function that takes the effective #' number of `steps` as input and returns another finite and non-negative #' number of steps. #' #' @param label (character) A label. #' #' @param trace (logical) If TRUE, then the call stack is recorded, otherwise #' not. #' #' @param initiate (logical) If TRUE, the progressor will signal a #' [progression] 'initiate' condition when created. #' #' @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. #' #' @return A function of class `progressor`. #' #' @export progressor <- local({ progressor_count <- 0L 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_, trace = FALSE, 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) 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)) label <- as.character(label) stop_if_not(length(label) == 1L) steps <- transform(steps) 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)) 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. Alternatively, create it 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) progressor_count <<- progressor_count + 1L progressor_uuid <- progressor_uuid(progressor_count) progression_index <- 0L fcn <- function(message = character(0L), ..., type = "update") { progression_index <<- progression_index + 1L cond <- progression( type = type, message = message, ..., progressor_uuid = progressor_uuid, progression_index = progression_index, owner_session_uuid = owner_session_uuid, call = if (trace) sys.call() else NULL, calls = if (trace) sys.calls() else NULL ) withRestarts( signalCondition(cond), muffleProgression = function(p) NULL ) invisible(cond) } formals(fcn)$message <- message class(fcn) <- c("progressor", class(fcn)) ## WORKAROUND: Use teeny, custom enviroment for the progressor function. ## The default would otherwise be to inherit the parent frame, which ## might contain very large objects. progressor_envir <- new.env(parent = getNamespace(.packageName)) for (name in c("progression_index", "progressor_uuid", "owner_session_uuid", "progressor_count", "enable", "initiate", "auto_finish", "trace", "steps", "label", "offset", "scale")) { progressor_envir[[name]] <- get(name) } environment(fcn) <- progressor_envir ## Is there already be an active '...progressr'? ## If so, make sure it is finished and then remove it if (exists("...progressor", mode = "function", envir = envir)) { ...progressor <- get("...progressor", mode = "function", envir = envir) ## Ideally, we produce a warning or an error here if the existing ## progressor is not finished. Currently, we don't have a way to ## query that, so we leave that for the future. /HB 2021-02-28 ## Finish it (although it might already have been done via auto-finish) ...progressor(type = "finish") ## Remove it (while avoiding false 'R CMD check' NOTE) do.call(unlockBinding, args = list("...progressor", env = envir)) rm("...progressor", envir = envir) } ## Initiate? if (initiate) { fcn( type = "initiate", steps = steps, auto_finish = auto_finish ) } ## Add on.exit(...progressor(type = "finish"))? if (on_exit) { 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 } }) #' @importFrom utils object.size #' @export print.progressor <- function(x, ...) { s <- sprintf("%s:", class(x)[1]) e <- environment(x) pe <- parent.env(e) s <- c(s, paste("- label:", e$label)) s <- c(s, paste("- steps:", e$steps)) s <- c(s, paste("- initiate:", e$initiate)) s <- c(s, paste("- auto_finish:", e$auto_finish)) 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 = "") stack <- if (e$trace) paste(call, collapse = " -> ") else "" s <- c(s, paste("- call stack:", stack)) 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)) owner_session_uuid <- e$owner_session_uuid s <- c(s, paste("- owner_session_uuid:", owner_session_uuid)) s <- c(s, paste("- enable:", e$enable)) size <- object.size(x) size2 <- serialization_size(x) s <- c(s, sprintf("- size: %s [%s serialized]", format(size, units = "auto", standard = "SI"), format(size2, units = "auto", standard = "SI"))) s <- paste(s, collapse = "\n") cat(s, "\n", sep = "") 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) } }) progressr/R/progress_aggregator.R0000644000175000017500000000272514122707130017027 0ustar nileshnilesh#' Aggregate Progression Conditions #' #' @param progress A [progressor] function. #' #' @return A function of class `progress_aggregator`. #' #' @example incl/progress_aggregator.R #' #' @keywords internal #' @export progress_aggregator <- function(progress) { stop_if_not(inherits(progress, "progressor")) ## Here we can find out how many steps the progressor function wants max_steps <- environment(progress)$steps handler <- function(p) { stop_if_not(inherits(p, "progression")) type <- p$type debug <- getOption("progressr.debug", FALSE) if (debug) { mprintf("Progression handler %s ...", sQuote(type)) on.exit(mprintf("Progression handler %s ... done", sQuote(type))) mprintf("- progression:") mstr(p) mprintf("- progressor_uuid: %s", p$progressor_uuid) mprintf("- progression_index: %d", p$progression_index) } if (type == "initiate") { } else if (type == "finish") { } else if (type == "reset") { } else if (type == "shutdown") { } else if (type == "update") { progress(child = p) } else { stop("Unknown 'progression' type: ", sQuote(type)) } ## Prevent upstream calling handlers to receive progression 'p' invokeRestart("muffleProgression") } handler <- make_progression_handler("progress_aggregator", handler = handler) fcn <- function(...) { with_progress(..., handlers = handler) } class(fcn) <- c("progress_aggregator", class(fcn)) fcn } progressr/R/handlers.R0000644000175000017500000001212714157254122014564 0ustar nileshnilesh#' Control How Progress is Reported #' #' @param \dots One or more progression handlers. Alternatively, this #' functions accepts also a single vector of progression handlers as input. #' If this vector is empty, then an empty set of progression handlers will #' be set. #' #' @param append (logical) If FALSE, the specified progression handlers #' replace the current ones, otherwise appended to them. #' #' @param on_missing (character) If `"error"`, an error is thrown if one of #' the progression handlers does not exists. If `"warning"`, a warning #' is produces and the missing handlers is ignored. If `"ignore"`, the #' missing handlers is ignored. #' #' @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 #' option \option{progressr.handlers}. #' #' _IMPORTANT: Setting progression handlers is a privilege that should be #' left to the end user. It should not be used by R packages, which only task #' is to _signal_ progress updates, not to decide if, when, and how progress #' should be reported._ #' #' @section Configuring progression handling during R startup: #' A convenient place to configure the default progression handler and to #' enable global progression reporting by default is in the \file{~/.Rprofile} #' startup file. For example, the following will (i) cause your interactive #' R session to use global progression handler by default, and (ii) report #' progress via the \pkg{progress} package when in the terminal and via the #' RStudio Jobs progress bar when in the RStudio Console. #' [handler_txtprogressbar], #' other whenever using the RStudio Console, add #' the following to your \file{~/.Rprofile} startup file: #' #' ```r #' if (interactive() && requireNamespace("progressr", quietly = TRUE)) { #' ## Enable global progression updates #' if (getRversion() >= 4) progressr::handlers(global = TRUE) #' #' ## In RStudio Console, or not? #' if (Sys.getenv("RSTUDIO") == "1" && !nzchar(Sys.getenv("RSTUDIO_TERM"))) { #' options(progressr.handlers = progressr::handler_rstudio) #' } else { #' options(progressr.handlers = progressr::handler_progress) #' } #' } #' ``` #' #' @example incl/handlers.R #' #' @export 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))) } 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 (nargs == 1L && is.vector(args[[1]])) { args <- args[[1]] } handlers <- list() names <- names(args) for (kk in seq_along(args)) { handler <- args[[kk]] stop_if_not(length(handler) == 1L) if (is.character(handler)) { name <- handler name2 <- sprintf("handler_%s", name) handler <- NULL if (exists(name2, mode = "function")) { handler <- get(name2, mode = "function") } if (is.null(handler)) { if (exists(name, mode = "function")) { handler <- get(name, mode = "function") } } if (is.null(handler)) { if (on_missing == "error") { stop("No such progression handler found: ", sQuote(name)) } else if (on_missing == "warning") { warning("Ignoring non-existing progression handler: ", sQuote(name)) } next } names[kk] <- name } stop_if_not(is.function(handler), length(formals(handler)) >= 1L) handlers[[kk]] <- handler } stop_if_not(is.list(handlers)) names(handlers) <- names ## Drop non-existing handlers keep <- vapply(handlers, FUN = is.function, FUN.VALUE = FALSE) handlers <- handlers[keep] if (append) { current <- getOption("progressr.handlers", list()) if (length(current) > 0L) handlers <- c(current, handlers) } invisible(options(progressr.handlers = handlers)[[1]]) } progressr/R/zzz.R0000644000175000017500000000200614123360236013611 0ustar nileshnilesh.onLoad <- function(libname, pkgname) { debug <- isTRUE(as.logical(Sys.getenv("R_PROGRESSR_DEBUG", "FALSE"))) if (debug) options(progressr.debug = TRUE) debug <- getOption("progressr.debug", debug) ## Set package options based on environment variables update_package_options(debug = debug) ## Record the process ID (PID) when the package is loaded is_fork_child() ## 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? if (isTRUE(getOption("progressr.global.handler", FALSE))) { ## 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() } } progressr/R/with_progress.R0000644000175000017500000002115514157465763015703 0ustar nileshnilesh#' Report on Progress while Evaluating an R Expression #' #' @param expr An \R expression to evaluate. #' #' @param handlers A progression handler or a list of them. #' If NULL or an empty list, progress updates are ignored. #' #' @param cleanup If TRUE, all progression handlers will be shutdown #' at the end regardless of the progression is complete or not. #' #' @param delay_terminal If TRUE, output and conditions that may end up in #' the terminal will delayed. #' #' @param delay_stdout If TRUE, standard output is captured and relayed #' at the end just before any captured conditions are relayed. #' #' @param delay_conditions A character vector specifying [base::condition] #' classes to be captured and relayed at the end after any captured #' standard output is relayed. #' #' @param interrupts Controls whether interrupts should be detected or not. #' If TRUE and a interrupt is signaled, progress handlers are asked to #' report on the current amount progress when the evaluation was terminated #' by the interrupt, e.g. when a user pressed Ctrl-C in an interactive session, #' or a batch process was interrupted because it ran out of time. #' #' @param interval (numeric) The minimum time (in seconds) between #' successive progression updates from handlers. #' #' @param enable (logical) If FALSE, then progress is not reported. The #' default is to report progress in interactive mode but not batch mode. #' See below for more details. #' #' @return Returns the value of the expression. #' #' @example incl/with_progress.R #' #' @details #' _IMPORTANT: This function is meant for end users only. It should not #' be used by R packages, which only task is to _signal_ progress updates, #' not to decide if, when, and how progress should be reported._ #' #' @section Progression handler functions: #' Formally, progression handlers are calling handlers that are called #' when a [progression] condition is signaled. These handlers are functions #' that takes one argument which is the [progression] condition. #' #' @section Progress updates in 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()` is to _not_ report on progress in non-interactive mode. #' To have progress being reported on also then, set R options #' \option{progressr.enable} or environment variable \env{R_PROGRESSR_ENABLE} #' to `TRUE`. Alternatively, one can set argument `enable=TRUE` when calling #' `with_progress()`. For example, #' ```sh #' $ Rscript -e "library(progressr)" -e "with_progress(slow_sum(1:5))" #' ``` #' will _not_ report on progress, whereas: #' ```sh #' $ export R_PROGRESSR_ENABLE=TRUE #' $ Rscript -e "library(progressr)" -e "with_progress(slow_sum(1:5))" #' ``` #' will. #' #' @seealso #' [base::withCallingHandlers()] #' #' @export with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE, delay_terminal = NULL, delay_stdout = NULL, delay_conditions = NULL, interrupts = getOption("progressr.interrupts", TRUE), interval = NULL, enable = NULL) { stop_if_not(is.logical(cleanup), length(cleanup) == 1L, !is.na(cleanup)) stop_if_not(is.logical(interrupts), length(interrupts) == 1L, !is.na(interrupts)) 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) { if (debug) message("No progress handlers - skipping") return(expr) } ## Temporarily set progressr options options <- list() ## Enabled or not? if (!is.null(enable)) { stop_if_not(is.logical(enable), length(enable) == 1L, !is.na(enable)) # Nothing to do? if (!enable) { if (debug) message("Progress disabled - skipping") return(expr) } options[["progressr.enable"]] <- enable } if (!is.null(interval)) { stop_if_not(is.numeric(interval), length(interval) == 1L, !is.na(interval)) options[["progressr.interval"]] <- interval } if (length(options) > 0L) { oopts <- options(options) on.exit(options(oopts), add = TRUE) } progressr_in_globalenv("allow") on.exit(progressr_in_globalenv("disallow"), add = TRUE) handlers <- as_progression_handler(handlers) ## Nothing to do? if (length(handlers) == 0L) { if (debug) message("No remaining progress handlers - skipping") return(expr) } ## Do we need to buffer? delays <- use_delays(handlers, terminal = delay_terminal, 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 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)) }, muffleProgression = function(p) NULL) }, progression = calling_handler) }, add = TRUE) } ## Delay standard output? stdout_file <- delay_stdout(delays, stdout_file = NULL) on.exit(flush_stdout(stdout_file), add = TRUE) ## Delay conditions? conditions <- list() if (length(delays$conditions) > 0) { on.exit(flush_conditions(conditions), add = TRUE) } ## 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) { 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) }, interrupt = function(c) { ## Ignore interrupts? if (!interrupts) return() suspendInterrupts({ ## 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("interrupt")) }) }, 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" if (isTRUE(res$visible)) { res$value } else { invisible(res$value) } } progressr/R/handler_winprogressbar.R0000644000175000017500000000507614156730333017537 0ustar nileshnilesh#' Progression Handler: Progress Reported as a MS Windows Progress Bars in the GUI #' #' A progression handler for `winProgressBar()` in the \pkg{utils} package. #' #' @inheritParams make_progression_handler #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @section Requirements: #' This progression handler requires MS Windows. #' #' @export handler_winprogressbar <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", ...) { ## Additional arguments passed to the progress-handler backend backend_args <- handler_backend_args(...) ## Used for package testing purposes only when we want to perform ## everything except the last part where the backend is called if (!is_fake("handler_winprogressbar")) { if (.Platform$OS.type != "windows") { stop("handler_winprogressbar requires MS Windows: ", sQuote(.Platform$OS.type)) } ## Import functions winProgressBar <- utils::winProgressBar setWinProgressBar <- utils::setWinProgressBar } else { winProgressBar <- function(...) rawConnection(raw(0L)) setWinProgressBar <- function(...) NULL } reporter <- local({ pb <- NULL make_pb <- function(..., label = NULL) { if (!is.null(pb)) return(pb) label <- paste0(label, "") args <- c(list(..., label = label), backend_args) pb <<- do.call(winProgressBar, args = args) pb } list( reset = function(...) { pb <<- NULL }, initiate = function(config, state, progression, ...) { if (!state$enabled || config$times == 1L) return() ## NOTE: 'pb' may be re-used for winProgressBar:s if (config$clear) stop_if_not(is.null(pb)) make_pb(max = config$max_steps, label = state$message) }, update = function(config, state, progression, ...) { if (!state$enabled || progression$amount == 0 || config$times <= 2L) return() make_pb(max = config$max_steps, label = state$message) setWinProgressBar(pb, value = state$step, label = paste0(state$message, "")) }, finish = function(config, state, progression, ...) { ## Already finished? if (is.null(pb)) return() if (!state$enabled) return() if (config$clear) { close(pb) pb <<- NULL } else { setWinProgressBar(pb, value = state$step, label = paste0(state$message, "")) } } ) }) make_progression_handler("winprogressbar", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/handler_debug.R0000644000175000017500000000512014157425412015544 0ustar nileshnilesh#' Progression Handler: Progress Reported as Debug Information (Text) in the Terminal #' #' @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 #' #' @section Appearance: #' Below is how this progress handler renders by default at 0%, 30% and 99% #' progress: #' #' With `handlers(handler_debug())`: #' ```r #' [21:27:11.236] (0.000s => +0.001s) initiate: 0/100 (+0) '' {clear=TRUE, enabled=TRUE, status=} #' [21:27:11.237] (0.001s => +0.000s) update: 0/100 (+0) 'Starting' {clear=TRUE, enabled=TRUE, status=} #' [21:27:14.240] (3.004s => +0.002s) update: 30/100 (+30) 'Importing' {clear=TRUE, enabled=TRUE, status=} #' [21:27:16.245] (5.009s => +0.001s) update: 100/100 (+70) 'Summarizing' {clear=TRUE, enabled=TRUE, status=} #' [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", uuid = FALSE, ...) { reporter <- local({ t_init <- NULL add_to_log <- function(config, state, progression, ...) { t <- Sys.time() if (is.null(t_init)) t_init <<- t dt <- difftime(t, t_init, units = "secs") delay <- difftime(t, progression$time, units = "secs") message <- paste(c(state$message, ""), collapse = "") entry <- list(now(t), dt, delay, progression$type, state$step, config$max_steps, state$delta, message, config$clear, state$enabled, paste0(progression$status, "")) msg <- do.call(sprintf, args = c(list("%s(%.3fs => +%.3fs) %s: %.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) } list( reset = function(...) { t_init <<- NULL }, hide = function(...) NULL, unhide = function(...) NULL, interrupt = function(...) NULL, initiate = function(...) { add_to_log("initiate", ...) }, update = function(...) { add_to_log("update", ...) }, finish = function(...) { add_to_log("finish", ...) } ) }) make_progression_handler("debug", reporter, interval = interval, intrusiveness = intrusiveness, target = target, ...) } progressr/R/handler_shiny.R0000644000175000017500000000566314122707130015614 0ustar nileshnilesh#' Progression Handler: Progress Reported via 'shiny' Widgets (GUI) in the HTML Browser #' #' A progression handler for \pkg{shiny} and [shiny::withProgress()]. #' #' @inheritParams make_progression_handler #' #' @param inputs (named list) Specifies from what sources the Shiny progress #' elements 'message' and 'detail' should be updated. Valid sources are #' `"message"`, `"sticky_message"` and `"non_sticky_message"`, where #' `"message"` is short for `c("non_sticky_message", "sticky_message")`. For #' example, `inputs = list(message = "sticky-message", detail = "message")` #' will update the Shiny 'message' component from sticky messages only, #' whereas the 'detail' component is updated using any message. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @examples #' \donttest{\dontrun{ #' handlers(handler_shiny()) #' with_progress(y <- slow_sum(1:100)) #' }} #' #' @section Requirements: #' This progression handler requires the \pkg{shiny} package. #' #' @details #' For most Shiny application there is little need to use this Shiny handler #' directly. Instead, it is sufficient to use [withProgressShiny()]. #' #' @keywords internal #' @export handler_shiny <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", inputs = list(message = NULL, detail = "message"), ...) { stop_if_not( is.list(inputs), !is.null(names(inputs)), all(names(inputs) %in% c("message", "detail")), all(vapply(inputs, FUN = function(x) { if (is.null(x)) return(TRUE) if (!is.character(x)) return(FALSE) x %in% c("message", "non_sticky_message", "sticky_message") }, FUN.VALUE = FALSE)) ) ## Expand 'message' => c("non_sticky_message", "sticky_message") for (name in names(inputs)) { input <- inputs[[name]] if ("message" %in% input) { input <- setdiff(input, "message") input <- c(input, "non_sticky_message", "sticky_message") } inputs[[name]] <- unique(input) } ## Default: The progression message updates Shiny 'message' map_args <- function(state, progression) { message <- progression$message if (is.null(message)) return(list()) ## Update Shiny 'message' and 'detail'? args <- list() for (target in c("message", "detail")) { if (inherits(progression, "sticky")) { if ("sticky_message" %in% inputs[[target]]) args[[target]] <- message } else { if ("non_sticky_message" %in% inputs[[target]]) args[[target]] <- message } } args } reporter <- local({ list( update = function(config, state, progression, ...) { amount <- if (config$max_steps == 0) 1 else progression$amount / config$max_steps args <- c(list(amount = amount), map_args(state, progression)) do.call(shiny::incProgress, args = args) } ) }) make_progression_handler("shiny", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/progressr-package.R0000644000175000017500000000445014122707130016375 0ustar nileshnilesh#' progressr: A Unifying API for Progress Updates #' #' The \pkg{progressr} package provides 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. For instance, they can chose to report progress #' in the terminal using [utils::txtProgressBar()] or #' [progress::progress_bar()] or via the graphical user interface (GUI) #' using `utils::winProgressBar()` or [tcltk::tkProgressBar()]. #' An alternative to above visual rendering of progress, is to report it #' using [beepr::beep()] sounds. #' It is possible to use a combination of above progression handlers, e.g. #' a progress bar in the terminal together with audio updates. #' Besides the existing handlers, it is possible to develop custom #' progression handlers. #' #' The \pkg{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, \pkg{purrr}, \pkg{plyr}, and #' \pkg{foreach}. #' The \pkg{progressr} package will also work with parallel processing via #' the \pkg{future} framework, e.g. [future.apply::future_lapply()], #' [furrr::future_map()], and [foreach::foreach()] with \pkg{doFuture}. #' #' The \pkg{progressr} package is compatible with Shiny applications. #' #' @section Progression Handlers: #' #' In the terminal: #' * [handler_txtprogressbar] (default) #' * [handler_pbcol] #' * [handler_pbmcapply] #' * [handler_progress] #' * [handler_ascii_alert] #' * [handler_debug] #' #' In a graphical user interface (GUI): #' * [handler_rstudio] #' * [handler_tkprogressbar] #' * [handler_winprogressbar] #' #' As sound: #' * [handler_beepr] #' * [handler_ascii_alert] #' #' Via the file system: #' * [handler_filesize] #' #' In Shiny: #' * [withProgressShiny] #' #' @example incl/progressr-package.R #' #' @keywords programming iteration #' #' @docType package #' @aliases progressr-package #' @name progressr NULL progressr/R/slow_sum.R0000644000175000017500000000211314122707130014620 0ustar nileshnilesh#' Slowly Calculate Sum of Elements #' #' @param x Numeric vector to sum #' #' @param delay Delay in seconds after each addition. #' #' @param stdout If TRUE, then a text is outputted to the standard output #' per element. #' #' @param message If TRUE, then a message is outputted per element. #' #' @return The sum of all elements in `x`. #' #' @section Progress updates: #' This function signals [progression] conditions as it progresses. #' #' @keywords internal #' @export slow_sum <- function(x, delay = getOption("progressr.demo.delay", 1.0), stdout = FALSE, message = TRUE) { p <- progressor(along = x) sum <- 0 for (kk in seq_along(x)) { p(amount = 0) ## "I'm alive" progression update Sys.sleep(0.2*delay) if (stdout) cat(sprintf("O: Element #%d\n", kk)) p(amount = 0) Sys.sleep(0.2*delay) p(amount = 0) Sys.sleep(0.2*delay) sum <- sum + x[kk] p(message = sprintf("P: Adding %g", kk)) Sys.sleep(0.2*delay) if (message) message(sprintf("M: Added value %g", x[kk])) p(amount = 0) Sys.sleep(0.2*delay) } p(amount = 0) sum } progressr/R/progression.R0000644000175000017500000001120114156754133015334 0ustar nileshnilesh#' A Progression Condition #' #' A progression condition represents a progress in an \R program. #' #' @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. #' #' @param step (numeric) The step completed. If specified, `amount` is ignored. #' _WARNING: Argument `step` should only be used when in full control of the #' order when this progression condition is signaled._ For example, it must not #' be signaled as one of many parallel progress updates signaled concurrently, #' because then we cannot guarantee the order these progressions arrive. #' #' @param time (POSIXct) A timestamp. #' #' @param \ldots Additional named elements. #' #' @param type Type of progression made. #' #' @param class (character) Zero or more class names to prepend. #' #' @param progressor_uuid (character string) A character string that is unique #' for the current progressor and the current \R session. #' #' @param progression_index (integer) A non-negative integer that is #' incremented by one for each progression condition created. #' #' @param progression_time (POSIXct or character string) A timestamp specifying #' when the progression condition was created. #' #' @param owner_session_uuid (character string) A character string that is #' unique for the \R session where the progressor was created. #' #' @param call (expression) A call expression. #' #' @param calls (pairlist) The calls that lead up to this progression update. #' #' @return A [base::condition] of class `progression`. #' #' @seealso #' To signal a progression condition, use [base::signalCondition()]. #' #' @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(), owner_session_uuid = NULL) { amount <- as.numeric(amount) time <- as.POSIXct(time) stop_if_not(is.character(type), length(type) == 1L, !is.na(type)) class <- as.character(class) if (inherits(progression_time, "POSIXct")) { progression_time <- format(progression_time, format = "%F %H:%M:%OS3 %z") } stop_if_not(length(progression_time) == 1L, is.character(progression_time)) args <- list(...) nargs <- length(args) if (nargs > 0L) { names <- names(args) stop_if_not(!is.null(names), all(nzchar(names)), length(unique(names)) == nargs) } structure( list( owner_session_uuid = owner_session_uuid, progressor_uuid = progressor_uuid, session_uuid = session_uuid(), progression_index = progression_index, progression_time = progression_time, type = type, message = message, amount = amount, step = step, time = time, ..., call = call, calls = calls ), 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) } message <- as.character(message) if (length(message) > 0L) message <- paste(message, collapse = "") message } #' @importFrom utils object.size #' @export print.progression <- function(x, ...) { s <- sprintf("%s:", class(x)[1]) s <- c(s, paste("- call:", deparse(conditionCall(x)))) s <- c(s, paste("- type:", x$type)) s <- c(s, sprintf("- message: [%s] %s", class(x$message)[1], sQuote(conditionMessage(x)))) s <- c(s, paste("- amount:", x$amount)) s <- c(s, paste("- step:", x$step)) s <- c(s, paste("- time:", x$time)) s <- c(s, paste("- progressor_uuid:", x$progressor_uuid)) s <- c(s, paste("- progression_index:", x$progression_index)) s <- c(s, paste("- progression_time:", x$progression_time)) s <- c(s, paste("- session_uuid:", x$session_uuid)) s <- c(s, paste("- owner_session_uuid:", x$owner_session_uuid)) s <- c(s, paste("- classes:", paste(sQuote(class(x)), collapse = ", "))) size <- object.size(x) size2 <- serialization_size(x) s <- c(s, sprintf("- size: %s [%s serialized]", format(size, units = "auto", standard = "SI"), format(size2, units = "auto", standard = "SI"))) s <- paste(s, collapse = "\n") cat(s, "\n", sep = "") invisible(x) } progressr/R/without_progress.R0000644000175000017500000000073314122707130016405 0ustar nileshnilesh#' @details #' `without_progress()` evaluates an expression while ignoring all #' progress updates. #' #' @rdname with_progress #' @export without_progress <- function(expr) { progressr_in_globalenv("allow") on.exit(progressr_in_globalenv("disallow")) withCallingHandlers({ res <- withVisible(expr) }, progression = function(p) { invokeRestart("muffleProgression") }) if (isTRUE(res$visible)) { res$value } else { invisible(res$value) } } progressr/R/handler_notifier.R0000644000175000017500000000471114122707130016272 0ustar nileshnilesh#' Progression Handler: Progress Reported via the Operating-System Notification Framework (GUI, Text) #' #' A progression handler for `notify()` of the \pkg{notifier} package. #' #' @inheritParams make_progression_handler #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @example incl/handler_notifier.R #' #' @section Requirements: #' This progression handler requires the \pkg{notifier} package, which is only #' available from . This can be #' installed as `remotes::install_github("gaborcsardi/notifier@62d484")`. #' #' @keywords internal #' @export handler_notifier <- function(intrusiveness = getOption("progressr.intrusiveness.notifier", 10), target = "gui", ...) { ## Used for package testing purposes only when we want to perform ## everything except the last part where the backend is called if (!is_fake("handler_notifier")) { pkg <- "notifier" if (!requireNamespace(pkg, quietly = TRUE)) { stop("Package 'notifier' is not available. See ?progressr::handler_notifier() for installation instructions") } notifier_notify <- get("notify", mode = "function", envir = getNamespace(pkg)) } else { notifier_notify <- function(...) NULL } notify <- function(step, max_steps, message) { ratio <- if (max_steps == 0) 1 else step / max_steps ratio <- sprintf("%.0f%%", 100*ratio) msg <- paste(c("", message), collapse = "") notifier_notify(sprintf("[%s] %s", ratio, msg)) } reporter <- local({ finished <- FALSE list( reset = function(...) { finished <<- FALSE }, initiate = function(config, state, progression, ...) { if (!state$enabled || config$times == 1L) return() notify(step = state$step, max_steps = config$max_steps, message = state$message) }, update = function(config, state, progression, ...) { if (!state$enabled || progression$amount == 0 || config$times <= 2L) return() notify(step = state$step, max_steps = config$max_steps, message = state$message) }, finish = function(config, state, progression, ...) { if (finished) return() if (!state$enabled) return() if (state$delta > 0) notify(step = state$step, max_steps = config$max_steps, message = state$message) finished <<- TRUE } ) }) make_progression_handler("notifier", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/global_progression_handler.R0000644000175000017500000003267514157463035020372 0ustar nileshnilesh#' 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 #' #' @keywords internal register_global_progression_handler <- function(action = c("add", "remove", "query")) { 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)") 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(condition = global_progression_handler) } invisible(TRUE) } else if (action == "remove") { global_progression_handler(control_progression("shutdown")) 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) } else if (action == "status") { global_progression_handler(control_progression("status")) } } #' 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 delays <- NULL stdout_file <- NULL capture_conditions <- NA conditions <- list() genv <- globalenv() update_calling_handler <- function() { handlers <- handlers() # Nothing to do? if (length(handlers) == 0L) return(NULL) handlers <- as_progression_handler(handlers) # Nothing to do? if (length(handlers) == 0L) return(NULL) ## Do we need to buffer? delays <<- use_delays(handlers) calling_handler <<- make_calling_handler(handlers) } interrupt_calling_handler <- function(progression = control_progression("interrupt"), debug = FALSE) { if (is.null(calling_handler)) return() ## 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(progression) } finish <- function(progression = control_progression("shutdown"), debug = FALSE) { 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) ## 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(length(conditions) == 0L, is.null(delays), isTRUE(finished), is.na(capture_conditions)) finished } handle_progression <- function(progression, debug = getOption("progressr.global.debug", FALSE)) { ## To please R CMD check 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({ if (is.null(current_progressor_uuid)) { capture_conditions <<- NA } else if (!is.na(capture_conditions)) { capture_conditions <<- TRUE } }) stop_if_not(inherits(progression, "progression")) assign(".Last.progression", value = progression, envir = genv, inherits = 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() } if (!is.null(calling_handler) && !is.null(delays)) { ## 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) stop_if_not(inherits(stdout_file, "connection")) conditions <<- flush_conditions(conditions) calling_handler(control_progression("unhide")) } } } 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") # 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() 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) if (debug) message(" - finished: ", finished) if (finished) { finished <- finish(debug = debug) stop_if_not(length(conditions) == 0L, is.na(capture_conditions), isTRUE(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) { warning(sprintf("[progressr]: Received a progression %s request (amount=%g; msg=%s) 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, sQuote(conditionMessage(progression)))) } return() } 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) { calling_handler(control_progression("shutdown")) finished <- finish(debug = debug) stop_if_not(length(conditions) == 0L, is.na(capture_conditions), isTRUE(finished)) } } } else if (type == "finish") { finished <- finish(debug = debug) stop_if_not(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 = last_capture_conditions, conditions = conditions ) if (debug) message(" - done") return(status) } if (debug) message(" - done") } ## handle_progression() function(condition) { debug <- getOption("progressr.global.debug", FALSE) ## Shut down progression handling? if (inherits(condition, c("interrupt", "error"))) { if (inherits(condition, "interrupt") && isTRUE(getOption("progressr.interrupts", TRUE))) { suspendInterrupts({ interrupt_calling_handler(debug = debug) }) } 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")) { suspendInterrupts({ res <- handle_progression(condition, debug = debug) }) return(res) } ## Nothing do to? if (is.na(capture_conditions) || !isTRUE(capture_conditions)) return() ## Nothing 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() if (getRversion() < "4.0.0") { globalCallingHandlers <- function(...) { 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) attr(stdout_file, "sink_index") <- sink.number(type = "output") stdout_file } ## buffer_stdout() flush_stdout <- function(stdout_file, close = TRUE, must_work = FALSE) { if (is.null(stdout_file)) return(NULL) ## 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) 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 } progressr/R/handler_pbcol.R0000644000175000017500000001265414157457434015600 0ustar nileshnilesh#' 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 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()]. #' #' @section Requirements: #' This progression handler requires the \pkg{crayon} package. #' #' @example incl/handler_pbcol.R #' #' @importFrom utils flush.console #' @export 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()) flush.console() } erase_progress_bar <- function() { cat_(c("\r", rep(" ", times = getOption("width")), "\r")) } 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, adjust = adjust, pad = pad, complete = complete, incomplete = incomplete, spin = spin, ) cat_("\r", pbstr) } reporter <- local({ spin_state <- 0L spinner <- c("-", "\\", "|", "/", "-", "\\", "|", "/") list( initiate = function(config, state, ...) { if (!state$enabled || config$times <= 2L) return() ratio <- if (config$max_steps == 0) 1 else state$step / config$max_steps redraw_progress_bar(ratio = ratio, message = state$message, spin = spinner[spin_state+1L]) }, reset = function(...) { erase_progress_bar() }, hide = function(...) { erase_progress_bar() }, unhide = function(config, state, ...) { if (!state$enabled || config$times <= 2L) return() ratio <- if (config$max_steps == 0) 1 else state$step / config$max_steps redraw_progress_bar(ratio = ratio, message = state$message, spin = spinner[spin_state+1L]) }, interrupt = function(config, state, progression, ...) { msg <- getOption("progressr.interrupt.message", "interrupt detected") msg <- paste(c("", msg, ""), collapse = "\n") cat_(msg) }, update = function(config, state, progression, ...) { if (!state$enabled || config$times <= 2L) return() if (state$delta < 0) return() spin_state <<- (spin_state+1L) %% length(spinner) ratio <- if (config$max_steps == 0) 1 else state$step / config$max_steps redraw_progress_bar(ratio = ratio, message = state$message, spin = spinner[spin_state+1L]) }, finish = function(config, state, progression, ...) { if (config$clear) { erase_progress_bar() } else { redraw_progress_bar(ratio = 1, message = state$message, spin = " ") cat("\n", file = stderr()) } } ) }) make_progression_handler("pbcol", reporter, intrusiveness = intrusiveness, target = target, ...) } 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)) 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) 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) - nchar(msgfraction) stop_if_not(msgpad >= 0) } ## Pad 'msg' lpad <- floor( adjust * msgpad) + pad rpad <- floor((1-adjust) * msgpad) stop_if_not(lpad >= 0L, rpad >= 0L) pmsg <- sprintf("%*s%s%*s%s%s%*s", lpad, "", msg, rpad, "", msgfraction, spin, pad, "") ## 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)) if (!is.null(complete)) lmsg <- complete(lmsg) if (!is.null(incomplete)) rmsg <- incomplete(rmsg) bar <- paste(lmsg, rmsg, sep = "") bar } progressr/R/uuid.R0000644000175000017500000000341314122707130013722 0ustar nileshnilesh## Create a universally unique identifier (UUID) for an R object #' @importFrom digest digest uuid <- function(source, keep_source = FALSE) { uuid <- digest(source) uuid <- strsplit(uuid, split = "")[[1]] uuid <- paste(c(uuid[1:8], "-", uuid[9:12], "-", uuid[13:16], "-", uuid[17:20], "-", uuid[21:32]), collapse = "") if (keep_source) attr(uuid, "source") <- source uuid } ## uuid() ## A universally unique identifier (UUID) for the current ## R process UUID. Generated only once per process ID 'pid'. ## The 'pid' may differ when using forked processes. session_uuid <- local({ uuids <- list() function(pid = Sys.getpid(), attributes = FALSE) { pidstr <- as.character(pid) uuid <- uuids[[pidstr]] if (is.null(uuid)) { info <- Sys.info() host <- Sys.getenv(c("HOST", "HOSTNAME", "COMPUTERNAME")) host <- host[nzchar(host)] host <- if (length(host) == 0L) info[["nodename"]] else host[1L] info <- list( host = host, info = info, time = Sys.time(), tempdir = tempdir(), pid = pid, random = stealth_sample.int(.Machine$integer.max, size = 1L) ) uuid <- uuid(info, keep_source = TRUE) uuids[[pidstr]] <<- uuid } if (!attributes) attr(uuid, "source") <- NULL uuid } }) progressor_uuid <- function(id, attributes = FALSE) { uuid(list(session_uuid = session_uuid(), id = id), keep_source = attributes) } ## A version of base::sample.int() that does not change .Random.seed stealth_sample.int <- function(...) { oseed <- .GlobalEnv$.Random.seed on.exit({ if (is.null(oseed)) { rm(list = ".Random.seed", envir = .GlobalEnv, inherits = FALSE) } else { .GlobalEnv$.Random.seed <- oseed } }) suppressWarnings(sample.int(...)) } progressr/R/handler_beepr.R0000644000175000017500000000326114122707130015547 0ustar nileshnilesh#' Progression Handler: Progress Reported as 'beepr' Sounds (Audio) #' #' A progression handler for [beepr::beep()]. #' #' @inheritParams make_progression_handler #' #' @param initiate,update,finish (integer) Indices of [beepr::beep()] sounds to #' play when progress starts, is updated, and completes. For silence, use `NA_integer_`. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @example incl/handler_beepr.R #' #' @section Requirements: #' This progression handler requires the \pkg{beepr} package. #' #' @export handler_beepr <- function(initiate = 2L, update = 10L, finish = 11L, intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), target = "audio", ...) { ## Used for package testing purposes only when we want to perform ## everything except the last part where the backend is called if (!is_fake("handler_beepr")) { beepr_beep <- beepr::beep } else { beepr_beep <- function(sound, expr) NULL } beep <- function(sound) { ## Silence? if (is.na(sound)) return() beepr_beep(sound) } ## Reporter state reporter <- local({ list( initiate = function(config, state, progression, ...) { if (!state$enabled || config$times == 1L) return() beep(initiate) }, update = function(config, state, progression, ...) { if (!state$enabled || progression$amount == 0 || config$times <= 2L) return() beep(update) }, finish = function(config, state, progression, ...) { if (!state$enabled) return() beep(finish) } ) }) make_progression_handler("beepr", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/control_progression.R0000644000175000017500000000017514157424001017071 0ustar nileshnileshcontrol_progression <- function(type = "shutdown", ...) { progression(type = type, ..., class = "control_progression") } progressr/R/plyr_progress_progressr.R0000644000175000017500000000213414122707130017773 0ustar nileshnilesh#' Use Progressr with Plyr Map-Reduce Functions #' #' A "progress bar" for \pkg{plyr}'s `.progress` argument. #' #' @param \ldots Not used. #' #' @return A named [base::list] that can be passed as argument `.progress` #' to any of \pkg{plyr} function accepting that argument. #' #' @example incl/plyr_progress_progressr.R #' #' @section Limitations: #' One can use use [doFuture::registerDoFuture()] to run \pkg{plyr} functions #' in parallel, e.g. `plyr::l_ply(..., .parallel = TRUE)`. Unfortunately, #' using `.parallel = TRUE` disables progress updates because, internally, #' \pkg{plyr} forces `.progress = "none"` whenever `.parallel = TRUE`. #' Thus, despite the \pkg{future} ecosystem and \pkg{progressr} would support #' it, it is not possible to run \pkg{dplyr} in parallel _and_ get progress #' updates at the same time. #' #' @export progress_progressr <- function(...) { ## Progressor p <- NULL ## List of plyr-recognized progress functions list( init = function(x, ...) { p <<- progressor(x) }, step = function() { p() }, term = function() NULL ) } progressr/R/handler_progress.R0000644000175000017500000001337514157457403016342 0ustar nileshnilesh#' Progression Handler: Progress Reported via 'progress' Progress Bars (Text) in the Terminal #' #' A progression handler for [progress::progress_bar()]. #' #' @inheritParams make_progression_handler #' #' @param format (character string) The format of the progress bar. #' #' @param show_after (numeric) Number of seconds to wait before displaying #' the progress bar. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @section Requirements: #' This progression handler requires the \pkg{progress} package. #' #' @section Appearance: #' Below is how this progress handler renders by default at 0%, 30% and 99% #' progress: #' #' With `handlers(handler_progress())`: #' ```r #' - [-------------------------------------------------] 0% #' \ [====>--------------------------------------------] 10% #' | [================================================>] 99% #' ``` #' #' If the progression updates have messages, they will appear like: #' ```r #' - [-----------------------------------------] 0% Starting #' \ [===========>----------------------------] 30% Importing #' | [=====================================>] 99% Summarizing #' ``` #' #' @example incl/handler_progress.R #' #' @export 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(...) ## Force evaluation for 'format' here in case 'crayon' is used. This ## works around the https://github.com/r-lib/crayon/issues/48 problem stop_if_not(is.character(format), length(format) == 1L, !is.na(format)) if (!is_fake("handler_progress")) { progress_bar <- progress::progress_bar get_private <- function(pb) { pb$.__enclos_env__$private } erase_progress_bar <- function(pb) { if (pb$finished) return() private <- get_private(pb) private$clear_line(private$width) private$cursor_to_start() } redraw_progress_bar <- function(pb, tokens = list()) { if (pb$finished) return() private <- get_private(pb) private$last_draw <- "" private$render(tokens) } } else { progress_bar <- list( new = function(...) list( finished = FALSE, tick = function(...) NULL, update = function(...) NULL ) ) get_private <- function(pb) NULL erase_progress_bar <- function(pb) NULL redraw_progress_bar <- function(pb, tokens = list()) NULL } reporter <- local({ pb <- NULL make_pb <- function(format, total, clear, show_after, ...) { if (!is.null(pb)) return(pb) stop_if_not( is.character(format), length(format) == 1L, is.numeric(total), length(total) == 1L, is.logical(clear), length(clear) == 1L, is.numeric(show_after), length(show_after) == 1L ) args <- c(list(format = format, total = total, clear = clear, show_after = show_after, ...), backend_args) pb <<- do.call(progress_bar$new, args = args) pb } last_tokens <- list() pb_tick <- function(pb, delta = 0, message = NULL, ...) { if (isTRUE(pb$finished)) return() ## WORKAROUND: https://github.com/r-lib/progress/issues/119 private <- get_private(pb) if (!is.null(private) && private$total == 0) return() tokens <- list(message = paste0(message, "")) last_tokens <<- tokens if (delta < 0) return() pb$tick(delta, tokens = tokens) } pb_update <- function(pb, ratio, ...) { if (isTRUE(pb$finished)) return() ## WORKAROUND: https://github.com/r-lib/progress/issues/119 private <- get_private(pb) if (!is.null(private) && private$total == 0) return() pb$update(ratio = ratio, ...) } list( reset = function(...) { pb <<- NULL }, hide = function(...) { if (is.null(pb)) return() erase_progress_bar(pb) }, unhide = function(...) { if (is.null(pb)) return() redraw_progress_bar(pb, tokens = last_tokens) }, interrupt = function(config, state, progression, ...) { if (is.null(pb)) return() msg <- getOption("progressr.interrupt.message", "interrupt detected") msg <- paste(c("", msg, ""), collapse = "\n") cat(msg, file = stderr()) }, initiate = function(config, state, progression, ...) { if (!state$enabled || config$times == 1L) return() stop_if_not(is.null(pb)) make_pb(format = format, total = config$max_steps, clear = config$clear, show_after = config$enable_after) pb_tick(pb, 0, message = state$message) }, update = function(config, state, progression, ...) { if (!state$enabled || config$times <= 2L) return() make_pb(format = format, total = config$max_steps, clear = config$clear, show_after = config$enable_after) if (inherits(progression, "sticky") && length(state$message) != 0) pb$message(state$message) pb_tick(pb, state$delta, message = state$message) }, finish = function(config, state, progression, ...) { ## Already finished? if (is.null(pb)) return() if (!pb$finished) { make_pb(format = format, total = config$max_steps, clear = config$clear, show_after = config$enable_after) reporter$update(config = config, state = state, progression = progression, ...) if (config$clear) pb_update(pb, ratio = 1.0) } pb <<- NULL } ) }) make_progression_handler("progress", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/handler_void.R0000644000175000017500000000150314122707130015410 0ustar nileshnilesh#' Progression Handler: No Progress Report #' #' @inheritParams make_progression_handler #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @examples #' \donttest{\dontrun{ #' handlers(handler_void()) #' with_progress(y <- slow_sum(1:100)) #' print(y) #' }} #' #' @details #' This progression handler gives not output - it is invisible and silent. #' #' @export handler_void <- function(intrusiveness = 0, target = "void", enable = FALSE, ...) { reporter <- local({ list( initiate = function(config, state, progression, ...) NULL, update = function(config, state, progression, ...) NULL, finish = function(config, state, progression, ...) NULL ) }) make_progression_handler("void", reporter, intrusiveness = intrusiveness, target = target, enable = enable, ...) } progressr/R/withProgressShiny.R0000644000175000017500000000531514122707130016472 0ustar nileshnilesh#' Use Progressr in Shiny Apps: Plug-in Backward Compatibility Replacement for shiny::withProgress() #' #' @inheritParams handler_shiny #' #' @param expr,\ldots,env,quoted Arguments passed to [shiny::withProgress] as is. #' #' @param message,detail (character string) The message and the detail message to be passed to [shiny::withProgress()]. #' #' @param handlers Zero or more progression handlers used to report on progress. #' #' @return The value of [shiny::withProgress]. #' #' @example incl/withProgressShiny.R #' #' @section Requirements: #' This function requires the \pkg{shiny} package and will use the #' [handler_shiny()] **progressr** handler internally to report on updates. #' #' @export withProgressShiny <- function(expr, ..., message = NULL, detail = NULL, inputs = list(message = NULL, detail = "message"), env = parent.frame(), quoted = FALSE, handlers = c(shiny = handler_shiny, progressr::handlers(default = NULL))) { if (!quoted) expr <- substitute(expr) stop_if_not(is.list(inputs), all(names(inputs) %in% c("message", "detail"))) stop_if_not("shiny" %in% names(handlers)) if (sum(names(handlers) == "shiny") > 1) { warning("Detected a 'shiny' handler set via progressr::handlers()") } ## Optional, configure 'inputs' from attribute 'input' of arguments ## 'message' and 'detail', if and only if that attribute is available. args <- list(message = message, detail = detail) for (name in names(args)) { input <- unique(attr(args[[name]], "input")) if (is.null(input)) next unknown <- setdiff(input, c("message", "sticky_message", "non_sticky_message")) if (length(unknown) > 0) { stop(sprintf("Unknown value of attribute %s on argument %s: %s", sQuote("input"), sQuote(name), commaq(unknown))) } inputs[[name]] <- input } stop_if_not( is.list(inputs), !is.null(names(inputs)), all(names(inputs) %in% c("message", "detail")), all(vapply(inputs, FUN = function(x) { if (is.null(x)) return(TRUE) if (!is.character(x)) return(FALSE) x %in% c("message", "non_sticky_message", "sticky_message") }, FUN.VALUE = FALSE)) ) ## Customize the shiny 'message' target? if (is.function(handlers$shiny) && !inherits(handlers$shiny, "progression_handler")) { tweaked_handler_shiny <- handlers$shiny if (!identical(inputs, formals(tweaked_handler_shiny)$inputs)) { formals(tweaked_handler_shiny)$inputs <- inputs handlers$shiny <- tweaked_handler_shiny } } expr <- bquote(progressr::with_progress({.(expr)}, handlers = .(handlers))) res <- withVisible(shiny::withProgress(expr, ..., message = message, detail = detail, env = env, quoted = TRUE)) if (res$visible) res$value else invisible(res$value) } progressr/R/handler_filesize.R0000644000175000017500000000542214122707130016265 0ustar nileshnilesh#' Progression Handler: Progress Reported as the Size of a File on the File System #' #' @inheritParams make_progression_handler #' #' @param file (character) A filename. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @examples #' \donttest{\dontrun{ #' handlers(handler_filesize(file = "myscript.progress")) #' with_progress(y <- slow_sum(1:100)) #' print(y) #' }} #' #' @details #' This progression handler reports progress by updating the size of a file #' on the file system. This provides a convenient way for an R script running #' in batch mode to report on the progress such that the user can peek at the #' file size (by default in 0-100 bytes) to assess the amount of the progress #' made, e.g. `ls -l -- *.progress`. #' If the \file{*.progress} file is accessible via for instance SSH, SFTP, #' FTPS, HTTPS, etc., then progress can be assessed from a remote location. #' #' @importFrom utils file_test #' @export handler_filesize <- function(file = "default.progress", intrusiveness = getOption("progressr.intrusiveness.file", 5), target = "file", ...) { reporter <- local({ set_file_size <- function(config, state, progression) { ratio <- if (config$max_steps == 0) 1 else state$step / config$max_steps size <- round(100 * ratio) current_size <- file.size(file) if (is.na(current_size)) file.create(file, showWarnings = FALSE) if (size == 0L) return() if (progression$amount == 0) return() head <- sprintf("%g/%g: ", state$step, config$max_steps) nhead <- nchar(head) tail <- sprintf(" [%d%%]", round(100 * ratio)) ntail <- nchar(tail) mid <- paste0(state$message, "") nmid <- nchar(mid) padding <- size - (nhead + nmid + ntail) if (padding <= 0) { msg <- paste(head, mid, tail, sep = "") if (padding < 0) msg <- substring(msg, first = 1L, last = size) } else if (padding > 0) { mid <- paste(c(mid, " ", rep(".", times = padding - 1L)), collapse = "") msg <- paste(head, mid, tail, sep = "") } cat(file = file, append = FALSE, msg) } list( initiate = function(config, state, progression, ...) { set_file_size(config = config, state = state, progression = progression) }, update = function(config, state, progression, ...) { set_file_size(config = config, state = state, progression = progression) }, finish = function(config, state, progression, ...) { if (config$clear) { if (file_test("-f", file)) file.remove(file) } else { set_file_size(config = config, state = state, progression = progression) } } ) }) make_progression_handler("filesize", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/utils.R0000644000175000017500000001310414123360236014115 0ustar nileshnilesh## From R.utils 2.0.2 (2015-05-23) hpaste <- function(..., sep = "", collapse = ", ", lastCollapse = NULL, maxHead = if (missing(lastCollapse)) 3 else Inf, maxTail = if (is.finite(maxHead)) 1 else Inf, abbreviate = "...") { if (is.null(lastCollapse)) lastCollapse <- collapse # Build vector 'x' x <- paste(..., sep = sep) n <- length(x) # Nothing todo? if (n == 0) return(x) if (is.null(collapse)) return(x) # Abbreviate? if (n > maxHead + maxTail + 1) { head <- x[seq_len(maxHead)] tail <- rev(rev(x)[seq_len(maxTail)]) x <- c(head, abbreviate, tail) n <- length(x) } if (!is.null(collapse) && n > 1) { if (lastCollapse == collapse) { x <- paste(x, collapse = collapse) } else { xT <- paste(x[1:(n-1)], collapse = collapse) x <- paste(xT, x[n], sep = lastCollapse) } } x } # hpaste() # More efficient than the default utils::capture.output() #' @importFrom utils capture.output capture_output <- function(expr, envir = parent.frame(), ...) { res <- eval({ file <- rawConnection(raw(0L), open = "w") on.exit(close(file)) capture.output(expr, file = file) rawToChar(rawConnectionValue(file)) }, envir = envir, enclos = baseenv()) unlist(strsplit(res, split = "\n", fixed = TRUE), use.names = FALSE) } now <- function(x = Sys.time(), format = "[%H:%M:%OS3] ") { format(as.POSIXlt(x, tz = ""), format = format) } mdebug <- function(..., debug = getOption("progressr.debug", FALSE)) { if (!debug) return() message(now(), ...) } mprintf <- function(..., appendLF = TRUE, debug = getOption("progressr.debug", FALSE)) { if (!debug) return() message(now(), sprintf(...), appendLF = appendLF) } mdebugf <- mprintf mprint <- function(..., appendLF = TRUE, debug = getOption("progressr.debug", FALSE)) { if (!debug) return() message(paste(now(), capture_output(print(...)), sep = "", collapse = "\n"), appendLF = appendLF) } #' @importFrom utils str mstr <- function(..., appendLF = TRUE, debug = getOption("progressr.debug", FALSE)) { if (!debug) return() message(paste(now(), capture_output(str(...)), sep = "", collapse = "\n"), appendLF = appendLF) } comma <- function(x, sep = ", ") paste(x, collapse = sep) commaq <- function(x, sep = ", ") paste(sQuote(x), collapse = sep) trim <- function(s) sub("[\t\n\f\r ]+$", "", sub("^[\t\n\f\r ]+", "", s)) stop_if_not <- function(..., calls = sys.calls()) { res <- list(...) n <- length(res) if (n == 0L) return() for (ii in 1L:n) { res_ii <- .subset2(res, ii) if (length(res_ii) != 1L || is.na(res_ii) || !res_ii) { mc <- match.call() call <- deparse(mc[[ii + 1]], width.cutoff = 60L) if (length(call) > 1L) call <- paste(call[1L], "...") 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) } } } ## Used for package testing purposes only when we want to perform ## everything except the last part where the backend is called ## This allows us to cover more of the code in package tests is_fake <- local({ cache <- list() function(name) { fake <- cache[[name]] if (is.null(fake)) { fake <- name %in% getOption("progressr.tests.fake_handlers") cache[[name]] <<- fake } fake } }) known_progression_handlers <- function(exclude = NULL) { ns <- asNamespace(.packageName) handlers <- ls(envir = ns, pattern = "^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 } `%||%` <- function(lhs, rhs) { if (is.null(lhs)) rhs else lhs } ## From R.utils 2.7.0 (2018-08-26) query_r_cmd_check <- function(...) { evidences <- list() # Command line arguments args <- commandArgs() evidences[["vanilla"]] <- is.element("--vanilla", args) # Check the working directory pwd <- getwd() dirname <- basename(pwd) parent <- basename(dirname(pwd)) pattern <- ".+[.]Rcheck$" # Is 'R CMD check' checking tests? evidences[["tests"]] <- ( grepl(pattern, parent) && grepl("^tests(|_.*)$", dirname) ) # Is the current working directory as expected? evidences[["pwd"]] <- (evidences[["tests"]] || grepl(pattern, dirname)) # Is 'R CMD check' checking examples? evidences[["examples"]] <- is.element("CheckExEnv", search()) # SPECIAL: win-builder? evidences[["win-builder"]] <- (.Platform$OS.type == "windows" && grepl("Rterm[.]exe$", args[1])) if (evidences[["win-builder"]]) { n <- length(args) if (all(c("--no-save", "--no-restore", "--no-site-file", "--no-init-file") %in% args)) { evidences[["vanilla"]] <- TRUE } if (grepl(pattern, parent)) { evidences[["pwd"]] <- TRUE } } if (!evidences$vanilla || !evidences$pwd) { res <- "notRunning" } else if (evidences$tests) { res <- "checkingTests" } else if (evidences$examples) { res <- "checkingExamples" } else { res <- "notRunning" } attr(res, "evidences") <- evidences res } in_r_cmd_check <- function() { query_r_cmd_check() != "notRunning" } ## Check whether current R process is running as a forked child is_fork_child <- local({ main_pid <- NULL function() { if (is.null(main_pid)) main_pid <<- Sys.getpid() Sys.getpid() != main_pid } }) serialization_size <- function(x) { size <- length(serialize(x, connection = NULL, xdr = TRUE)) class(size) <- "object_size" size } progressr/R/vignette_engine.R0000644000175000017500000000540014122707130016124 0ustar nileshnileshregister_vignette_engine_during_build_only <- function(pkgname) { # Are vignette engines supported? if (getRversion() < "3.0.0") return() # Nope! ## HACK: Only register vignette engine 'selfonly' during R CMD build if (Sys.getenv("R_CMD") == "") return() tools::vignetteEngine("selfonly", package = pkgname, pattern = "[.]md$", weave = function(file, ...) { output <- sprintf("%s.html", tools::file_path_sans_ext(basename(file))) md <- readLines(file) title <- grep("%\\VignetteIndexEntry{", md, fixed = TRUE, value = TRUE) title <- gsub(".*[{](.*)[}].*", "\\1", title) ## Inject vignette title md <- c(sprintf("# %s\n\n", title), md) html <- commonmark::markdown_html(md, smart = FALSE, extensions = "table", normalize = FALSE) ## Embed images as mimes <- list( gif = "image/gif", jpg = "image/jpeg", png = "image/png", svg = "image/svg+xml" ) html <- unlist(strsplit(html, split = "\n", fixed = TRUE)) for (ext in names(mimes)) { mime <- mimes[[ext]] pattern <- sprintf('(.*[ ]src=")([^"]+[.]%s)(".*)', ext) idxs <- grep(pattern, html) if (length(idxs) == 0) next if (!requireNamespace(stealth <- "base64enc", quietly = TRUE)) { stop("This vignette requires the ", sQuote(stealth), " package because it contains a ", sQuote(toupper(ext)), " image") } ns <- getNamespace(stealth) dataURI <- get("dataURI", mode = "function", envir = ns) for (idx in idxs) { file <- gsub(pattern, "\\2", html[idx]) uri <- dataURI(file = file, mime = mime) html[idx] <- gsub(pattern, sprintf("\\1%s\\3", uri), html[idx]) } } ## Inject HTML environment html <- c("", "", "", sprintf("%s", title), "", "", "", html, "", "") writeLines(html, con = output) output }, tangle = function(file, ...) { ## As of R 3.3.2, vignette engines must produce tangled output, but as ## long as it contains all comments then 'R CMD build' will drop it. output <- sprintf("%s.R", tools::file_path_sans_ext(basename(file))) cat(sprintf("### This is an R script tangled from %s\n", sQuote(basename(file))), file = output) output } ) } progressr/R/delays.R0000644000175000017500000000230414157452641014247 0ustar nileshnileshuse_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) } delay_stdout <- function(delays, stdout_file) { ## Delay standard output? if (is.null(stdout_file) && delays$stdout) { stdout_file <- buffer_stdout() } stdout_file } progressr/R/handler_tkprogressbar.R0000644000175000017500000000503614156730361017355 0ustar nileshnilesh#' Progression Handler: Progress Reported as a Tcl/Tk Progress Bars in the GUI #' #' A progression handler for [tcltk::tkProgressBar()]. #' #' @inheritParams make_progression_handler #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @example incl/handler_tkprogressbar.R #' #' @section Requirements: #' This progression handler requires the \pkg{tcltk} package and that the #' current R session supports Tcl/Tk (`capabilities("tcltk")`). #' #' @export handler_tkprogressbar <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "terminal", ...) { ## Additional arguments passed to the progress-handler backend backend_args <- handler_backend_args(...) ## Used for package testing purposes only when we want to perform ## everything except the last part where the backend is called if (!is_fake("handler_tkprogressbar")) { if (!capabilities("tcltk")) { stop("handler_tkprogressbar requires TclTk support") } ## Import functions tkProgressBar <- tcltk::tkProgressBar setTkProgressBar <- tcltk::setTkProgressBar } else { tkProgressBar <- function(...) rawConnection(raw(0L)) setTkProgressBar <- function(...) NULL } reporter <- local({ pb <- NULL make_pb <- function(...) { if (!is.null(pb)) return(pb) args <- c(list(...), backend_args) pb <<- do.call(tkProgressBar, args = args) pb } list( reset = function(...) { pb <<- NULL }, initiate = function(config, state, progression, ...) { if (!state$enabled || config$times == 1L) return() ## NOTE: 'pb' may be re-used for tkProgressBar:s if (config$clear) stop_if_not(is.null(pb)) make_pb(max = config$max_steps, label = state$message) }, update = function(config, state, progression, ...) { if (!state$enabled || progression$amount == 0 || config$times <= 2L) return() make_pb(max = config$max_steps, label = state$message) setTkProgressBar(pb, value = state$step, label = state$message) }, finish = function(config, state, progression, ...) { ## Already finished? if (is.null(pb)) return() if (!state$enabled) return() if (config$clear) { close(pb) pb <<- NULL } else { setTkProgressBar(pb, value = state$step, label = state$message) } } ) }) make_progression_handler("tkprogressbar", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/progress.R0000644000175000017500000000201014124007032014604 0ustar nileshnilesh#' Creates and Signals a Progression Condition #' #' _WARNING:_ `progress()` is defunct - don't use. #' #' @param \ldots Arguments pass to [progression()]. #' #' @param call (expression) A call expression. #' #' @return A [base::condition] of class `progression`. #' #' @seealso #' To create a progression condition, use [progression()]. #' To signal a progression condition, use [base::signalCondition()]. #' #' @keywords internal #' @export progress <- function(..., call = sys.call()) { action <- getOption("progressr.lifecycle.progress", "defunct") signal <- switch(action, deprecated = .Deprecated, defunct = .Defunct) signal(msg = sprintf("progress() is %s", action), package = .packageName) args <- list(...) if (length(args) == 1L && inherits(args[[1L]], "condition")) { cond <- args[[1L]] stop_if_not(inherits(cond, "progression")) } else { cond <- progression(..., call = call) } withRestarts( signalCondition(cond), muffleProgression = function(p) NULL ) invisible(cond) } progressr/R/handler_rstudio.R0000644000175000017500000000513314122707130016143 0ustar nileshnilesh#' Progression Handler: Progress Reported in the RStudio Console #' #' @inheritParams make_progression_handler #' #' @param title (character or a function) The "name" of the progressor, which #' is displayed in front of the progress bar. If a function, then the name #' is created dynamically by calling the function when the progressor is #' created. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @section Requirements: #' This progression handler works only in the RStudio Console. #' #' @section Use this progression handler by default: #' To use this handler by default whenever using the RStudio Console, add #' the following to your \file{~/.Rprofile} startup file: #' #' ```r #' if (requireNamespace("progressr", quietly = TRUE)) { #' if (Sys.getenv("RSTUDIO") == "1" && !nzchar(Sys.getenv("RSTUDIO_TERM"))) { #' options(progressr.handlers = progressr::handler_rstudio) #' } #' } #' ``` #' #' @example incl/handler_rstudio.R #' #' @export handler_rstudio <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", title = function() format(Sys.time(), "Console %X"), ...) { reporter <- local({ job_id <- NULL list( initiate = function(config, state, ...) { if (!state$enabled || config$times <= 2L) return() name <- state$message if (length(name) == 0L) { if (is.null(title)) { name <- "Console" } else if (is.character(title)) { name <- title } else if (is.function(title)) { name <- title() } } stop_if_not( is.null(job_id), is.character(name), length(name) == 1L ) job_id <<- rstudioapi::jobAdd( name = name, progressUnits = as.integer(config$max_steps), status = "running", autoRemove = FALSE, show = FALSE ) }, update = function(config, state, progression, ...) { if (!state$enabled || config$times <= 2L) return() ## The RStudio Job progress bar cannot go backwards if (state$delta < 0) return() ## The RStudio Job progress bar does not have a "spinner" if (state$delta == 0) return() stop_if_not(!is.null(job_id)) rstudioapi::jobSetProgress(job_id, units = state$step) }, finish = function(...) { if (!is.null(job_id)) rstudioapi::jobRemove(job_id) job_id <<- NULL } ) }) make_progression_handler("rstudio", reporter, intrusiveness = intrusiveness, target = target, ...) } progressr/R/make_progression_handler.R0000644000175000017500000004466114157452414020044 0ustar nileshnilesh#' Creates a Progression Calling Handler #' #' A progression calling handler is a function that takes a [base::condition] #' as its first argument and that can be use together with #' [base::withCallingHandlers()]. This function helps creating such #' progression calling handler functions. #' #' @param name (character) Name of progression handler. #' #' @param reporter (environment) A reporter environment. #' #' @param handler (function) Function take a [progression] condition #' as the first argument. #' #' @param intrusiveness (numeric) A non-negative scalar on how intrusive #' (disruptive) the reporter to the user. #' #' @param enable (logical) If FALSE, then progress is not reported. #' #' @param enable_after (numeric) Delay (in seconds) before progression #' updates are reported. #' #' @param times (numeric) The maximum number of times this handler #' should report progression updates. #' If zero, then progress is not reported. #' #' @param interval (numeric) The minimum time (in seconds) between #' successive progression updates from this handler. #' #' @param clear (logical) If TRUE, any output, typically visual, produced #' by a reporter will be cleared/removed upon completion, if possible. #' #' @param target (character vector) Specifies where progression updates are #' rendered. #' #' @param \ldots Additional arguments passed to [make_progression_handler()] #' or not used. #' #' @return A function of class `progression_handler` that takes a #' [progression] condition as its first and only argument. #' #' @details #' The inner details of progression handlers and how to use this function #' are still to be documented. Until then, see the source code of existing #' handlers for how it is used, e.g. `progressr::handler_txtprogressbar`. #' Please use with care as things might change. #' #' @seealso #' [base::withCallingHandlers()]. #' #' @keywords internal #' @export make_progression_handler <- function(name, reporter = list(), handler = NULL, enable = getOption("progressr.enable", interactive()), enable_after = getOption("progressr.enable_after", 0.0), times = getOption("progressr.times", +Inf), interval = getOption("progressr.interval", 0.0), intrusiveness = 1.0, clear = getOption("progressr.clear", TRUE), target = "terminal", ...) { enable <- as.logical(enable) stop_if_not(is.logical(enable), length(enable) == 1L, !is.na(enable)) if (!enable) times <- 0 name <- as.character(name) stop_if_not(length(name) == 1L, !is.na(name), nzchar(name)) # stop_if_not(is.function(handler)) # formals <- formals(handler) # stop_if_not(length(formals) == 1L) stop_if_not(is.list(reporter)) enable_after <- as.numeric(enable_after) stop_if_not(is.numeric(enable_after), length(enable_after), !is.na(enable_after), enable_after >= 0) times <- as.numeric(times) stop_if_not(length(times) == 1L, is.numeric(times), !is.na(times), times >= 0) interval <- as.numeric(interval) stop_if_not(length(interval) == 1L, is.numeric(interval), !is.na(interval), interval >= 0) clear <- as.logical(clear) stop_if_not(is.logical(clear), length(clear) == 1L, !is.na(clear)) stop_if_not(is.character(target)) ## Disable progress updates? if (times == 0 || is.infinite(interval) || is.infinite(intrusiveness)) { handler <- function(p) NULL } ## Reporter for (key in setdiff(c("reset", "initiate", "update", "finish", "hide", "unhide", "interrupt"), names(reporter))) { reporter[[key]] <- structure(function(...) NULL, class = "null_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() ## Sanity checks .validate_internal_state <- function(label = "") { error <- function(...) { msg <- sprintf(...) stop(sprintf(".validate_internal_state(%s): %s", sQuote(label), msg)) } if (!is.null(timestamps)) { if (length(timestamps) == 0L) { error(paste("length(timestamps) == 0L but not is.null(timestamps):", sQuote(deparse(timestamps)))) } } } reporter_args <- function(progression) { .validate_internal_state("reporter_args() ... begin") if (!enabled && !is.null(timestamps)) { dt <- difftime(Sys.time(), timestamps[1L], units = "secs") enabled <<- (dt >= enable_after) } config <- list( max_steps = max_steps, times = times, interval = interval, enable_after = enable_after, auto_finish = auto_finish, clear = clear, target = target ) state <- list( step = step, message = message, timestamps = timestamps, delta = step - prev_milestone, enabled = enabled ) if (length(state$delta) == 0L) state$delta <- 0L .validate_internal_state("reporter_args() ... end") c(config, state, list( config = config, state = state, progression = progression )) } 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) if (debug) { mprintf("reset_reporter() ...") mstr(args) } do.call(reporter$reset, args = args) .validate_internal_state("reset_reporter() ... done") if (debug) mprintf("reset_reporter() ... done") } initiate_reporter <- function(p) { args <- reporter_args(progression = p) debug <- getOption("progressr.debug", FALSE) if (debug) { 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") } update_reporter <- function(p) { args <- reporter_args(progression = p) debug <- getOption("progressr.debug", FALSE) if (debug) { 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") if (debug) mprintf("update_reporter() ... done") } hide_reporter <- function(p) { args <- reporter_args(progression = p) debug <- getOption("progressr.debug", FALSE) if (debug) { mprintf("hide_reporter() ...") mstr(args) } # stop_if_not(isTRUE(active)) if (is.null(reporter$hide)) { if (debug) mprintf("hide_reporter() ... skipping; not supported") return() } do.call(reporter$hide, args = args) .validate_internal_state("hide_reporter() ... done") if (debug) mprintf("hide_reporter() ... done") } unhide_reporter <- function(p) { args <- reporter_args(progression = p) debug <- getOption("progressr.debug", FALSE) if (debug) { mprintf("unhide_reporter() ...") mstr(args) } # stop_if_not(isTRUE(active)) if (is.null(reporter$unhide)) { if (debug) mprintf("unhide_reporter() ... skipping; not supported") return() } do.call(reporter$unhide, args = args) .validate_internal_state("unhide_reporter() ... done") if (debug) mprintf("unhide_reporter() ... done") } interrupt_reporter <- function(p) { args <- reporter_args(progression = p) debug <- getOption("progressr.debug", FALSE) if (debug) { mprintf("interrupt_reporter() ...") mstr(args) } # stop_if_not(isTRUE(active)) if (is.null(reporter$interrupt)) { if (debug) mprintf("interrupt_reporter() ... skipping; not supported") return() } do.call(reporter$interrupt, args = args) .validate_internal_state("interrupt_reporter() ... done") if (debug) mprintf("interrupt_reporter() ... done") } finish_reporter <- function(p) { args <- reporter_args(progression = p) debug <- getOption("progressr.debug", FALSE) if (debug) { mprintf("finish_reporter() ...") mstr(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) { why <- if (!active && !finished) { "not active" } else if (!active && finished) { "not active and already finished" } else if (active && finished) { "already finished" } message(sprintf("- Hmm ... got a request to 'finish' handler, but it's %s. Oh well, will finish it then", why)) } } reset_internal_state() finished <<- TRUE if (debug) message("- owner: ", deparse(owner)) .validate_internal_state("finish_reporter() ... done") if (debug) mprintf("finish_reporter() ... done") } is_owner <- function(p) { 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"]] progression_id <- sprintf("%s-%d-%s", session_uuid, progression_index, progression_time) db <- done[["progressor_uuid"]] res <- is.element(progression_id, db) if (!res) { db <- c(db, progression_id) done[["progressor_uuid"]] <<- db } res } if (is.null(handler)) { handler <- function(p) { stop_if_not(inherits(p, "progression")) ## Ignore if running in a forked child process if (is_fork_child()) return(invisible(FALSE)) if (inherits(p, "control_progression")) { type <- p[["type"]] if (type == "reset") { reset_internal_state() reset_reporter(p) .validate_internal_state(sprintf("handler(type=%s) ... end", type)) } else if (type == "shutdown") { finish_reporter(p) .validate_internal_state(sprintf("handler(type=%s) ... end", type)) } else if (type == "hide") { hide_reporter(p) .validate_internal_state(sprintf("handler(type=%s) ... end", type)) } else if (type == "unhide") { unhide_reporter(p) .validate_internal_state(sprintf("handler(type=%s) ... end", type)) } else if (type == "interrupt") { interrupt_reporter(p) .validate_internal_state(sprintf("handler(type=%s) ... end", type)) } else { stop("Unknown control_progression type: ", sQuote(type)) } .validate_internal_state(sprintf("control_progression ... end", type)) 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)) { if (debug) message("- not owner of this progression. Skipping") return(invisible(finished)) } duplicated <- is_duplicated(p) type <- p[["type"]] 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("- duplicated: %s", duplicated) } if (duplicated) { if (debug) mprintf("Progression calling handler %s ... condition already done", sQuote(type)) return(invisible(finished)) } 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 >= 0) auto_finish <<- p[["auto_finish"]] times <- min(times, max_steps) if (debug) mstr(list(auto_finish = auto_finish, times = times, interval = interval, intrusiveness = intrusiveness)) ## Adjust 'times' and 'interval' according to 'intrusiveness' times <- min(c(times / intrusiveness, max_steps), na.rm = TRUE) times <- max(times, 1L) interval <- interval * intrusiveness if (debug) mstr(list(times = times, interval = interval)) ## Milestone steps that need to be reach in order to trigger an ## update of the reporter milestones <<- if (times == 1L) { c(max_steps) } else if (times == 2L) { c(0L, max_steps) } else { seq(from = 0L, to = max_steps, length.out = times + 1L)[-1] } ## Timestamps for when steps where reached ## Note that they will remain NA for "skipped" steps timestamps <<- rep(as.POSIXct(NA), times = max_steps) timestamps[1] <<- Sys.time() step <<- 0L message <<- character(0L) if (debug) mstr(list(finished = finished, milestones = milestones)) initiate_reporter(p) prev_milestone <<- step .validate_internal_state(sprintf("handler(type=%s) ... end", type)) } else if (type == "finish") { if (debug) mstr(list(finished = finished, milestones = milestones)) finish_reporter(p) .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"]], "p$step"=p[["step"]], max_steps=max_steps)) if (!is.null(p[["step"]])) { ## Infer effective 'amount' from previous 'step' and p$step p[["amount"]] <- p[["step"]] - step } step <<- min(max(step + p[["amount"]], 0L), max_steps) stop_if_not(step >= 0L) msg <- conditionMessage(p) if (length(msg) > 0) message <<- msg 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 if ((length(milestones) > 0L && step >= milestones[1]) || p[["amount"]] == 0) { skip <- FALSE 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)) } if (!skip) { if (debug) mstr(list(milestones = milestones)) update_reporter(p) if (p[["amount"]] > 0) prev_milestone <<- step } 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)) } else { stop("Unknown 'progression' type: ", sQuote(type)) } ## Sanity checks .validate_internal_state(sprintf("handler() ... end", type)) if (debug) mprintf("Progression calling handler %s ... done", sQuote(type)) invisible(finished) } ## handler() } class(handler) <- c(sprintf("%s_progression_handler", name), "progression_handler", "calling_handler", class(handler)) handler } #' @export print.progression_handler <- function(x, ...) { print(sys.calls()) s <- sprintf("Progression calling handler of class %s:", sQuote(class(x)[1])) env <- environment(x) s <- c(s, " * configuration:") s <- c(s, sprintf(" - name: %s", sQuote(env$name %||% ""))) s <- c(s, sprintf(" - max_steps: %s", env$max_steps %||% "")) s <- c(s, sprintf(" - enable: %s", env$enable)) s <- c(s, sprintf(" - enable_after: %g seconds", env$enable_after)) s <- c(s, sprintf(" - times: %g", env$times)) s <- c(s, sprintf(" - interval: %g seconds", env$interval)) s <- c(s, sprintf(" - intrusiveness: %g", env$intrusiveness)) s <- c(s, sprintf(" - auto_finish: %s", env$auto_finish)) s <- c(s, sprintf(" - clear: %s", env$clear)) s <- c(s, sprintf(" - target: %s", paste(sQuote(env$target), collapse = ", "))) s <- c(s, sprintf(" - milestones: %s", hpaste(env$milestones %||% ""))) s <- c(s, sprintf(" - owner: %s", hpaste(env$owner %||% ""))) s <- c(s, " * state:") s <- c(s, sprintf(" - enabled: %s", env$enabled)) s <- c(s, sprintf(" - finished: %s", env$finished)) s <- c(s, sprintf(" - step: %s", env$step %||% "")) s <- c(s, sprintf(" - message: %s", env$message %||% "")) s <- c(s, sprintf(" - prev_milestone: %s", env$prev_milestone %||% "")) s <- c(s, sprintf(" - delta: %g", (env$step - env$prev_milestone) %||% 0L)) s <- c(s, sprintf(" - timestamps: %s", hpaste(env$timestamps %||% ""))) s <- paste(s, collapse = "\n") cat(s, "\n", sep = "") } # Additional arguments passed to the progress backend handler_backend_args <- function(...) { args <- list(...) if (length(args) == 0L) return(list()) names <- names(args) if (is.null(names) || !all(nzchar(names))) { stop("Additional arguments must be named") } ## Drop arguments passed to make_progression_handler() names <- setdiff(names, names(formals(make_progression_handler))) args[names] } progressr/R/handler_txtprogressbar.R0000644000175000017500000001143314157465361017562 0ustar nileshnilesh#' Progression Handler: Progress Reported as Plain Progress Bars (Text) in the Terminal #' #' A progression handler for [utils::txtProgressBar()]. #' #' @inheritParams make_progression_handler #' #' @param style (integer) The progress-bar style according to #' [utils::txtProgressBar()]. #' #' @param file (connection) A [base::connection] to where output should be sent. #' #' @param \ldots Additional arguments passed to [make_progression_handler()]. #' #' @section Appearance: #' Below is how this progress handler renders at 0%, 30% and 99% progress #' for the three different `style` values that [utils::txtProgressBar()] #' supports. #' #' With `handlers(handler_txtprogressbar(style = 1L))`: #' ```r #' #' ==================================== #' ========================================================== #' ``` #' #' With `handlers(handler_txtprogressbar(style = 2L))`: #' ```r #' #' ==================================== #' ========================================================== #' ``` #' #' With `handlers(handler_txtprogressbar(style = 3L))`: #' ```r #' | | 0% #' |=============== | 30% #' |=================================================| 99% #' ``` #' #' @example incl/handler_txtprogressbar.R #' #' @importFrom utils file_test flush.console txtProgressBar setTxtProgressBar #' @export handler_txtprogressbar <- function(style = 3L, file = stderr(), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) { ## Additional arguments passed to the progress-handler backend backend_args <- handler_backend_args(...) reporter <- local({ pb <- NULL make_pb <- function(max, ...) { if (!is.null(pb)) return(pb) ## SPECIAL CASE: utils::txtProgressBar() does not support max == min if (max == 0) { pb <<- voidProgressBar() } else { args <- c(list(max = max, ...), backend_args) pb <<- do.call(txtProgressBar, args = args) } pb } list( reset = function(...) { pb <<- NULL }, hide = function(...) { if (is.null(pb)) return() eraseTxtProgressBar(pb) }, unhide = function(...) { if (is.null(pb)) return() redrawTxtProgressBar(pb) }, interrupt = function(config, state, progression, ...) { if (is.null(pb)) return() msg <- getOption("progressr.interrupt.message", "interrupt detected") msg <- paste(c("", msg, ""), collapse = "\n") cat(msg, file = file) }, initiate = function(config, state, progression, ...) { if (!state$enabled || config$times == 1L) return() stop_if_not(is.null(pb)) make_pb(max = config$max_steps, style = style, file = file) }, update = function(config, state, progression, ...) { if (!state$enabled || config$times == 1L) return() make_pb(max = config$max_steps, style = style, file = file) if (inherits(progression, "sticky")) { eraseTxtProgressBar(pb) message(paste0(state$message, "")) redrawTxtProgressBar(pb) } if (progression$amount == 0) return() setTxtProgressBar(pb, value = state$step) }, finish = function(config, state, progression, ...) { ## Already finished? if (is.null(pb)) return() if (!state$enabled) return() if (config$clear) { eraseTxtProgressBar(pb) ## Suppress newline outputted by close() pb_env <- environment(pb$getVal) file <- pb_env$file pb_env$file <- tempfile() on.exit({ if (file_test("-f", pb_env$file)) file.remove(pb_env$file) pb_env$file <- file }) } else { setTxtProgressBar(pb, value = config$max_steps) } close(pb) pb <<- NULL } ) }) make_progression_handler("txtprogressbar", reporter, intrusiveness = intrusiveness, target = target, ...) } #' @importFrom utils txtProgressBar voidProgressBar <- function(...) { pb <- txtProgressBar() class(pb) <- c("voidProgressBar", class(pb)) pb } ## Erase a utils::txtProgressBar() eraseTxtProgressBar <- function(pb) { if (inherits(pb, "voidProgressBar")) return() pb_env <- environment(pb$getVal) with(pb_env, { if (style == 1L || style == 2L) { n <- .nb } else if (style == 3L) { n <- 3L + nw * width + 6L } cat("\r", strrep(" ", times = n), "\r", sep = "", file = file) flush.console() ## Reset internal counter, cf. utils::txtProgressBar() .nb <- 0L .pc <- -1L }) } ## Redraw a utils::txtProgressBar() redrawTxtProgressBar <- function(pb) { if (inherits(pb, "voidProgressBar")) return() setTxtProgressBar(pb, value = pb$getVal()) } progressr/NEWS0000644000175000017500000004663014157511404013144 0ustar nileshnileshPackage: progressr ================== Version: 0.10.0 [2021-12-18] SIGNIFICANT CHANGES: * Now interrupts are detected, which triggers the progress handlers to terminate nicely, e.g. a progress bar in the terminal will stay as is instead of being cleared. BUG FIXES: * A progressor that signaled progress beyond 100% prevented any further progressors in the same environment to report on progress. * It was not possible to reuse handlers of type 'progress' more than once, because they did not fully reset themselves when finished. * The 'pbcol' progression handler did not respect clean = FALSE. DEPRECATED AND DEFUNCT: * Function progress() is defunct in order to re-use it for other purpose. It is unlikely that anyone really used this function, but if you did, then use cond <- progression() to create 'progression' condition and then use withRestart(signalCondition(cond), muffleProgression = function(p) NULL) to signal it. Version: 0.9.0 [2021-09-24] PERFORMANCE: * The progressor function created by progressor() no longer "inherit" objects from the calling environment, which would, for instance, result in those objects to be exported to parallel workers together with the progressor function, which in turn would come with large time and memory costs. * progressor() no longer records the call stack for progressions by default, because that significantly increases the size of these condition objects, e.g. instead of being 5 kB it may be 500 kB. If a large number of progress updates are signaled and collected, as done, for instance, by futures, then the memory consumption on the collecting end could become very large. The large sizes would also have a negative impact on the performance in parallelization with futures because of the extra overhead of transferring these extra large conditions from the parallel workers back to the main R session. These issues has been there since progressr 0.7.0 (December 2020). To revert to the previous behavior, use progressor(..., trace = TRUE). NEW FEATURES: * progressor() gained argument 'trace' to control whether or not the call stack should be recorded in each progression condition. * Now print() for 'progressor' functions and 'progression' conditions report also on the size of the object, i.e. the number of bytes it requires when serialized, for instance, to and from a parallel worker. BUG FIXES: * Registered progression handlers would report on progress also when in a _forked_ parallel child processes, e.g. when using parallel::mclapply(). This would give a false impression that progressr updates would work when using parallel::mclapply(), which is not true. Note however, that it does indeed work when using the future 'multicore' backend, which uses forks. Version: 0.8.0 [2021-06-09] SIGNIFICANT CHANGES: * Creating a new progressor() will now automatically finish an existing progressor, if one was previously created in the same environment. The previous behavior was to give an error (see below bug fix). * R_PROGRESSR_* environment variables are now only read when the 'progressr' package is loaded, where they set the corresponding progressr.* option. Previously, some of these environment variables were queried by different functions as a fallback to when an option was not set. By only parsing them when the package is loaded, it decrease the overhead in functions, and it clarifies that options can be changed at runtime whereas environment variables should only be set at startup. * When using withProgressShiny(), progression messages now updates the 'detail' component of the Shiny progress panel. Previously, it updated the 'message' component. This can be configured via new 'inputs' argument. NEW FEATURES: * withProgressShiny() gained argument 'inputs', which can be used to control whether or not Shiny progress components 'message' and 'detail' should be updated based on the progression message, e.g. inputs = list(message = "sticky_message", detail = "message") will cause progression messages to update the 'detail' component and sticky ones to update both. * Now supporting zero-length progressors, e.g. p <- progressor(along = x) where length(x) == 0. * Add handlers("rstudio") to report on progress in the RStudio Console via the RStudio Job interface. BETA FEATURES: * As an alternative to specifying the relative amount of progress, say, p(amount = 2), it is now possible to also specify the absolute amount of progress made this far, e.g. p(step = 42). Argument 'amount' has not effect when argument 'step' is specified. WARNING: Argument 'step' should only be used when in full control of the order when this progression condition is signaled. For example, it must not be signaled as one of many parallel progress updates signaled concurrently, because we cannot guarantee the order these progressions arrive. BUG FIXES: * In progressr 0.7.0, any attempt to use more than one progressor inside a function or a local() call would result in: Error in assign("...progressor", value = fcn, envir = envir) : cannot change value of locked binding for '...progressor'. DEPRECATED AND DEFUNCT: * Function progress() is deprecated in order to re-use it for other purpose. It is unlikely that anyone really used this function, but if you did, then use cond <- progression() to create 'progression' condition and then use withRestart(signalCondition(cond), muffleProgression = function(p) NULL) to signal it. Version: 0.7.0 [2020-12-11] SIGNIFICANT CHANGES: * The user can now use handlers(global = TRUE) to enable progress reports 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) }). * 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 '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. * 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. * 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. * Progression handlers now return invisibly whether or not they are finished. BUG FIXES: * Zero-amount progress updates never reached the progress handlers. * Argument 'enable' for with_progress() had no effect. Version: 0.6.0 [2020-05-18] SIGNIFICANT CHANGES: * Now with_progress() makes sure that any output produced while reporting on 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 usual regardless of progress being reported or not. NEW FEATURES: * Signaling progress(msg, class = "sticky") will cause the message to be sticky, e.g. for progress bars outputting to the terminal, the message will be "pushed" above the progress bar. * with_progress() gained argument 'delay_terminal' whose default will be automatically inferred from inspecting the currently set handlers and whether they output to the terminal or not. * Arguments 'delay_stdout' and 'delay_conditions' for with_progress() is now agile to the effective value of the 'delay_terminal' argument. * Now handler_nnn() functions pass additional arguments in '...' to the underlying progress-handler backend, e.g. handler_progress(width = 40L) will set up progress::progress_bar$new(width = 40L). * Add environment variables 'R_PROGRESSR_CLEAR', 'R_PROGRESSR_ENABLE', 'R_PROGRESSR_ENABLE_AFTER', 'R_PROGRESSR_TIMES', and 'R_PROGRESSR_INTERVAL' for controlling the default value of the corresponding 'progressr.*' options. BUG FIXES: * Limiting the frequency of progress reporting via handler arguments 'times', '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. * handlers() did not return invisible (as documented). * Argument 'target' was ignored for all handler functions. * Argument 'interval' was ignored for handler_debug(). * The class of handler_nnn() functions where all "reset_progression_handler" rather than "nnn_progression_handler". The same bug caused the reported 'name' field to be "reset" rather than "nnn". Version: 0.5.0 [2020-04-16] NEW FEATURES: * Add 'void' progression handler. BUG FIXES: * Only the last of multiple progression handlers registered was used. Version: 0.4.0 [2020-01-22] SIGNIFICANT CHANGES: * All progression handler function have been renamed from _handler() to handler_() to make it easier to use autocompletion on them. Version: 0.3.0 [2020-01-20] NEW FEATURES: * progressor() gained arguments 'offset' and 'scale', and 'transform'. * handlers() gained argument 'append' to make it easier to append handlers. BUG FIXES: * A progression condition with amount = 0 would not update the message. Version: 0.2.1 [2020-01-04] BUG FIXES: * winprogressbar_handler() would produce error "invalid 'Label' argument". * handlers() did not return a list if the 'default' handler was returned. Version: 0.2.0 [2020-01-04] SIGNIFICANT CHANGES: * Renamed withProgress2() to withProgressShiny(). NEW FEATURES: * handlers() gained argument 'default' specifying a progression handler to be returned if none is set. Version: 0.1.5 [2019-10-26] NEW FEATURES: * 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. * Add demo("mandelbrot", package = "progressr"). BUG FIXES: * Package could set '.Random.seed' to NULL, instead of removing it, which in turn would produce a warning on "'.Random.seed' is not an integer vector but of type 'NULL', so ignored" when the next random number generated. Version: 0.1.4 [2019-07-02] NEW FEATURES: * Add support for progressor(along = ...). Version: 0.1.3 [2019-07-01] NEW FEATURES: * Now it is possible to send "I'm still here" progression updates by setting the progress step to zero, e.g. progress(amount = 0). This type of information can for instance be used to updated a progress bar spinner. * Add utility function handlers() for controlling option 'progressr.handlers'. * Progression handlers' internal state now has a sticky 'message' field, which hold the most recent, non-empty progression 'message' received. Version: 0.1.2 [2019-06-14] NEW FEATURES: * with_progress() gained arguments 'enable' and 'interval' as an alternative to setting corresponding options progressr.*. * Now option 'progressr.interval' defaults to 0.0 (was 0.5 seconds). * Added print() for 'progression_handler' objects. BUG FIXES: * with_progress(..., delay_conditions = "condition"), introduced in v0.1.0, would also capture conditions produced by progression handlers, e.g. progress::progress_bar() output would not be displayed until the very end. Version: 0.1.1 [2019-06-08] NEW FEATURES: * with_progress() now captures standard output and conditions and relay them at then end. This is done in order to avoid interweaving such output with the output produced by the progression handlers. This behavior can be controlled by arguments 'delay_stdout' and 'delay_condition'. Version: 0.1.0 [2019-06-07] NEW FEATURES: * Now a progression condition is identified from the R session UUID, the progressor UUID, the incremental progression index, and the progression timestamp. BUG FIXES: * A progressor object that was exported to the same external R process multiple times would produce progression conditions that was non-distinguishable from those previously exported. Adding a timestamp to the progression condition makes them distinguishable. Version: 0.0.6 [2019-06-03] NEW FEATURES: * Add print() for progression conditions and progressor functions. * Now the progressors record more details on the session information. This information is passed along with all progression conditions as part of the internal owner information. Version: 0.0.5 [2019-05-20] NEW FEATURES: * Add filesize_handler progression handler. * 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 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. Version: 0.0.4 [2019-05-18] NEW FEATURES: * Add utils::winProgressBar() progression handler for MS Windows. * Add support for silent sounds for beepr::beep(). * Add option 'progressr.enable', which defaults to interactive(). SOFTWARE QUALITY: * TESTS: Increased package test coverage of progression handlers by running all code except the last step that calls the backend, which may not be installed or supported on the current platform, e.g. tcltk, beepr, notifier. BUG FIXES: * Precreated progression handlers could only be used once. * with_progress(..., cleanup = TRUE) requires a withRestart() such that also "shutdown" progressions can be muffled. Version: 0.0.3 [2019-05-17] NEW FEATURES: * Add argument 'enable_after' for progression handlers. * Now with_progress(..., cleanup = TRUE) will signal a generic "shutdown" progression at the end that will trigger all progression handlers to finish up regardless of all steps have been take or not. * Now progressions originating from an unknown source are ignored. * The default output format of the progress::progress_bar() progression handler is now ":percent :bar :message". * The tcltk::tkProgressBar() progression handler now displays the progression message. * Now the progression condition itself is passed to the progression reporter functions. * Add debug_handler for prototyping and debugging purposes. * Add newline_handler to add newlines between output of multiple handlers. * Argument 'intrusiveness' may now be zero. Previously it had to be a strictly positive value. * Add without_progress() - which causes all progression conditions to be muffled and ignored. BUG FIXES: * Progressor functions could produce progression conditions that had the same identifiers and therefore would be considered duplicates such that progression handlers would ignore them. * It was an error if a progression took a step big enough to skip more than the next milestone. * Progression handlers now keep the internal 'step' field within [0, max_steps] in case of a too big progression step is taken. * Progression updates received after progression handler is finished would keep increasing the internal step field. Version: 0.0.2 [2019-05-15] SIGNIFICANT CHANGES: * Renamed restart 'consume_progression' to 'muffleProgression' to align with restarts 'muffleMessage' and 'muffleWarning' in base R. NEW FEATURES: * Add a plyr-compatible "progress bar" named progress_progressr(). * Add option 'progressr.clear'. * Visual progression handler will now always render the complete update state when 'clear' is FALSE. * 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 and for the progressor that produced the condition. It also contains an unique index per progressor that is incremented whenever a new progression condition is created. Version: 0.0.1 [2019-05-08] SIGNIFICANT CHANGES: * First decent prototype of this package and the idea behind it. * Make 'auto_done = TRUE' the default. Version: 0.0.0-9004 [2019-05-08] NEW FEATURES: * Add argument 'auto_done' to automatically have progress updates also signal "done" as soon as the last step has been reached. * Made 'amount' the first argument of progressors to avoid having to specify it by name if progressing with an amount than the default 'amount = 1.0'. * Add argument 'clear' to control whether progress reporter should clear its output upon completion. The default is to do this, where supported. * Add progress update handler based on pbmcapply::progressBar(). * Each achieved step is now timestamped. * Add option 'progressr.debug'. Version: 0.0.0-9003 [2019-05-06] NEW FEATURES: * Add 'intrusiveness' parameter that specifies how intrusive/disruptive a certain progress reporter is. For instance, an auditory reporter is relatively more disruptive than a visual progress bar part of the status bar. * Simplified the API for creating new types of progress reporters. Version: 0.0.0-9002 [2019-04-25] NEW FEATURES: * Add progressor(). * Add progress_aggregator(). Version: 0.0.0-9001 [2019-04-24] NEW FEATURES: * Add progress update handlers based on utils::txtProgressBar(), tcltk::tkProgressBar(), cat("\a"), progress::progress_bar(), beepr::beep(), and notifier::notify(). * Add with_progress(). * Add options 'progressr.handlers' for settings default progress handlers. * Add 'progressr.times' for controlling the number of times progress updates are rendered. * Add 'progressr.interval' for controlling the minimum number of seconds that needs to elapse before reporting on the next update. Version: 0.0.0-9000 [2019-04-11] NEW FEATURES: * Add progress() to create and signal progression condition. * Add progression() to create progression condition. progressr/inst/0000755000175000017500000000000014157512126013413 5ustar nileshnileshprogressr/inst/WORDLIST0000644000175000017500000000135114157465741014617 0ustar nileshnileshAppVeyor beepr BEL CMD Ctrl doFuture foreach furrr github HenrikBengtsson https HTTPS lapply llply macOS multisession NL parallelize pbmcapply plyr Plyr POSIXct pre Pre progressor Progressor purrr Renviron roadmap Roadmap Rprofile selfonly SFTP substyle tcltk th tkProgressBar txtProgressBar VignetteAuthor VignetteEngine VignetteIndexEntry VignetteKeyword winProgressBar withProgress autocompletion Bengtsson filesize interweaved mandelbrot msg muffleMessage muffleProgression muffleWarning nnn Precreated progressBar progressr PROGRESSR stdout UUID winprogressbar withProgressShiny withRestart pbcol conditionMessage rstudio RStudio BiocParallel bplapply txtprogressbar cond envir fcn signalCondition md doParallel kB mclapply parallelization progressr/inst/doc/0000755000175000017500000000000014157512126014160 5ustar nileshnileshprogressr/inst/doc/progressr-intro.md0000644000175000017500000006015714157511644017676 0ustar nileshnilesh The **[progressr]** package provides a minimal API for reporting progress updates in [R](https://www.r-project.org/). The design is to separate the representation of progress updates from how they are presented. What type of progress to signal is controlled by the developer. How these progress updates are rendered is controlled by the end user. For instance, some users may prefer visual feedback such as a horizontal progress bar in the terminal, whereas others may prefer auditory feedback. Three strokes writing three in Chinese 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 - One For Developers and One For End-Users
Developer'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
    
End-user's API

1a. Subscribe to progress updates from everywhere: 

handlers(global = TRUE)

y <- slow_sum(1:5)
y <- slow_sum(6:10)

1b. Subscribe to a specific expression: 

with_progress({
  y <- slow_sum(1:5)
  y <- slow_sum(6:10)
})

2. Configure how progress is presented: 

handlers("progress")
handlers("txtprogressbar", "beepr")
handlers(handler_pbcol(enable_after = 3.0))
handlers(handler_progress(complete = "#"))
## A simple example Assume that we have a function `slow_sum()` for adding up the values in a vector. It is so slow, that we like to provide progress updates to whoever might be interested in it. With the **progressr** package, this can be done as: ```r slow_sum <- function(x) { p <- progressr::progressor(along = x) sum <- 0 for (kk in seq_along(x)) { Sys.sleep(0.1) sum <- sum + x[kk] p(message = sprintf("Added %g", x[kk])) } sum } ``` 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 on progress When calling this function as in: ```r > y <- slow_sum(1:10) > y [1] 55 > ``` it will behave as any function and there will be no progress updates displayed. ### Reporting on progress If we are only interested in progress for a particular call, we can do: ```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 The default is to present progress via `utils::txtProgressBar()`, which is available on all R installations. To change the default, to, say, `progress_bar()` by the **[progress]** package, set: ```r handlers("progress") ``` This progress handler will present itself as: ```r > y <- slow_sum(1:10) / [================>--------------------------] 40% Added 4 ``` To set the default progress handler, or handlers, in all your R sessions, call `progressr::handlers(...)` in your ~/.Rprofile file. ### Auditory progress updates Progress updates do not have to be presented visually. They can equally well be communicated via audio. For example, using: ```r 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 > y <- slow_sum(1:10) > y [1] 55 > ``` ### Concurrent auditory and visual progress updates It is possible to have multiple progress handlers presenting progress updates at the same time. For example, to get both visual and auditory updates, use: ```r handlers("txtprogressbar", "beepr") ``` ### Silence all progress To silence all progress updates, use: ```r handlers("void") ``` ### Further configuration of progress handlers Above we have seen examples where the `handlers()` takes one or more strings as input, e.g. `handlers(c("progress", "beepr"))`. This is short for a more flexible specification where we can pass a list of handler functions, e.g. ```r handlers(list( handler_progress(), handler_beepr() )) ``` With this construct, we can make adjustments to the default behavior of these progress handlers. For example, we can configure the `format`, `width`, and `complete` arguments of `progress::progress_bar$new()`, and tell **beepr** to use a different `finish` sound and generate sounds at most every two seconds by setting: ```r handlers(list( handler_progress( format = ":spin :current/:total (:message) [:bar] :percent in :elapsed ETA: :eta", width = 60, complete = "+" ), handler_beepr( finish = "wilhelm", interval = 2.0 ) )) ``` ## Sticky messages As seen above, some progress handlers present the progress message as part of its output, e.g. the "progress" handler will display the message as part of the progress bar. It is also possible to "push" the message up together with other terminal output. This can be done by adding class attribute `"sticky"` to the progression signaled. This works for several progress handlers that output to the terminal. For example, with: ```r slow_sum <- function(x) { p <- progressr::progressor(along = x) sum <- 0 for (kk in seq_along(x)) { Sys.sleep(0.1) sum <- sum + x[kk] p(sprintf("Step %d", kk), class = if (kk %% 5 == 0) "sticky", amount = 0) p(message = sprintf("Added %g", x[kk])) } sum } ``` we get ```r > handlers("txtprogressbar") > y <- slow_sum(1:30) Step 5 Step 10 |==================== | 43% ``` and ```r > handlers("progress") > y <- slow_sum(1:30) Step 5 Step 10 / [===============>--------------------------] 43% Added 13 ``` ## Use regular output as usual alongside progress updates In contrast to other progress-bar frameworks, output from `message()`, `cat()`, `print()` and so on, will _not_ interfere with progress reported via **progressr**. For example, say we have: ```r slow_sqrt <- function(xs) { p <- progressor(along = xs) lapply(xs, function(x) { message("Calculating the square root of ", x) Sys.sleep(2) p(sprintf("x=%g", x)) sqrt(x) }) } ``` we will get: ```r > library(progressr) > handlers(global = TRUE) > handlers("progress") > y <- slow_sqrt(1:8) Calculating the square root of 1 Calculating the square root of 2 - [===========>-----------------------------------] 25% x=2 ``` 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. ## Support for progressr elsewhere Note that progression updates by **progressr** is designed to work out of the box for any iterator framework in R. Below is an set of examples for the most common ones. ### Base R Apply Functions ```r library(progressr) handlers(global = TRUE) my_fcn <- function(xs) { p <- progressor(along = xs) y <- lapply(xs, function(x) { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # |==================== | 40% ``` ### The foreach package ```r library(foreach) library(progressr) handlers(global = TRUE) 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% ``` ### The purrr package ```r library(purrr) library(progressr) handlers(global = TRUE) my_fcn <- function(xs) { p <- progressor(along = xs) y <- map(xs, function(x) { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # |==================== | 40% ``` ### The plyr package ```r library(plyr) library(progressr) handlers(global = TRUE) my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(0.1) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # |==================== | 40% ``` _Note:_ This solution does not involved the `.progress = TRUE` argument that **plyr** implements. Because **progressr** is more flexible, and because `.progress` is automatically disabled when running in parallel (see below), I recommend to use the above **progressr** approach instead. Having said this, as proof-of-concept, the **progressr** package implements support `.progress = "progressr"` if you still prefer the **plyr** way of doing it. ## Parallel processing and progress updates The **[future]** framework, which provides a unified API for parallel and distributed processing in R, has built-in support for the kind of progression updates produced by the **progressr** package. This means that you can use it with for instance **[future.apply]**, **[furrr]**, and **[foreach]** with **[doFuture]**, and **[plyr]** or **[BiocParallel]** with **doFuture**. In contrast, _non-future_ parallelization methods such as **parallel**'s `mclapply()` and, `parallel::parLapply()`, and **foreach** adapters like **doParallel** do _not_ support progress reports via **progressr**. ### future_lapply() - parallel lapply() Here is an example that uses `future_lapply()` of the **[future.apply]** package to parallelize on the local machine while at the same time signaling progression updates: ```r library(future.apply) plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_lapply(xs, function(x, ...) { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` ### foreach() with doFuture Here is an example that uses `foreach()` of the **[foreach]** package to parallelize on the local machine (via **[doFuture]**) while at the same time signaling progression updates: ```r library(doFuture) registerDoFuture() ## %dopar% parallelizes via future plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- foreach(x = xs) %dopar% { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) } } my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` ### future_map() - parallel purrr::map() Here is an example that uses `future_map()` of the **[furrr]** package to parallelize on the local machine while at the same time signaling progression updates: ```r library(furrr) plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- future_map(xs, function(x) { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # / [================>-----------------------------] 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 supports certain future backends and produces errors on non-supported backends, I recommended to stop using `.progress = TRUE` and use the **progressr** package instead. ### BiocParallel::bplapply() - parallel lapply() Here is an example that uses `bplapply()` of the **[BiocParallel]** package to parallelize on the local machine while at the same time signaling progression updates: ```r library(BiocParallel) library(doFuture) register(DoparParam()) ## BiocParallel parallelizes via %dopar% registerDoFuture() ## %dopar% parallelizes via future plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- bplapply(xs, function(x) { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) }) } my_fcn(1:5) # / [================>-----------------------------] 40% x=2 ``` ### plyr::llply(..., .parallel = TRUE) with doFuture Here is an example that uses `llply()` of the **[plyr]** package to parallelize on the local machine while at the same time signaling progression updates: ```r library(plyr) library(doFuture) registerDoFuture() ## %dopar% parallelizes via future plan(multisession) library(progressr) handlers(global = TRUE) handlers("progress", "beepr") my_fcn <- function(xs) { p <- progressor(along = xs) y <- llply(xs, function(x, ...) { Sys.sleep(6.0-x) p(sprintf("x=%g", x)) sqrt(x) }, .parallel = TRUE) } my_fcn(1:5) # / [================>-----------------------------] 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. ### Near-live versus buffered progress updates with futures As of November 2020, there are four types of **future** backends that are known(*) to provide near-live progress updates: 1. `sequential`, 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 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. ## Note of caution - sending progress updates too frequently Signaling progress updates comes with some overhead. In situation where we use progress updates, this overhead is typically much smaller than the task we are processing in each step. However, if the task we iterate over is quick, then the extra time induced by the progress updates might end up dominating the overall processing time. If that is the case, a simple solution is to only signal progress updates every n:th step. Here is a version of `slow_sum()` that signals progress every 10:th iteration: ``` slow_sum <- function(x) { p <- progressr::progressor(length(x) / 10) sum <- 0 for (kk in seq_along(x)) { Sys.sleep(0.1) sum <- sum + x[kk] if (kk %% 10 == 0) p(message = sprintf("Added %g", x[kk])) } sum } ``` The overhead of progress signaling may depend on context. For example, in parallel processing with near-live progress updates via 'multisession' futures, each progress update is communicated via a socket connections back to the main R session. These connections might become clogged up if progress updates are too frequent. ## 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 **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, ```sh $ Rscript -e "library(progressr)" -e "with_progress(y <- slow_sum(1:10))" ``` will _not_ report on progress, whereas ```sh $ export R_PROGRESSR_ENABLE=TRUE $ Rscript -e "library(progressr)" -e "with_progress(y <- slow_sum(1:10))" ``` will. ## Roadmap 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: * [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)` * [ ] Make it possible to create a progressor also in the global environment (see 'Known issues' below) * [ ] Add support for nested progress updates * [ ] 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. Alternatively, create it 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. (\*) The `immediateCondition` class of conditions are relayed as soon as possible by the **[future]** framework, which means that progression updates produced in parallel workers are reported to the end user as soon as the main R session have received them. ![](imgs/slow_sum.svg) _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 To debug progress updates, use: ```r > handlers("debug") > 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} ``` [progressr]: https://cran.r-project.org/package=progressr [beepr]: https://cran.r-project.org/package=beepr [progress]: https://cran.r-project.org/package=progress [purrr]: https://cran.r-project.org/package=purrr [future]: https://cran.r-project.org/package=future [foreach]: https://cran.r-project.org/package=foreach [future.apply]: https://cran.r-project.org/package=future.apply [doParallel]: https://cran.r-project.org/package=doParallel [doFuture]: https://cran.r-project.org/package=doFuture [furrr]: https://cran.r-project.org/package=furrr [pbapply]: https://cran.r-project.org/package=pbapply [pbmcapply]: https://cran.r-project.org/package=pbmcapply [plyr]: https://cran.r-project.org/package=plyr [BiocParallel]: https://www.bioconductor.org/packages/BiocParallel/ progressr/inst/doc/progressr-intro.html0000644000175000017500000015404614157512125020236 0ustar nileshnilesh progressr: An Introduction

progressr: An Introduction

The progressr package provides a minimal API for reporting progress updates in R. The design is to separate the representation of progress updates from how they are presented. What type of progress to signal is controlled by the developer. How these progress updates are rendered is controlled by the end user. For instance, some users may prefer visual feedback such as a horizontal progress bar in the terminal, whereas others may prefer auditory feedback.

Three strokes writing three in Chinese

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 - One For Developers and One For End-Users

Developer'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
    
End-user's API

1a. Subscribe to progress updates from everywhere: 

handlers(global = TRUE)

y <- slow_sum(1:5)
y <- slow_sum(6:10)

1b. Subscribe to a specific expression: 

with_progress({
  y <- slow_sum(1:5)
  y <- slow_sum(6:10)
})

2. Configure how progress is presented: 

handlers("progress")
handlers("txtprogressbar", "beepr")
handlers(handler_pbcol(enable_after = 3.0))
handlers(handler_progress(complete = "#"))

A simple example

Assume that we have a function slow_sum() for adding up the values in a vector. It is so slow, that we like to provide progress updates to whoever might be interested in it. With the progressr package, this can be done as:

slow_sum <- function(x) {
  p <- progressr::progressor(along = x)
  sum <- 0
  for (kk in seq_along(x)) {
    Sys.sleep(0.1)
    sum <- sum + x[kk]
    p(message = sprintf("Added %g", x[kk]))
  }
  sum
}

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 on progress

When calling this function as in:

> y <- slow_sum(1:10)
> y
[1] 55
>

it will behave as any function and there will be no progress updates displayed.

Reporting on progress

If we are only interested in progress for a particular call, we can do:

> 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:

> library(progressr)
> handlers(global = TRUE)

so that progress updates are reported on wherever signaled, e.g.

> 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:

> handlers(global = FALSE)

In the below examples, we will assume handlers(global = TRUE) is already set.

Customizing how progress is reported

The default is to present progress via utils::txtProgressBar(), which is available on all R installations. To change the default, to, say, progress_bar() by the progress package, set:

handlers("progress")

This progress handler will present itself as:

> y <- slow_sum(1:10)
/ [================>--------------------------]  40% Added 4

To set the default progress handler, or handlers, in all your R sessions, call progressr::handlers(...) in your ~/.Rprofile file.

Auditory progress updates

Progress updates do not have to be presented visually. They can equally well be communicated via audio. For example, using:

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;

> y <- slow_sum(1:10)
> y
[1] 55
>

Concurrent auditory and visual progress updates

It is possible to have multiple progress handlers presenting progress updates at the same time. For example, to get both visual and auditory updates, use:

handlers("txtprogressbar", "beepr")

Silence all progress

To silence all progress updates, use:

handlers("void")

Further configuration of progress handlers

Above we have seen examples where the handlers() takes one or more strings as input, e.g. handlers(c("progress", "beepr")). This is short for a more flexible specification where we can pass a list of handler functions, e.g.

handlers(list(
  handler_progress(),
  handler_beepr()
))

With this construct, we can make adjustments to the default behavior of these progress handlers. For example, we can configure the format, width, and complete arguments of progress::progress_bar$new(), and tell beepr to use a different finish sound and generate sounds at most every two seconds by setting:

handlers(list(
  handler_progress(
    format   = ":spin :current/:total (:message) [:bar] :percent in :elapsed ETA: :eta",
    width    = 60,
    complete = "+"
  ),
  handler_beepr(
    finish   = "wilhelm",
    interval = 2.0
  )
))

Sticky messages

As seen above, some progress handlers present the progress message as part of its output, e.g. the "progress" handler will display the message as part of the progress bar. It is also possible to "push" the message up together with other terminal output. This can be done by adding class attribute "sticky" to the progression signaled. This works for several progress handlers that output to the terminal. For example, with:

slow_sum <- function(x) {
  p <- progressr::progressor(along = x)
  sum <- 0
  for (kk in seq_along(x)) {
    Sys.sleep(0.1)
    sum <- sum + x[kk]
    p(sprintf("Step %d", kk), class = if (kk %% 5 == 0) "sticky", amount = 0)
    p(message = sprintf("Added %g", x[kk]))
  }
  sum
}

we get

> handlers("txtprogressbar")
> y <- slow_sum(1:30)
Step 5
Step 10
  |====================                               |  43%

and

> handlers("progress")
> y <- slow_sum(1:30)
Step 5
Step 10
/ [===============>--------------------------]  43% Added 13

Use regular output as usual alongside progress updates

In contrast to other progress-bar frameworks, output from message(), cat(), print() and so on, will not interfere with progress reported via progressr. For example, say we have:

slow_sqrt <- function(xs) {
  p <- progressor(along = xs)
  lapply(xs, function(x) {
    message("Calculating the square root of ", x)
    Sys.sleep(2)
    p(sprintf("x=%g", x))
    sqrt(x)
  })
}

we will get:

> library(progressr)
> handlers(global = TRUE)
> handlers("progress")
> y <- slow_sqrt(1:8)
Calculating the square root of 1
Calculating the square root of 2
- [===========>-----------------------------------]  25% x=2

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.

Support for progressr elsewhere

Note that progression updates by progressr is designed to work out of the box for any iterator framework in R. Below is an set of examples for the most common ones.

Base R Apply Functions

library(progressr)
handlers(global = TRUE)

my_fcn <- function(xs) {
  p <- progressor(along = xs)
  y <- lapply(xs, function(x) {
    Sys.sleep(0.1)
    p(sprintf("x=%g", x))
    sqrt(x)
  })
}

my_fcn(1:5)
#  |====================                               |  40%

The foreach package

library(foreach)
library(progressr)
handlers(global = TRUE)

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%

The purrr package

library(purrr)
library(progressr)
handlers(global = TRUE)

my_fcn <- function(xs) {
  p <- progressor(along = xs)
  y <- map(xs, function(x) {
    Sys.sleep(0.1)
    p(sprintf("x=%g", x))
    sqrt(x)
  })
}

my_fcn(1:5)
#  |====================                               |  40%

The plyr package

library(plyr)
library(progressr)
handlers(global = TRUE)

my_fcn <- function(xs) {
  p <- progressor(along = xs)
  y <- llply(xs, function(x, ...) {
    Sys.sleep(0.1)
    p(sprintf("x=%g", x))
    sqrt(x)
  })
}

my_fcn(1:5)
#  |====================                               |  40%

Note: This solution does not involved the .progress = TRUE argument that plyr implements. Because progressr is more flexible, and because .progress is automatically disabled when running in parallel (see below), I recommend to use the above progressr approach instead. Having said this, as proof-of-concept, the progressr package implements support .progress = "progressr" if you still prefer the plyr way of doing it.

Parallel processing and progress updates

The future framework, which provides a unified API for parallel and distributed processing in R, has built-in support for the kind of progression updates produced by the progressr package. This means that you can use it with for instance future.apply, furrr, and foreach with doFuture, and plyr or BiocParallel with doFuture. In contrast, non-future parallelization methods such as parallel's mclapply() and, parallel::parLapply(), and foreach adapters like doParallel do not support progress reports via progressr.

future_lapply() - parallel lapply()

Here is an example that uses future_lapply() of the future.apply package to parallelize on the local machine while at the same time signaling progression updates:

library(future.apply)
plan(multisession)

library(progressr)
handlers(global = TRUE)
handlers("progress", "beepr")

my_fcn <- function(xs) {
  p <- progressor(along = xs)
  y <- future_lapply(xs, function(x, ...) {
    Sys.sleep(6.0-x)
    p(sprintf("x=%g", x))
    sqrt(x)
  })
}

my_fcn(1:5)
# / [================>-----------------------------]  40% x=2

foreach() with doFuture

Here is an example that uses foreach() of the foreach package to parallelize on the local machine (via doFuture) while at the same time signaling progression updates:

library(doFuture)
registerDoFuture()      ## %dopar% parallelizes via future
plan(multisession)

library(progressr)
handlers(global = TRUE)
handlers("progress", "beepr")

my_fcn <- function(xs) {
  p <- progressor(along = xs)
  y <- foreach(x = xs) %dopar% {
    Sys.sleep(6.0-x)
    p(sprintf("x=%g", x))
    sqrt(x)
  }
}

my_fcn(1:5)
# / [================>-----------------------------]  40% x=2

future_map() - parallel purrr::map()

Here is an example that uses future_map() of the furrr package to parallelize on the local machine while at the same time signaling progression updates:

library(furrr)
plan(multisession)

library(progressr)
handlers(global = TRUE)
handlers("progress", "beepr")

my_fcn <- function(xs) {
  p <- progressor(along = xs)
  y <- future_map(xs, function(x) {
    Sys.sleep(6.0-x)
    p(sprintf("x=%g", x))
    sqrt(x)
  })
}

my_fcn(1:5)
# / [================>-----------------------------]  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 supports certain future backends and produces errors on non-supported backends, I recommended to stop using .progress = TRUE and use the progressr package instead.

BiocParallel::bplapply() - parallel lapply()

Here is an example that uses bplapply() of the BiocParallel package to parallelize on the local machine while at the same time signaling progression updates:

library(BiocParallel)
library(doFuture)
register(DoparParam())  ## BiocParallel parallelizes via %dopar%
registerDoFuture()      ## %dopar% parallelizes via future
plan(multisession)

library(progressr)
handlers(global = TRUE)
handlers("progress", "beepr")

my_fcn <- function(xs) {
  p <- progressor(along = xs)
  y <- bplapply(xs, function(x) {
    Sys.sleep(6.0-x)
    p(sprintf("x=%g", x))
    sqrt(x)
  })
}

my_fcn(1:5)
# / [================>-----------------------------]  40% x=2

plyr::llply(..., .parallel = TRUE) with doFuture

Here is an example that uses llply() of the plyr package to parallelize on the local machine while at the same time signaling progression updates:

library(plyr)
library(doFuture)
registerDoFuture()      ## %dopar% parallelizes via future
plan(multisession)

library(progressr)
handlers(global = TRUE)
handlers("progress", "beepr")

my_fcn <- function(xs) {
  p <- progressor(along = xs)
  y <- llply(xs, function(x, ...) {
    Sys.sleep(6.0-x)
    p(sprintf("x=%g", x))
    sqrt(x)
  }, .parallel = TRUE)
}

my_fcn(1:5)
# / [================>-----------------------------]  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 https://github.com/HenrikBengtsson/progressr/issues/70 for details and a hack that works around this limitation.

Near-live versus buffered progress updates with futures

As of November 2020, there are four types of future backends that are known(*) to provide near-live progress updates:

  1. sequential,
  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 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.

Note of caution - sending progress updates too frequently

Signaling progress updates comes with some overhead. In situation where we use progress updates, this overhead is typically much smaller than the task we are processing in each step. However, if the task we iterate over is quick, then the extra time induced by the progress updates might end up dominating the overall processing time. If that is the case, a simple solution is to only signal progress updates every n:th step. Here is a version of slow_sum() that signals progress every 10:th iteration:

slow_sum <- function(x) {
  p <- progressr::progressor(length(x) / 10)
  sum <- 0
  for (kk in seq_along(x)) {
    Sys.sleep(0.1)
    sum <- sum + x[kk]
    if (kk %% 10 == 0) p(message = sprintf("Added %g", x[kk]))
  }
  sum
}

The overhead of progress signaling may depend on context. For example, in parallel processing with near-live progress updates via 'multisession' futures, each progress update is communicated via a socket connections back to the main R session. These connections might become clogged up if progress updates are too frequent.

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 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,

$ Rscript -e "library(progressr)" -e "with_progress(y <- slow_sum(1:10))"

will not report on progress, whereas

$ export R_PROGRESSR_ENABLE=TRUE
$ Rscript -e "library(progressr)" -e "with_progress(y <- slow_sum(1:10))"

will.

Roadmap

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:

  • [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)

  • [ ] Make it possible to create a progressor also in the global environment (see 'Known issues' below)

  • [ ] Add support for nested progress updates

  • [ ] 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 https://github.com/HenrikBengtsson/progressr/issues.

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:

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. Alternatively, create it 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:

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.

(*) The immediateCondition class of conditions are relayed as soon as possible by the future framework, which means that progression updates produced in parallel workers are reported to the end user as soon as the main R session have received them.

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

To debug progress updates, use:

> handlers("debug")
> 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}
progressr/NAMESPACE0000644000175000017500000000202514157511434013655 0ustar nileshnilesh# Generated by roxygen2: do not edit by hand S3method(conditionMessage,progression) S3method(print,progression) S3method(print,progression_handler) S3method(print,progressor) export(handler_ascii_alert) export(handler_beepr) export(handler_debug) export(handler_filesize) export(handler_newline) export(handler_notifier) export(handler_pbcol) export(handler_pbmcapply) export(handler_progress) export(handler_rstudio) export(handler_shiny) export(handler_tkprogressbar) export(handler_txtprogressbar) export(handler_void) export(handler_winprogressbar) export(handlers) export(make_progression_handler) export(progress) export(progress_aggregator) export(progress_progressr) export(progression) export(progressor) export(slow_sum) export(withProgressShiny) export(with_progress) export(without_progress) importFrom(digest,digest) importFrom(utils,capture.output) importFrom(utils,file_test) importFrom(utils,flush.console) importFrom(utils,object.size) importFrom(utils,setTxtProgressBar) importFrom(utils,str) importFrom(utils,txtProgressBar)