#' Reporting progress (object-oriented API) #' #' Reports progress to the user during long-running operations. #' #' This package exposes two distinct programming APIs for working with #' progress. \code{\link{withProgress}} and \code{\link{setProgress}} #' together provide a simple function-based interface, while the #' \code{Progress} reference class provides an object-oriented API. #' #' Instantiating a \code{Progress} object causes a progress panel to be #' created, and it will be displayed the first time the \code{set} #' method is called. Calling \code{close} will cause the progress panel #' to be removed. #' #' As of version 0.14, the progress indicators use Shiny's new notification API. #' If you want to use the old styling (for example, you may have used customized #' CSS), you can use \code{style="old"} each time you call #' \code{Progress$new()}. If you don't want to set the style each time #' \code{Progress$new} is called, you can instead call #' \code{\link{shinyOptions}(progress.style="old")} just once, inside the server #' function. #' #' \strong{Methods} #' \describe{ #' \item{\code{initialize(session, min = 0, max = 1)}}{ #' Creates a new progress panel (but does not display it). #' } #' \item{\code{set(value = NULL, message = NULL, detail = NULL)}}{ #' Updates the progress panel. When called the first time, the #' progress panel is displayed. #' } #' \item{\code{inc(amount = 0.1, message = NULL, detail = NULL)}}{ #' Like \code{set}, this updates the progress panel. The difference is #' that \code{inc} increases the progress bar by \code{amount}, instead #' of setting it to a specific value. #' } #' \item{\code{close()}}{ #' Removes the progress panel. Future calls to \code{set} and #' \code{close} will be ignored. #' } #' } #' #' @param session The Shiny session object, as provided by #' \code{shinyServer} to the server function. #' @param min The value that represents the starting point of the #' progress bar. Must be less tham \code{max}. #' @param max The value that represents the end of the progress bar. #' Must be greater than \code{min}. #' @param message A single-element character vector; the message to be #' displayed to the user, or \code{NULL} to hide the current message #' (if any). #' @param detail A single-element character vector; the detail message #' to be displayed to the user, or \code{NULL} to hide the current #' detail message (if any). The detail message will be shown with a #' de-emphasized appearance relative to \code{message}. #' @param value A numeric value at which to set #' the progress bar, relative to \code{min} and \code{max}. #' \code{NULL} hides the progress bar, if it is currently visible. #' @param style Progress display style. If \code{"notification"} (the default), #' the progress indicator will show using Shiny's notification API. If #' \code{"old"}, use the same HTML and CSS used in Shiny 0.13.2 and below #' (this is for backward-compatibility). #' @param amount Single-element numeric vector; the value at which to set #' the progress bar, relative to \code{min} and \code{max}. #' \code{NULL} hides the progress bar, if it is currently visible. #' @param amount For the \code{inc()} method, a numeric value to increment the #' progress bar. #' #' @examples #' ## Only run examples in interactive R sessions #' if (interactive()) { #' #' ui <- fluidPage( #' plotOutput("plot") #' ) #' #' server <- function(input, output, session) { #' output$plot <- renderPlot({ #' progress <- Progress$new(session, min=1, max=15) #' on.exit(progress$close()) #' #' progress$set(message = 'Calculation in progress', #' detail = 'This may take a while...') #' #' for (i in 1:15) { #' progress$set(value = i) #' Sys.sleep(0.5) #' } #' plot(cars) #' }) #' } #' #' shinyApp(ui, server) #' } #' @seealso \code{\link{withProgress}} #' @format NULL #' @usage NULL #' @export Progress <- R6Class( 'Progress', portable = TRUE, public = list( initialize = function(session = getDefaultReactiveDomain(), min = 0, max = 1, style = getShinyOption("progress.style", default = "notification")) { if (is.null(session$progressStack)) stop("'session' is not a ShinySession object.") private$session <- session private$id <- createUniqueId(8) private$min <- min private$max <- max private$style <- match.arg(style, choices = c("notification", "old")) private$value <- NULL private$closed <- FALSE session$sendProgress('open', list(id = private$id, style = private$style)) }, set = function(value = NULL, message = NULL, detail = NULL) { if (private$closed) { warning("Attempting to set progress, but progress already closed.") return() } if (is.null(value) || is.na(value)) { value <- NULL } else { # Normalize value to number between 0 and 1 value <- min(1, max(0, (value - private$min) / (private$max - private$min))) } private$value <- value data <- dropNulls(list( id = private$id, message = message, detail = detail, value = value, style = private$style )) private$session$sendProgress('update', data) }, inc = function(amount = 0.1, message = NULL, detail = NULL) { value <- min(self$getValue() + amount, private$max) self$set(value, message, detail) }, getMin = function() private$min, getMax = function() private$max, # Return value (not the normalized 0-1 value, but in the original range) getValue = function() { private$value * (private$max - private$min) + private$min }, close = function() { if (private$closed) { warning("Attempting to close progress, but progress already closed.") return() } private$session$sendProgress('close', list(id = private$id, style = private$style) ) private$closed <- TRUE } ), private = list( session = 'environment', id = character(0), min = numeric(0), max = numeric(0), style = character(0), value = NULL, closed = logical(0) ) ) #' Reporting progress (functional API) #' #' Reports progress to the user during long-running operations. #' #' This package exposes two distinct programming APIs for working with progress. #' Using \code{withProgress} with \code{incProgress} or \code{setProgress} #' provide a simple function-based interface, while the \code{\link{Progress}} #' reference class provides an object-oriented API. #' #' Use \code{withProgress} to wrap the scope of your work; doing so will cause a #' new progress panel to be created, and it will be displayed the first time #' \code{incProgress} or \code{setProgress} are called. When \code{withProgress} #' exits, the corresponding progress panel will be removed. #' #' The \code{incProgress} function increments the status bar by a specified #' amount, whereas the \code{setProgress} function sets it to a specific value, #' and can also set the text displayed. #' #' Generally, \code{withProgress}/\code{incProgress}/\code{setProgress} should #' be sufficient; the exception is if the work to be done is asynchronous (this #' is not common) or otherwise cannot be encapsulated by a single scope. In that #' case, you can use the \code{Progress} reference class. #' #' As of version 0.14, the progress indicators use Shiny's new notification API. #' If you want to use the old styling (for example, you may have used customized #' CSS), you can use \code{style="old"} each time you call #' \code{withProgress()}. If you don't want to set the style each time #' \code{withProgress} is called, you can instead call #' \code{\link{shinyOptions}(progress.style="old")} just once, inside the server #' function. #' #' @param session The Shiny session object, as provided by \code{shinyServer} to #' the server function. The default is to automatically find the session by #' using the current reactive domain. #' @param expr The work to be done. This expression should contain calls to #' \code{setProgress}. #' @param min The value that represents the starting point of the progress bar. #' Must be less tham \code{max}. Default is 0. #' @param max The value that represents the end of the progress bar. Must be #' greater than \code{min}. Default is 1. #' @param amount For \code{incProgress}, the amount to increment the status bar. #' Default is 0.1. #' @param env The environment in which \code{expr} should be evaluated. #' @param quoted Whether \code{expr} is a quoted expression (this is not #' common). #' @param message A single-element character vector; the message to be displayed #' to the user, or \code{NULL} to hide the current message (if any). #' @param detail A single-element character vector; the detail message to be #' displayed to the user, or \code{NULL} to hide the current detail message #' (if any). The detail message will be shown with a de-emphasized appearance #' relative to \code{message}. #' @param style Progress display style. If \code{"notification"} (the default), #' the progress indicator will show using Shiny's notification API. If #' \code{"old"}, use the same HTML and CSS used in Shiny 0.13.2 and below #' (this is for backward-compatibility). #' @param value Single-element numeric vector; the value at which to set the #' progress bar, relative to \code{min} and \code{max}. \code{NULL} hides the #' progress bar, if it is currently visible. #' #' @examples #' ## Only run examples in interactive R sessions #' if (interactive()) { #' #' ui <- fluidPage( #' plotOutput("plot") #' ) #' #' server <- function(input, output) { #' output$plot <- renderPlot({ #' withProgress(message = 'Calculation in progress', #' detail = 'This may take a while...', value = 0, { #' for (i in 1:15) { #' incProgress(1/15) #' Sys.sleep(0.25) #' } #' }) #' plot(cars) #' }) #' } #' #' shinyApp(ui, server) #' } #' @seealso \code{\link{Progress}} #' @rdname withProgress #' @export withProgress <- function(expr, min = 0, max = 1, value = min + (max - min) * 0.1, message = NULL, detail = NULL, style = getShinyOption("progress.style", default = "notification"), session = getDefaultReactiveDomain(), env = parent.frame(), quoted = FALSE) { if (!quoted) expr <- substitute(expr) if (is.null(session$progressStack)) stop("'session' is not a ShinySession object.") style <- match.arg(style, c("notification", "old")) p <- Progress$new(session, min = min, max = max, style = style) session$progressStack$push(p) on.exit({ session$progressStack$pop() p$close() }) p$set(value, message, detail) eval(expr, env) } #' @rdname withProgress #' @export setProgress <- function(value = NULL, message = NULL, detail = NULL, session = getDefaultReactiveDomain()) { if (is.null(session$progressStack)) stop("'session' is not a ShinySession object.") if (session$progressStack$size() == 0) { warning('setProgress was called outside of withProgress; ignoring') return() } session$progressStack$peek()$set(value, message, detail) invisible() } #' @rdname withProgress #' @export incProgress <- function(amount = 0.1, message = NULL, detail = NULL, session = getDefaultReactiveDomain()) { if (is.null(session$progressStack)) stop("'session' is not a ShinySession object.") if (session$progressStack$size() == 0) { warning('incProgress was called outside of withProgress; ignoring') return() } p <- session$progressStack$peek() p$inc(amount, message, detail) invisible() }