Progress Bar in R Shiny within an eventReactive call

Question

I'm using an eventReactive call in my Shiny app to do calculations, varying from 10 to 10000 seconds. I would like to show to my users how far we are in the loop. I can't use the example provided by shiny since I need to store a couple of objects from the eventReactive call. I have provided a simplified example where a sort of 'progress bar' is produced on the R Console, but I don't know how to get something similar in Shiny. Please be aware that I need to use the dat1,dat2 and dat3 in plots later on. The code:

# This function computes a new data set. It can optionally take a function,
# updateProgress, which will be called as each row of data is added.
compute_data <- function(updateProgress = NULL) {
  # Create 0-row data frame which will be used to store data
  dat <- data.frame(x = numeric(0), y = numeric(0))

  for (i in 1:10) {
    Sys.sleep(0.25)

    # Compute new row of data
    new_row <- data.frame(x = rnorm(1), y = rnorm(1))

    # If we were passed a progress update function, call it
    if (is.function(updateProgress)) {
      text <- paste0("x:", round(new_row$x, 2), " y:", round(new_row$y, 2))
      updateProgress(detail = text)
    }

    # Add the new row of data
    dat <- rbind(dat, new_row)
  }

  dat
}


server <- function(input, output) {
  output$table <- renderTable({
    input$goTable

    # Create a Progress object
    progress <- shiny::Progress$new()
    progress$set(message = "Computing data", value = 0)
    # Close the progress when this reactive exits (even if there's an error)
    on.exit(progress$close())

    # Create a callback function to update progress.
    # Each time this is called:
    # - If `value` is NULL, it will move the progress bar 1/5 of the remaining
    #   distance. If non-NULL, it will set the progress to that value.
    # - It also accepts optional detail text.
    updateProgress <- function(value = NULL, detail = NULL) {
      if (is.null(value)) {
        value <- progress$getValue()
        value <- value + (progress$getMax() - value) / 5
      }
      progress$set(value = value, detail = detail)
    }

    # Compute the new data, and pass in the updateProgress function so
    # that it can update the progress indicator.
    compute_data(updateProgress)
  })


  Test <- eventReactive(input$goTable,{
    n <- 10
    dat1 <- data.frame(x = numeric(0), y = numeric(0))
    dat2 <- data.frame(x = numeric(0), y = numeric(0))
    dat3 <- data.frame(x = numeric(0), y = numeric(0))
    for (i in 1:n) {
      print(paste0(i*10,"%"))
      # Each time through the loop, add another row of data. This is
      # a stand-in for a long-running computation.
      dat1 <- rbind(dat1, data.frame(x = rnorm(1), y = rnorm(1)))
      dat2 <- rbind(dat2, data.frame(x = rnorm(1), y = rnorm(1)))
      dat3 <- rbind(dat3, data.frame(x = rnorm(1), y = rnorm(1)))


      # Increment the progress bar, and update the detail text.
      #incProgress(1/n, detail = paste("Doing part", i))

      # Pause for 0.1 seconds to simulate a long computation.
      Sys.sleep(0.5)

    }
    list(dat1,dat2,dat3)

  }) 

  output$table1 <- renderTable({Test()[[1]]})
  output$table2 <- renderTable({Test()[[2]]})
  output$table3 <- renderTable({Test()[[3]]})




}

ui <- shinyUI(basicPage(
  #tableOutput('table1'),
  actionButton('goTable', 'Start Computing..'),
  tableOutput('table1'),
  tableOutput('table2'),
  tableOutput('table3')
))

shinyApp(ui = ui, server = server)

Any help is much appreciated.

Answer 1

Seems to work with the pop-up progress bar function inside your eventReactive call:

for (i in 1:100) {
  Sys.sleep(.05)
  info <- sprintf("%d%% done", round((i/100)*100))
setWinProgressBar(pb, i/(100)*100, label=info)

}; close(pb)