shiny loading bar for htmlwidgets

Question

In R/Shiny, I am making some quite detailed htmlwidgets to go into a shiny app through a variety of packages, and can often take a long time to render.

I would like to create a loading bar or use a loading gif to let the user know that it is loading...and to be patient while it loads.

Below is an example of using the dygraphs package that takes quite a while to load once you start including more and more data, i.e. shift the slider higher and higher...and loading times take longer and longer...

I am unsure how to incorporate the progress indicator (http://shiny.rstudio.com/articles/progress.html) into this...but am open to other suggestions on demonstrating the loading indicator...

# load libraries
require(dygraphs)
require(shiny)
require(xts)

# create a simple app
runApp(list(
  ui = bootstrapPage(
    sliderInput('n', '10 to the power x', min=2,max=7,value=2),
    dygraphOutput('plot1')
  ),
  server = function(input, output) {
    output$plot1 <- renderDygraph({
      v <- 10^(input$n)
      out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>% 
        dyRangeSelector()
      return(out)
    })
  }
))

* EDIT *

I attempted the below based on suggestions from @Carl in his comments....but it didn't seem to work...please see the below...

# load libraries
require(dygraphs)
require(shiny)
require(shinydashboard)
require(xts)

# create a simple app
ui <- dashboardPage(title='Loading graphs',
              dashboardHeader(
                title = 'Loading Graphs'
              ),
              dashboardSidebar(
                sliderInput('n', '10 to the power x', min=2,max=7,value=2)
              ),
              dashboardBody(
                tags$head(tags$style(type="text/css", "
             #loadmessage {
               position: fixed;
               top: 0px;
               left: 0px;
               width: 100%;
               padding: 5px 0px 5px 0px;
               text-align: center;
               font-weight: bold;
               font-size: 100%;
               color: #000000;
               background-color: #CCFF66;
               z-index: 105;
             }
          ")),
                dygraphOutput('plot1'),
                conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                                 tags$div("Loading...",id="loadmessage"))
              )
)
server <- function(input, output) {
  output$plot1 <- renderDygraph({
    v <- 10^(input$n)
    out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>% 
      dyRangeSelector()
    return(out)
  })
}

shinyApp(ui=ui,server=server)

Neither did the following:

# load libraries
require(dygraphs)
require(shiny)
require(shinydashboard)
require(xts)

# create a simple app
ui <- dashboardPage(title='Loading graphs',
              dashboardHeader(
                title = 'Loading Graphs'
              ),
              dashboardSidebar(
                sliderInput('n', '10 to the power x', min=2,max=7,value=2)
              ),
              dashboardBody(
                tags$head(tags$style(HTML("
.progress-striped .bar {
  background-color: #149bdf;
  background-image: -webkit-gradient(linear, 0 100%, 100% 0, color-stop(0.25, rgba(255, 255, 255, 0.6)), color-stop(0.25, transparent), color-stop(0.5, transparent), color-stop(0.5, rgba(255, 255, 255, 0.6)), color-stop(0.75, rgba(255, 255, 255, 0.6)), color-stop(0.75, transparent), to(transparent));
  background-image: -webkit-linear-gradient(45deg, rgba(255, 255, 255, 0.6) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.6) 50%, rgba(255, 255, 255, 0.6) 75%, transparent 75%, transparent);
  background-image: -moz-linear-gradient(45deg, rgba(255, 255, 255, 0.6) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.6) 50%, rgba(255, 255, 255, 0.6) 75%, transparent 75%, transparent);
  background-image: -o-linear-gradient(45deg, rgba(255, 255, 255, 0.6) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.6) 50%, rgba(255, 255, 255, 0.6) 75%, transparent 75%, transparent);
  background-image: linear-gradient(45deg, rgba(255, 255, 255, 0.6) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.6) 50%, rgba(255, 255, 255, 0.6) 75%, transparent 75%, transparent);
  -webkit-background-size: 40px 40px;
     -moz-background-size: 40px 40px;
       -o-background-size: 40px 40px;
          background-size: 40px 40px;
}"))),
                dygraphOutput('plot1')

              )
)

server <- function(input, output) {
  output$plot1 <- renderDygraph({
    v <- 10^(input$n)
    withProgress(message = 'Making plot', value = 1, {
      out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>% 
        dyRangeSelector()
    })
    return(out)
  })
}

shinyApp(ui=ui,server=server)

* EDIT2 *

could something like the solution to this question be used?

How to display busy image when actual image is loading in client machine

This what you are looking for? http://stackoverflow.com/questions/17325521/r-shiny-display-loading-message-while-function-is-running — Carl, Jul 12 '16 at 22:08
Thanks for the suggestions, have edited the question to show what I attempted, but it doesn't look like its working... — h.l.m, Jul 13 '16 at 15:24
I'm guessing `shinydashboard` uses a differently named classes than base `shiny` so instead of `shiny-busy` it's probably something else like `shinydashboard-busy` but I could be wrong — Carl, Jul 13 '16 at 15:49
After looking at the source code it looks like `shinydashboard` doesn't have a HTML "busy" class so you'll need a different approach. Perhaps something with `shinyjs` is the way to go: https://github.com/daattali/shinyjs#usage-dashboard — Carl, Jul 13 '16 at 16:12
If you provide a working example as an answer, I would be more than happy to have a look.... — h.l.m, Jul 14 '16 at 08:56

Victorp · Answer 1 · 2016-07-20T08:15:40.310

Hi you can use JavaScript Events in Shiny with events shiny:busy and shiny:idle, but maybe there's a better way... Try :

# load libraries
require(dygraphs)
require(shiny)
require(shinydashboard)
require(xts)

# create a simple app
ui <- dashboardPage(
  title = 'Loading graphs',
  dashboardHeader(title = 'Loading Graphs'),
  dashboardSidebar(sliderInput(
    'n',
    '10 to the power x',
    min = 2,
    max = 7,
    value = 2
  )),
  dashboardBody(
    tags$head(
      tags$style(
        type = "text/css",
        "
        #loadmessage {
        position: fixed;
        top: 70px;
        left: 0px;
        width: 100%;
        padding: 5px 0px 5px 0px;
        text-align: center;
        font-weight: bold;
        font-size: 100%;
        color: #000000;
        background-color: #CCFF66;
        z-index: 105;
        }
        "
      )
      ),
    dygraphOutput('plot1'),
    # conditionalPanel(condition="$('html').hasClass('shiny-busy')",
    #                  tags$div("Loading...",id="loadmessage"))
    tags$div("Loading...", id = "loadmessage"),
    tags$script(
      HTML(
        "$(document).on('shiny:busy', function(event) {
          $('#loadmessage').css('display', 'inline');
        });
        $(document).on('shiny:idle', function(event) {
          $('#loadmessage').css('display', 'none');
        });
        "
      )
    )
  )
)
server <- function(input, output) {
  output$plot1 <- renderDygraph({
    v <- 10 ^ (input$n)
    Sys.sleep(2)
    out <- dygraph(xts(rnorm(v), Sys.time() + seq(v))) %>%
      dyRangeSelector()
    return(out)
  })
}

shinyApp(ui = ui, server = server)

Just tried coping and pasting this into the console in RStudio, and I don't this the loading message is working. — h.l.m, Jul 20 '16 at 07:57
Which version of `shiny` do you use ? Mine is `0.13.2`. You can put `Sys.sleep(2)` in `renderDygraph` to be sure to see the loading message — Victorp, Jul 20 '16 at 08:15
Hi yes I am on 0.13.2, as well...so using your updated code that has a `Sys.sleep(2)` in it and i can see the loading message, but when the slider is moved to 4 or higher there is still a long lag that doesn't show the loading message — h.l.m, Jul 20 '16 at 12:17
I think it's because `shiny` is no longer busy but however the browser is still busy to render the dygraph and display the curve.. — Victorp, Jul 20 '16 at 12:21
Thank you for that information, do you have any suggestion of how to show a loading sign until the browser is ready to display the dygraph? — h.l.m, Jul 20 '16 at 12:25

Sumedh · Accepted Answer · 2016-07-21T13:27:17.957

One of the ways to do it using the first linked post: (As mentioned earlier, this still has a large lag time):

 require(dygraphs)
 require(shiny)
 require(xts)

 runApp(list(
     ui = bootstrapPage(
         sliderInput('n', '10 to the power x', min=2,max=7,value=2),
         dygraphOutput('plot1')
     ),
     server = function(input, output) {
         output$plot1 <- renderDygraph({

             progress <- shiny::Progress$new()
             on.exit(progress$close())

             progress$set(message = 'Generating plot')

             v <- 10^(input$n)
             out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>%
                 dyRangeSelector()


             return(out)
         })
     }
 ))

I have been trying to figure this out for quite sometime now, since I have a similar problem. For this particular case, I think it takes around ~7-8 secs for the graph to render and about 20 secs (when slider is 6) for graph to display on the browser (or whatever is causing the delay after the graph is generated). You can add a for loop along with Sys.sleep after the plot command to confirm this.

We can also include a progressing indicator bar (like here), this can be accomplished with the for loop, but this will also delay the display of the plot.

 require(dygraphs)
 require(shiny)
 require(xts)

 runApp(list(
     ui = bootstrapPage(
         sliderInput('n', '10 to the power x', min=2,max=7,value=2),
         dygraphOutput('plot1')
     ),
     server = function(input, output, session) {
         output$plot1 <- renderDygraph({

             n1 <- input$n
             n2 <- ifelse(n1 < 5, n1, ifelse(n1 < 6, n1*5, n1*10))

             progress <- shiny::Progress$new(session, min=1, max=n2)
             on.exit(progress$close())

             progress$set(message = 'Generating plot')

             v <- 10^(n1)
             out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>%
                 dyRangeSelector()

             for (i in 1:n2) {
                 progress$set(value = i)
                 Sys.sleep(0.25)
             }

             return(out)
         })
     }
 ))

shiny loading bar for htmlwidgets

2 Answers2

Linked