Search code examples
rshinydelayinvalidation

Delay on sliderinput


Is there a way to make the sliderInput wait for a couple seconds before it changes its corresponding input$ variable? I have a bar that is controlling a graph that needs to re-render upon the value change. I'm aware of the workaround with a submit button, I'm looking to avoid needing that.


Solution

  • You can use invalidateLater. It can be done in a naive but concise way:

    library(shiny)
    shinyApp(
      server = function(input, output, session) {
          values <- reactiveValues(mean=0)
    
          observe({
            invalidateLater(3000, session)
            isolate(values$mean <- input$mean)
          })
    
          output$plot <- renderPlot({
              x <- rnorm(n=1000, mean=values$mean, sd=1)
              plot(density(x))
          })
      },
      ui = fluidPage(
        sliderInput("mean", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
        plotOutput("plot")
      )
    )
    

    Problem with this approach is that you can still trigger execution when changing slider input and invalidate event is fired. If thats the problem you try a little bit more complex approach where you check if values changed and how many time value has been seen.

    library(shiny)
    library(logging)
    basicConfig()
    
    shinyApp(
      server = function(input, output, session) {
          n <- 2 # How many times you have to see the value to change
          interval <- 3000 # Set interval, make it large so we can see what is going on
    
          # We need reactive only for current but it is easier to keep
          # all values in one place
          values <- reactiveValues(current=0, pending=0, times=0)
    
          observe({
            # Invalidate 
            invalidateLater(interval, session)
    
            # Isolate so we don't trigger execution
            # by changing reactive values
            isolate({
                m <- input$mean
    
                # Slider value is pending and not current
                if(m == values$pending && values$current != values$pending) {
                    # Increment counter
                    values$times <- values$times + 1
                    loginfo(paste(values$pending, "has been seen", values$times, "times"))
    
                    # We've seen value enough number of times to plot
                    if(values$times == n) {
                        loginfo(paste(values$pending, "has been seen", n, "times. Replacing current"))
                        values$current <- values$pending
                    }
    
                } else if(m != values$pending) { # We got new pending
                    values$pending <- m
                    values$times <- 0
                    loginfo(paste("New pending", values$pending))
                }
            })
          })
    
          output$plot <- renderPlot({
              x <- rnorm(n=1000, mean=values$current, sd=1)
              plot(density(x))
          })
      },
      ui = fluidPage(
        sliderInput("mean", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
        plotOutput("plot")
      )
    )