Is it possible to have a loading bar or spinner with the real time that job takes to be run in shiny?

Question

I am interested in having a spinner or a loading bar in my Shiny app. I have found and I have tried these packages: shinycssloaders, waiter, shinycustomloader, shinybusy but the way that most of the people implement the spinners or loading bars is including 1) a for loop or 2) suspending the execution for a time interval (sys.sleep) for some seconds.

1)

 withProgress(message = 'Making plot', value = 0, {
      # Number of times we'll go through the loop
      n <- 10
      
      for (i in 1:n) {
        
        # Increment the progress bar, and update the detail text.
        incProgress(1/n, detail = paste("Loading", i*10, "%"))
        
        # Pause for 0.1 seconds to simulate a long computation.
        Sys.sleep(0.5)
      }
      
    v$plot <- myplot()

Sys.sleep(3) 

plot()

However, the way that it is being executed is: first it spends some time to execute the for loop or the sys.sleep (with the time that you have decided or the number of items that you want to put in the loop) and LATER, it shows the plot (and the plot it will take the time that it needs to show it).

I have been trying to find (with no success) if there is a way to do the same thing but instead of putting/selecting a specific time, using the amount of time that the plot/table is going to spend to be shown.

Does anyone know if this is possible with Shiny?

Just in case someone wants one example to work with, here it is one (although it is pretty fast, because it doesn't use an huge dataframe. The idea is that the plot will take more time to be shown).

library(shiny)
library(magrittr)
library(DT)
library(shinybusy)
library(ggplot2)

new_choices <- setNames(names(mtcars), names(mtcars))


ui <- fluidPage(
  
  # Application title
  titlePanel("Shiny app"),
  
  sidebarLayout(
    sidebarPanel(
      
      tabsetPanel(
          tabPanel("Selection",
                  selectInput("x_axis", "Choose x axis",
                            choices = new_choices),
                  
                  selectInput("y_axis", "Choose y axis",
                              choices = new_choices),
               
                  hr(),
                ),
                  
          tabPanel("Titles",
                    hr(),
              
                    textInput(inputId = "title", "You can write the title:",  value = "This is the title"),
                    textInput(inputId = "xlab", "You can re-name the x-axis:",  value = "x-axis...."),
                    textInput(inputId = "ylab", "You can re-name the y-axis:",  value = "y-axis ...."),
          
                  ),
      
      
          tabPanel("Calculations", 
                    hr(),
                    
                    checkboxInput("log2", "Do the log2 transformation", value = F),
                    checkboxInput("sqrt", "Calculate the square root", value = F),
                   
                   )

          ),
      actionButton(inputId = "drawplot", label = "Show the plot")
    
      ),
              
              mainPanel(
                plotOutput("plot"),
              )
      )
    )


server <- function(input, output, session) {
  
  data <- reactive({
    mtcars
  })
  
  
  filtered_data <- reactive({
    data <- data()
    if(input$log2 == TRUE){
      data <- log2(data+1)
    }
    if(input$sqrt == TRUE){
      data <- sqrt(data)
    }
    return(data)
    
  })
  
  
  v <- reactiveValues()
  observeEvent(input$drawplot, {
    
    v$plot <- ggplot() +
      geom_point(data = filtered_data(),
                 aes_string(x = input$x_axis, y = input$y_axis)) +
      xlab(input$xlab) +
      ylab(input$ylab) +
      ggtitle(input$title)
    
  })
  

  output$plot <- renderPlot({
    if (is.null(v$plot)) return()
    v$plot
  })
  
  
}

shinyApp(ui, server)

Thanks very much in advance

Regards

Answer 1

Most of these packages don't need to pre calculate the time it is going to take for spinner to run.

Here is an example with shinycssloaders.

library(shiny)
library(DT)
library(ggplot2)

new_choices <- setNames(names(mtcars), names(mtcars))

ui <- fluidPage(
  
  # Application title
  titlePanel("Shiny app"),
  
  sidebarLayout(
    sidebarPanel(
      
      tabsetPanel(
        tabPanel("Selection",
                 selectInput("x_axis", "Choose x axis",
                             choices = new_choices),
                 
                 selectInput("y_axis", "Choose y axis",
                             choices = new_choices),
                 
                 hr(),
        ),
        
        tabPanel("Titles",
                 hr(),
                 
                 textInput(inputId = "title", "You can write the title:",  value = "This is the title"),
                 textInput(inputId = "xlab", "You can re-name the x-axis:",  value = "x-axis...."),
                 textInput(inputId = "ylab", "You can re-name the y-axis:",  value = "y-axis ...."),
                 
        ),
        
        
        tabPanel("Calculations", 
                 hr(),
                 
                 checkboxInput("log2", "Do the log2 transformation", value = F),
                 checkboxInput("sqrt", "Calculate the square root", value = F),
                 
        )
        
      ),
      actionButton(inputId = "drawplot", label = "Show the plot")
      
    ),
    
    mainPanel(
      shinycssloaders::withSpinner(plotOutput("plot")),
    )
  )
)


server <- function(input, output, session) {
  
  data <- reactive({
    mtcars
  })
  
  
  filtered_data <- reactive({
    data <- data()
    if(input$log2){
      data <- log2(data+1)
    }
    if(input$sqrt){
      data <- sqrt(data)
    }
    return(data)
    
  })
  
  
  v <- reactiveValues()
  observeEvent(input$drawplot, {
    
    v$plot <- ggplot() +
      geom_point(data = filtered_data(),
                 aes_string(x = input$x_axis, y = input$y_axis)) +
      xlab(input$xlab) +
      ylab(input$ylab) +
      ggtitle(input$title)
    
  })
  
  
  output$plot <- renderPlot({
    if (is.null(v$plot)) return()
    v$plot
  })
  
  
}

shinyApp(ui, server)