How to display a busy indicator in a shiny app?

Alternatively, you can use shinycssloaders package https://github.com/andrewsali/shinycssloaders

library(shiny)
library(dplyr)
library(shinycssloaders)

ui <- fluidPage(
  actionButton("plot","plot"),
  plotOutput("Test") %>% withSpinner(color="#0dc5c1")
)

server <- function(input, output, session) {

  data <- eventReactive(input$plot,{
    rnorm(1:100000)
  })

  output$Test <- renderPlot({
    plot(data())
  })

}

shinyApp(ui = ui, server = server)

enter image description here


Update 2018: Currently there is a great package to help you display loaders: shinycssloaders (source: https://github.com/andrewsali/shinycssloaders)

I've been looking for this as well. Most people suggest a conditional panel like so:

conditionalPanel(
            condition="!($('html').hasClass('shiny-busy'))",
            img(src="images/busy.gif")
)

You could always give yourself more control and create the conditional handling (maybe depending on more stuff) like this in your ui.R:

div(class = "busy",
    p("Calculation in progress.."),
    img(src="images/busy.gif")
)

where some JavaScript handles the showing and hiding of that div:

setInterval(function(){
  if ($('html').attr('class')=='shiny-busy') {
    $('div.busy').show()
  } else {
    $('div.busy').hide()
  }
},100)

with some extra css you could make sure your animated busy image gets a fixed postion where it will always be visible.

In any of the above cases i found that the "shiny-busy" condition is somewhat imprecise and unreliable: the div shows for a split second and disappears while computations are still going on... I found a dirty solution to fix that problem, at least in my apps. Feel free to try it out and maybe someone could give an insight to how and why this solves the issue.

In your server.R you'll need to add two reactiveValues:

shinyServer(function(input, output, session) {

    # Reactive Value to reset UI, see render functions for more documentation
    uiState <- reactiveValues()
    uiState$readyFlag <- 0
    uiState$readyCheck <- 0

then, in your renderPlot function (or other output function where computations go on), you use these reactive values to reset the function:

output$plot<- renderPlot({

    if (is.null(input$file)){
        return()
    }
    if(input$get == 0){
        return()
    }

    uiState$readyFlag

    # DIRTY HACK:
    # Everytime "Get Plot" is clicked we get into this function
    # In order for the ui to be able show the 'busy' indicator we
    # somehow need to abort this function and then of course seamlessly
    # call it again.
    # We do this by using a reactive value keeping track of the ui State:
    # renderPlot is depending on 'readyFlag': if that gets changed somehow
    # the reactive programming model will call renderPlot
    # If readyFlag equals readyCheck we exit the function (= ui reset) but in the
    # meantime we change the readyFlag, so the renderHeatMap function will 
    # immediatly be called again. At the end of the function we make sure 
    # readyCheck gets the same value so we are back to the original state

    isolate({
        if (uiState$readyFlag == uiState$readyCheck) {
            uiState$readyFlag <- uiState$readyFlag+1
            return(NULL)
        }
    })

    isolate({plot <- ...})

    # Here we make sure readyCheck equals readyFlag once again
    uiState$readyCheck <- uiState$readyFlag

    return(plot)
})

I found using fadeIn() as opposed to show() helps mitigate this blinking occurence:

setInterval(function(){
                     if ($('html').attr('class')=='shiny-busy') {
                          setTimeoutConst = setTimeout(function(){
                                $('#loading-page').fadeIn(500);
                             }, delay);
                      } else {
                          clearTimeout(setTimeoutConst );
                          $('#loading-page').hide();
                      }
              },10)

Using waiter

library(shiny)
library(waiter)

ui <- fluidPage(
  use_waiter(),
  actionButton("plot","plot"),
  plotOutput("Test")
)
server <- function(input, output, session) {
  w <- Waiter$new(id = "Test")

  data <- eventReactive(input$plot,{
    w$show()
    rnorm(1:100000)
  })

  output$Test <- renderPlot({
    plot(data())
  })
}
shinyApp(ui = ui, server = server)

waiter demo