Parallel + Progress Bars

[ajaypillarisetti]

First: thanks, as always, for the excellent work and for folks' time in advance. I've got a few apps that have used progress bars for fairly large computations (MC simulations of emissions related to simple combustion devices). These progress bars worked until recently using parallel ldply. Below is a basic example adapted from the Progress documentation that works:

library(shiny)
library(parallel)

## 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)
    on.exit(progress$close())

    progress$set(message = 'Calculation in progress.')

    mclapply(1:5000, function(x){
        progress$inc(1/5000, detail = paste('Computating...'))
    }, mc.cores=1)

    plot(cars)
  })
}

shinyApp(ui, server)
}

Anything over 1 core, however, fails:

library(shiny)
library(parallel)

## 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)
    on.exit(progress$close())

    progress$set(message = 'Calculation in progress.')

    mclapply(1:5000, function(x){
        progress$inc(1/5000, detail = paste('Computating...'))
    }, mc.cores=4)

    plot(cars)
  })
}

shinyApp(ui, server)
}

This is the same behavior I'm seeing in my app. Any ideas? I can guess that drawing progress bars during parallel processes is a bit fraught. Thanks!

[vj-09]

same issue here.

[ghost]

Facing the same problem. Appreciate if this can be addressed earliest possible

[jcheng5]

I'm surprised anything like this would ever work? The default progress bar in Shiny is implemented in memory, and mclapply launches tasks in sub-processes. If anyone can reproduce something like this working in a previous version of Shiny I'd be very interested to see it.

You might have better luck with the ipc package: https://github.com/fellstat/ipc I'm uncertain if it could work with mclapply but it'd be a more promising avenue to pursue than Shiny's own progress bars.

[schloerke]

Rule to follow: session (or any reactive value) will not work as expected when executed in a different R session.

Given this, mclapply will not support progress bars as it will block the main R session until computation is complete. Blocking the main R session is bad for concurrent Shiny users as a single user can block the whole R session.

I've updated the app by adding a progress bar to allow for the plot to restart calculations.

Notes:

• I did not use any promise pipes (%...>%) and have explicitly used the promises functions directly to avoid confusion around what is a promise and what is not.
• promises::finally() does not operate on the resolved promise value but will pass the resolved value through. If you want access to the previous value, use promises::then or promises::catch for your appropriate situation.
• Docs on using promises with Shiny: https://rstudio.github.io/promises/articles/shiny.html
• Docs on promises::future_promise(): https://rstudio.github.io/promises/articles/future_promise.html

App:

library(shiny)
library(future)
# Use `promises::future_promise()` to allow other shiny users to be able to compute.
# Recommended to always use `promises::future_promise()` instead of `future::future()`
library(promises)
# Pick a plan that makes sense for your use case.
# For this example, using `multisession` and max workers = 3
future::plan("multisession", workers = 3)

ui <- fluidPage(
  sliderInput("slider", "Number of items", min = 100, max = 500, value = 250),
  plotOutput("plot")
)

server <- function(input, output, session) {
  output$plot <- renderPlot({
    req(input$slider)

    progress <- Progress$new(session)

    progress$set(message = 'Calculation in progress.')

    # Retrieve `input$slider` outside of `future`
    n <- input$slider
    seq_len(n) %>%
      lapply(function(i) {
        promises::future_promise({
          # Do heavy computations in a `future` worker
          data.frame(i = i, pid = Sys.getpid())
        }) %>%
          promises::finally(function() {
            # Update progress bar in the main R session
            progress$inc(1/n, detail = paste('Computating...', i))
          })
      }) %>%
      # Wait for all promises to finish. Return single promise.
      promises::promise_all(.list = .) %>%
      promises::then(function(results) {
        # Extract result and plot in main R session
        plot(do.call(rbind, results))
      }) %>% promises::finally(function() {
        # Close the progress bar.
        # (An `on.exit()` would occur too early)
        progress$close()
      })
  })
}

shinyApp(ui, server)

Screen cap:

While the computation appears to start slow, future_promise() is greedily prepping the data for 250 calls to future. If future_promise() was not used, this same prep work would be spread out and executed immediately before each future call.