6

I'm working with a Shiny app where I need to calculate processes and while the calc progress is executing, I'm using a progressBar to show the process.

The problem is that the progress bar is too small, and I don't like the way is shown.

So, I was thinking that maybe there's a way to implement a progress bar using a Shiny modal (there's a function called modalDialog).

My idea is that when the user runs the calc, a modal will be opened showing a progressBar.

This is the progress code:

withProgress(message = 'Runing GSVA', value = 0, {
    incProgress(1, detail = "This may take a while...")
    functionToGenerate()
  })

Any idea?

Tonio Liebrand
  • 17,189
  • 4
  • 39
  • 59
JFernandez
  • 265
  • 4
  • 16
  • Are you restricted to `modalDialog` or is the expected output having a progress bar that is bigger than the current one and e.g. centered? – Tonio Liebrand May 18 '17 at 09:25
  • I'm not restricted to `modalDialog`, I just want the current progress bar to be at least much bigger or centered, but it would be cool to use a modal too. – JFernandez May 18 '17 at 09:34

2 Answers2

16

I would suggest customizing the CSS class of the notification: If you inspect the element of the notifier you see that it has the class "shiny-notification". So you can overwrite some properties of that class with tags$style(). In the example below (for the template: see ?withProgress) i decided to adjust height+width to make it bigger and top+left to center it.

ui <- fluidPage(
  tags$head(
    tags$style(
      HTML(".shiny-notification {
              height: 100px;
              width: 800px;
              position:fixed;
              top: calc(50% - 50px);;
              left: calc(50% - 400px);;
            }
           "
      )
    )
  ),
  plotOutput("plot")
)

server <- function(input, output) {
  output$plot <- renderPlot({
    withProgress(message = 'Calculation in progress',
                 detail = 'This may take a while...', value = 0, {
                   for (i in 1:15) {
                     incProgress(1/15)
                     Sys.sleep(0.25)
                   }
                 })
    plot(cars)
  })
}

runApp(shinyApp(ui, server), launch.browser = TRUE)
Tonio Liebrand
  • 17,189
  • 4
  • 39
  • 59
  • 1
    This is better, but if the `progressBar` is in the middle of the screen and the app still shows the main data, the `progressBar` overlaps the data and the result is not readable. That's why I wanted to use a `modalDialog` to hide the main data and show only the `progressBar`. – JFernandez May 18 '17 at 09:48
  • 1
    thats why i asked for specs in the comment ;) So to be specific the transparency of the light grey background is disturbing? – Tonio Liebrand May 18 '17 at 09:55
  • 1
    I know, I really appreciate your help. No, is not the transparency, the problem is that the main page have a lot of data, and when the ´progressBar´ is shown, it's barely visible because all the elements in the page, and if you put it in the middle the problem is the same. It would be good to show the ´progressBar´ and blur the page content. – JFernandez May 18 '17 at 10:01
  • 2
    ok, i think Victorps solution covers it already :) But If you are still interested in adapting this solution just let me know. – Tonio Liebrand May 18 '17 at 10:20
  • 1
    Yes, got it. Thanks a lot both of you. – JFernandez May 18 '17 at 10:34
6

I wrote a progress bar function in the package shinyWidgets, you can put it in a modal, but it's tricky to use with shiny::showModal, so you can create your own modal manually like the below. It's more code to write but it works fine.

library("shiny")
library("shinyWidgets")

ui <- fluidPage(
  actionButton(inputId = "go", label = "Launch long calculation"), #, onclick = "$('#my-modal').modal().focus();"
  
  # You can open the modal server-side, you have to put this in the ui :
  tags$script("Shiny.addCustomMessageHandler('launch-modal', function(d) {$('#' + d).modal().focus();})"),
  tags$script("Shiny.addCustomMessageHandler('remove-modal', function(d) {$('#' + d).modal('hide');})"),
  
  # Code for creating a modal
  tags$div(
    id = "my-modal",
    class="modal fade", tabindex="-1", `data-backdrop`="static", `data-keyboard`="false",
    tags$div(
      class="modal-dialog",
      tags$div(
        class = "modal-content",
        tags$div(class="modal-header", tags$h4(class="modal-title", "Calculation in progress")),
        tags$div(
          class="modal-body",
          shinyWidgets::progressBar(id = "pb", value = 0, display_pct = TRUE)
        ),
        tags$div(class="modal-footer", tags$button(type="button", class="btn btn-default", `data-dismiss`="modal", "Dismiss"))
      )
    )
  )
)

server <- function(input, output, session) {
  
  value <- reactiveVal(0)
  
  observeEvent(input$go, {
    shinyWidgets::updateProgressBar(session = session, id = "pb", value = 0) # reinitialize to 0 if you run the calculation several times
    session$sendCustomMessage(type = 'launch-modal', "my-modal") # launch the modal
    # run calculation
    for (i in 1:10) {
      Sys.sleep(0.5)
      newValue <- value() + 1
      value(newValue)
      shinyWidgets::updateProgressBar(session = session, id = "pb", value = 100/10*i)
    }
    Sys.sleep(0.5)
    # session$sendCustomMessage(type = 'remove-modal', "my-modal") # hide the modal programmatically
  })

}

shinyApp(ui = ui, server = server)
RRuiz
  • 2,159
  • 21
  • 32
Victorp
  • 13,636
  • 2
  • 51
  • 55
  • 1
    I like the modal removal upon finish – Pork Chop May 18 '17 at 12:15
  • Thanks for this post @Victorp, I am attempting to do something similar. In my app I have a `selectInput` under the progress bar that I would like to update in tandem with the progress bar at each iteration of the loop. However, `updateSelectInput` does not work inside the loop. Would you have any insight as to why? Here is my post: https://stackoverflow.com/questions/59799641/r-shiny-updating-the-value-of-a-selectinput-and-progressbar-simultaneously?noredirect=1#comment105750295_59799641. I would really appreciate your input. – user51462 Jan 19 '20 at 00:06
  • PS I've also posted it over on the [RStudio Community](https://community.rstudio.com/t/r-shiny-the-behaviour-of-sendinputmessage-vs-sendcustommessage-inside-a-for-loop/49834). – user51462 Jan 19 '20 at 00:06