5

I'm trying to include a progress bar during the computations in my shiny application. Description of my problem:

  • My computation takes a while, like 30 seconds
  • I'm able to evaluate in advance the exact time a computation will take
  • however, the computation is in one chunk, not splitable in small parts that I could use to manually increment the progress bar, think of it as a large model fitting process.

Currently there are some questions related to the problem but no satisfying answer: here, here for instance.

Is there a way to implement an bar that progresses on top of a calculation, independently and continuously, for a fixed amount of time (or maybe insert an animation of the bar in a pop-up that mimics the bar?)

Thanks

Edit: I tried to mimic a progress bar with an animated sliderInput, but I couldn't find how programmatically trigger the animation...

agenis
  • 8,069
  • 5
  • 53
  • 102
  • 1
    Including a [minimal reproducible example](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example) in your question will increase your chances of getting an answer. – Samuel Dec 08 '17 at 13:40

3 Answers3

3

I think this would be a lot easier when Shiny releases its async support. But for now, it'd have to be a custom, client-side JavaScript solution.

My take on it uses the same Bootstrap 3 progress bars that Shiny uses. Out of laziness, I also leveraged Shiny's progress bar CSS classes (top bar style), so this will conflict with Shiny's progress bars. Ideally it'd be a widget with its own styles.

I used jQuery's animate to set the width of the progress bar over a fixed duration. animate has some nice options out of the box like easing. I also let the progress bar linger after 100% by default, thinking it'd be better for the server to explicitly close the progress bar in case the timing isn't exact.

library(shiny)

progressBarTimer <- function(top = TRUE) {
  progressBar <- div(
    class = "progress progress-striped active",
    # disable Bootstrap's transitions so we can use jQuery.animate
    div(class = "progress-bar", style = "-webkit-transition: none !important;
              transition: none !important;")
  )

  containerClass <- "progress-timer-container"

  if (top) {
    progressBar <- div(class = "shiny-progress", progressBar)
    containerClass <- paste(containerClass, "shiny-progress-container")
  }

  tagList(
    tags$head(
      tags$script(HTML("
        $(function() {
          Shiny.addCustomMessageHandler('progress-timer-start', function(message) {
            var $progress = $('.progress-timer-container');
            var $bar = $progress.find('.progress-bar');
            $bar.css('width', '0%');
            $progress.show();
            $bar.animate({ width: '100%' }, {
              duration: message.duration,
              easing: message.easing,
              complete: function() {
                if (message.autoClose) $progress.fadeOut();
              }
            });
          });

          Shiny.addCustomMessageHandler('progress-timer-close', function(message) {
            var $progress = $('.progress-timer-container');
            $progress.fadeOut();
          });
        });
      "))
    ),

    div(class = containerClass, style = "display: none;", progressBar)
  )
}

startProgressTimer <- function(durationMsecs = 2000, easing = c("swing", "linear"),
                               autoClose = FALSE, session = getDefaultReactiveDomain()) {
  easing <- match.arg(easing)
  session$sendCustomMessage("progress-timer-start", list(
    duration = durationMsecs,
    easing = easing,
    autoClose = autoClose
  ))
}

closeProgressTimer <- function(session = getDefaultReactiveDomain()) {
  session$sendCustomMessage("progress-timer-close", list())
}

ui <- fluidPage(
  numericInput("seconds", "how many seconds your calculation will last?", value = 6),
  progressBarTimer(top = TRUE),
  actionButton("go", "Compute")
)

server <- function(input, output, session) {
  observeEvent(input$go, {
    startProgressTimer(input$seconds * 1000, easing = "swing")
    Sys.sleep(input$seconds) # simulate computation
    closeProgressTimer()
    showNotification("Computation finished!", type = "error")
  })
}

shinyApp(ui, server)
greg L
  • 4,034
  • 1
  • 19
  • 18
  • Hi Thanks greg. Is the progress bar necessarily on the top of the screen? it's not very easy to notice it, it's right under the browser tab. Can we move it to a custom location? – agenis Dec 11 '17 at 09:44
  • 1
    I just did the slim/top style progress bar since that was the easiest to mimic Shiny. Doing it with a Shiny notification isn't straightforward at all. But, I edited the code so `progressBarTimer` accepts a `top` option to remove the Shiny styles. Try it with `top = FALSE` to get a regular Bootstrap progress bar that you'll have to style yourself. – greg L Dec 11 '17 at 19:14
1

Not a complete answer, since my suggestion would be to use progress bars, but I hope it helps a bit.

Here's a way to trigger clicking a slider animate button using some javascript with the shinyjs package:

library(shiny)
library(shinyjs)

jscode <- "
  shinyjs.play = function() {
    $('.slider-animate-button').trigger('click');
  }
"

ui <- fluidPage(
  useShinyjs(),
  extendShinyjs(text = jscode),
  sliderInput("slider", label = "", width = '600px',
              min = 0,
              max = 20,
              value = 0,
              step = 1,
              animate = animationOptions(
                interval = 100,
                playButton = "Play",
                pauseButton = "Pause"
              )
  )
)

server <- function(input, output,session) {
  observe( {
    js$play()
  })
}

shinyApp(ui, server)

Please note that the js code references the slider-animate-button class, so it will trigger every slider animation option in the app.

GyD
  • 3,902
  • 2
  • 18
  • 28
  • Hi @GyD, thanks a lot. it works indeed, the computation happens at the same time as the slider movement. I tried to hide this basic slider, and tie its movemnet to something more sexy, like the movemnet of a nice `shinywidgets::progressBar`, but it seems that shiny refuses to update any dependencies to the animated slider before the background computation ends. So i guess the animated slider is the only way to go; at least we should present it deactivated (to avoid confusing the user) and with some html customization to make it "look" like a progress bar...(if you know how to do this welcome!) – agenis Dec 08 '17 at 21:48
1

Thanks to the answer of @GyD, I now propose an improved solution (that has something of a hack I admit). The long computation is simulated here by a sys.sleep of the desired duration. You see that there is still slider movement during the 'sleep'. I put the animated slider into a RenderUI so we can control the speed:

library(shiny); library(shinyjs); library(shinyWidgets)
jscode <- "
shinyjs.play = function() {
$('.slider-animate-button').trigger('click');
}
"
ui <- fluidPage(
     tags$head(tags$style(HTML('.irs-from, .irs-to, .irs-min, .irs-max, .irs-grid-text, .irs-grid-pol, .irs-slider {visibility:hidden !important;}'))),
     useShinyjs(), extendShinyjs(text = jscode),
     numericInput("seconds", "how many seconds your calculation will last?", value=6),
     uiOutput("UI"),
     actionButton("go", "Compute"))
server <- function(input, output,session) {
     disable("slider")
     observeEvent(input$go, priority=10, {
          js$play()
          Sys.sleep(input$seconds) # simulate computation
          showNotification("Computation finished!", type="error")})
     output$UI = renderUI({
          sliderInput("slider", label = "", width = '300px',min = 0,max = 100,value = 0,step = 1,
                      post="% done",
                      animate = animationOptions(
                           interval = (as.numeric(input$seconds)*8),
                           playButton = "",
                           pauseButton = ""))})}
shinyApp(ui, server)

The slider really looks like a bar, doesn't it?

enter image description here

agenis
  • 8,069
  • 5
  • 53
  • 102