shiny withprogress() for calculations outside of loops

[williaml]

Hi, I'm having trouble with shiny::withProgress(). I've only seen examples of it using loops. How would you use it with calculations?

For example this, where ideally it would update the progress bar when you move to the next list.

library(shiny)
library(tidyverse)

# test data ---------------------------------------------
# n <- 5e6
# fake_data <- tibble(y = n,
#                     x1 = sample(1L:200L, n, replace = TRUE),
#                     x2 = rnorm(n, 100, 5),
#                     x3 = sample(LETTERS, n, replace = TRUE)) %>%
#   arrange(x1) %>%
#   split(.$x1)

# write_rds(fake_data, "test_fake.rds")

fake_data <- read_rds("test_fake.rds")

# test function -------------------------------------------
sums <- function(df){

  df %>% 
    summarise(across(everything(), list(mean = mean, sd = sd)))
}

# app ui --------------------------------------------------
ui <- fluidPage(
  actionButton("button", "Go!"),
  tableOutput("table")
)

# app server -------------------------------------------
server <- function(input, output) {
  
  rv <- reactiveValues()
  
  observeEvent(input$button, {
    withProgress(
      message='Please wait',
      detail='Running calculations...',
      value = 0, {
        
        n <- length(fake_data)

        rv$df <-map_df(fake_data, ~sums(.x))

        incProgress(1/n, detail = paste("Finished section 2"))
      })
  })
  
  output$table <- renderTable({
    
    if(input$button == 0){
      NULL}
    else {
      rv$df
      }
    
  })
  
}

shinyApp(ui, server)

[nirgrahamuk]

I would probably do it by changing the sums function being tracked to take an increment as a parameter so it can update the progress when it completes.

sums <- function(df,prog){
  rval <- df %>% 
    summarise(across(everything(), list(mean = mean, sd = sd)))
  incProgress(prog)
  rval
}

then the calling portion becomes

  observeEvent(input$button, {
    withProgress(
      message='Please wait',
      detail='Running calculations...',
      value = 0, {
        
        n <- length(fake_data)
        
        rv$df <-map_df(fake_data, ~sums(.x,prog=1/n))

      })
  })

[williaml]

That's great. Thanks for the example.