69

I use Shiny GUI R package. I'm looking for a way to display a message like "loading..." after the actionButton was pressed. The function takes several minutes to execute, so I need to inform the user somehow that the button actually triggered some event. Now the server.R code looks like this:

DATA <- reactive({
  if(input$DownloadButton>0) {
    RunDownload()
  } else {
    NULL
  }
})

output$Download <- renderText({
  if(NROW(DATA())>0) {
    paste0(Sys.time(),": ",NROW(DATA()), " items downloaded")
  } else {
    ''
  }
})

actionButton() is a function that downloads data from internet. input$DownloadButton is actionButton. So after the button was pressed the user waits for several minutes and only then sees a message saying that download was successful. I would like to show a message "Loading..." just after the actionButton was pressed and then another message like paste0(Sys.time(),": ",NROW(DATA()), " items downloaded") when execution ends.

2
  • To simplify things I think you need a progress bar and in R there are many ways to add it to functions. Can we have a version of RunDownload to see how to add progress bar ? Commented Jun 26, 2013 at 16:44
  • I don't need a progress bar, well it can be called binary progress bar. I need to show 2 messages: one at function start and one at function end. I think I forgot to specify in message body that I'm using Shiny package, it's not just R code. Will fix that now. Commented Jun 27, 2013 at 6:40

6 Answers 6

45

I'm already using a simpler and more reliable way than the one I posted before.

A combination of

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

with

conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                 tags$div("Loading...",id="loadmessage")
)

Example:

runApp(list(
  ui = pageWithSidebar(
      headerPanel("Test"),
         sidebarPanel(
           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;
             }
          ")),
           numericInput('n', 'Number of obs', 100),
           conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                            tags$div("Loading...",id="loadmessage"))
         ),
         mainPanel(plotOutput('plot'))
  ),
  server = function(input, output) {
    output$plot <- renderPlot({ Sys.sleep(2); hist(runif(input$n)) })
  }
))

tags$head() is not required, but it's a good practice to keep all the styles inside head tag.

Sign up to request clarification or add additional context in comments.

4 Comments

Can something similar be done for renderDataTable tables inside the page that take some time to load?
Love this solution, but I'm having a hard time making it work with shinydashboard. Any ideas why? In the developer console I can see the condition getting triggered, but despite trying many different locations and wrappers around the conditionalPanel, I can't get the message to actually show up.
In case anyone has the same question I did, I adapted this bug-workaround to get a much nicer looking and more natural to use progress bar that works on shinydashboard as well: github.com/rstudio/shiny/issues/609
In this case, how do you use textOutput to replace "loading..." with a dynamic message? For example, what if I want to indicate how many rows are being crunched by the running function (e.g. "Mining 50,000 records").?
43

Very simply, you can use built-in shiny functions showModal() at the start of the function and removeModal() at the end. If you remove the footer, said modal cannot be clicked out of.

Example:

observeEvent(input$button, {
     showModal(modalDialog("Doing a function", footer=NULL))
     #Do the stuff here....
     #...
     #...
     #Finish the function
     removeModal()
})

1 Comment

The shinybusy package also has a nice "busy" signal which can also be incorporated as modal dialog. I find that more attractive than just text, however it does require an additional package.
8

Though this question is old I think it is still relevant. I have another solution to offer that displays the activity indicator on the button that starts a lengthy process next to the button label.

Button with an activity indicator

We need an action button with a label in a span and some way of identifying that label.

actionButton("btnUpdate", span("Update", id="UpdateAnimate", class=""))

We also need some CSS animation that can be added to the button label, e.g. like this:

            tags$head(tags$style(type="text/css", '
            .loading {
                display: inline-block;
                overflow: hidden;
                height: 1.3em;
                margin-top: -0.3em;
                line-height: 1.5em;
                vertical-align: text-bottom;
                box-sizing: border-box;
            }
            .loading.dots::after {
                text-rendering: geometricPrecision;
                content: "⠋\\A⠙\\A⠹\\A⠸\\A⠼\\A⠴\\A⠦\\A⠧\\A⠇\\A⠏";
                animation: spin10 1s steps(10) infinite;
                animation-duration: 1s;
                animation-timing-function: steps(10);
                animation-delay: 0s;
                animation-iteration-count: infinite;
                animation-direction: normal;
                animation-fill-mode: none;
                animation-play-state: running;
                animation-name: spin10;
            }
            .loading::after {
                display: inline-table;
                white-space: pre;
                text-align: left;
            }
            @keyframes spin10 { to { transform: translateY(-15.0em); } }
            '))

Now we can use shinyjsto manipulate the span class which dynamically adds the animation behind the button label. We add the animation once a user presses the button:

    observeEvent(input$btnUpdate, { # User requests update
        # ... 

        shinyjs::addClass(id = "UpdateAnimate", class = "loading dots")
        shinyjs::disable("btnUpdate")
        
        # ...
    })

When the operation has finished we can remove the class from the span and end the animation:

    output$distPlot <- renderPlot({
        # ...
        
        Sys.sleep(1) # just for show, you probably want to remove it in a real app
        # Button settings        
        shinyjs::enable("btnUpdate")
        shinyjs::removeClass(id = "UpdateAnimate", class = "loading dots")

        # ...
    })

The full code of the sample app is available as gist on GitHub.

1 Comment

I've been trying to adapt this code to also change the button label while it's busy, but I can either get the label to update, or the animation, but not both? Any ideas?
4

I solved the problem by adding the following code to sidebarPanel():

HTML('<script type="text/javascript">
        $(document).ready(function() {
          $("#DownloadButton").click(function() {
            $("#Download").text("Loading...");
          });
        });
      </script>
')

Comments

3

You can use ShinyJS: https://github.com/daattali/shinyjs

When the actionButton is pressed, you can easily toggle a text component showing "loading...", and when the calculation is finished, you can then toggle this component to hidden.

Comments

2

I found a solution, that works fine for me. I am using the Bootstrap modal. It is shown when the execution of the function starts and is hidden again, when it ends.

modalBusy <- function(id, title, ...){

 msgHandler =  singleton(tags$head(tags$script('Shiny.addCustomMessageHandler("jsCode",
                                            function(message) {
                                              console.log(message)
                                              eval(message.code);
                                            });'
                                            )
                                )
                      )

 label_id = paste(id, "label", sep='-')
 modal_tag <- div(id=id, 
               class="modal hide fade", 
               "aria-hidden"=FALSE, 
               "aria-labelledby"=label_id, 
               "role"="dialog", 
               "tabindex"="-1",
               "data-keyboard"=FALSE,
               "data-backdrop"="static")
 header_tag <- div(class="modal-header",
                h3(id=label_id, title))
 body_tag <- div(class="modal-body",
              Row(...))   
 footer_tag <- div(class="modal-footer")
 modal_tag <- tagAppendChildren(modal_tag, header_tag, body_tag, footer_tag)
 tagList(msgHandler, modal_tag) 
}

To show and to hide it use the functions

showModal <- function(id,session) {
  session$sendCustomMessage(type="jsCode",
                            list(code= paste("$('#",id,"').modal('show')"
                                             ,sep="")))
}

hideModal <- function(id,session) {
  session$sendCustomMessage(type="jsCode",
                            list(code= paste("$('#",id,"').modal('hide')"
                                             ,sep="")))
}

Call the showModal function before your function Call and the hideModal function afterwards!

Hope this helps.

Seb

1 Comment

I am unable to get this to work. @Seb Can you please share a working example. Thanks

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.