How to display a busy indicator in a shiny app?

Question

Note : I have read almost all the discussions on this object in shiny googlegroups and here in SO.

I need an indicator that shows the shiny server is busy. I have tried shiny incubator, however, the problem is that I can't set a max for progress bar. I don't want something like this : https://shiny.rstudio.com/gallery/progress-bar-example.html What I need is something that: 1- shows a busy indicator message and bar (i.e just a simple animated bar, do not need to show a filling bar) as long as the server is calculating 2- it is shown in no matter which tab you are viewing. (not only in the related tab, but on top of the tabset)

Solution 1

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)
})

Solution 2

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)

Solution 3

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)

Solution 4

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)

Solution 5

The busy div also appears for split seconds for the latest versions of shiny, even though no apparent calculations are going on (it was not an issue in older versions). Shiny seems to be regularly in its busy-mode for a short time. As a solution (complementing the above discussion), one can include another 2nd delayed validation of the shiny-busy html class for the conditional handling. The JavaScript-part would look something like that (example also includes check for two different div.busy-states depending on the reactive textit):

      if( ($('html').attr('class')=='shiny-busy') ){
                setTimeout(function() {
                if ($('html').attr('class')=='shiny-busy') {
                    if($('#textit').html()!='Waiting...' ){
                        $('div.busy1').show()
                    }
                    if($('#textit').html()=='Waiting...'){
                        $('div.busy2').show()
                    }
                }   
                },1000) 
              } else {
                $('div.busy1').hide()
                $('div.busy2').hide()
              }
            },100)  

View more solutions

Comments

[Kate]

Also, if you don't have dplyr loaded for the pipe %>%, you can use withSpinner(plotOutput("Test"))

[Simon Woodward]

This won't work with a proxy update I think, only on the initial ui render?