shiny::debounce problem with numericInputs and dynamic slider

[Eric Nantz]

Greetings Shiny users,

I have an app that contains a couple of numericInputs which define the lower and upper limits for a dynamic slider created via renderUI (and the median of those values is used as the value set in the slider).  Since the app is being viewed on touch devices, the customers like being able to hit the little up/down arrows to change the values without having to finger-type the numbers.  I'd like to ensure that the slider is not re-generated unless the user stops hitting up/down on either of these inputs for at least a full second, so this seemed like a perfect opportunity to use the new debounce function from shiny 1.0.  But it seems I am not using the concept correctly because the slider is still getting updated immediately after each press of those arrows.  The code is below and you can run this directly via shiny::runGist("910e6f4a1a02e71f0852ebeda7c31d6c") .  Any ideas of how to get the behavior I'm looking for?  This is running shiny version 1.0.0 (CRAN release).  If you need additional details I'd be glad to provide them.  Thanks in advance!

App code:

library(shiny)

ui <- fluidPage(
   fluidRow(
     numericInput(
       "obs_low",
       "Minimum obs",
       value = 1000,
       min = 500,
       max = 5000,
       step = 100
     ),
     numericInput(
       "obs_max",
       "Maximum obs",
       value = 4000,
       min = 500,
       max = 10000,
       step = 100
     ),
     uiOutput("likely_ui")
   )
)

server <- function(input, output, session) {
  output$likely_ui <- renderUI({
    
    # obtain the min and max obs
    min_obs <- input$obs_low
    max_obs <- input$obs_max
    
    median_obs <- reactive({
      median(c(input$obs_low, input$obs_max))
    })
    
    min_obs_d <- reactive({ input$obs_low }) %>% debounce(1000)
    max_obs_d <- reactive({ input$obs_max }) %>% debounce(1000)
    median_obs_d <- debounce(median_obs, 1000)
    
    validate(
      need(min_obs < max_obs, "Minimum obs must be less than maximum obs!")
    )
    tagList(
      sliderInput(
        "prev_likely",
        "Most Likely obs",
        min = min_obs_d(),
        max = max_obs_d(),
        value = median_obs_d(),
        sep = ","
      )
    )
  })
}

shinyApp(ui = ui, server = server)

Regards,
Eric

www.r-podcast.org

[Joe Cheng]

The nesting is the problem. This is closer (but keep reading for another issue):

server <- function(input, output, session) {

  median_obs <- reactive({

    median(c(input$obs_low, input$obs_max))

  })

  

  min_obs_d <- reactive({ input$obs_low }) %>% debounce(1000)

  max_obs_d <- reactive({ input$obs_max }) %>% debounce(1000)

  median_obs_d <- debounce(median_obs, 1000)

  

  output$likely_ui <- renderUI({

    validate(

      need(min_obs_d() < max_obs_d(), "Minimum obs must be less than maximum obs!")

    )

    tagList(

      sliderInput(

        "prev_likely",

        "Most Likely obs",

        min = min_obs_d(),

        max = max_obs_d(),

        value = median_obs_d(),

        sep = ","

      )

    )

  })

}

The problem is that min_obs_d, max_obs_d, and median_obs_d are debounced on independent timers. So if you quickly change the min and then the max, you end up with a weird-feeling lag. I think what you really want to do is have both debounced together. There isn't a way I can think of today to take two independent reactive expressions and synchronize their debounces, other than to combine them into a third reactive expression first. So that's what this version does:

server <- function(input, output, session) {

  obs_range <- reactive({

    validate(

      need(input$obs_low < input$obs_max, "Minimum obs must be less than maximum obs!")

    )

    c(input$obs_low, input$obs_max)

  }) %>% debounce(1000)

  obs_median <- reactive(median(obs_range()))

  

  output$likely_ui <- renderUI({

    tagList(

      sliderInput(

        "prev_likely",

        "Most Likely obs",

        min = obs_range()[[1]],

        max = obs_range()[[2]],

        value = obs_median(),

        sep = ","

      )

    )

  })

}

I think this version reads cleaner anyway, and moves the validation upstream where I think it's likely to be more useful.

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/0600150a-82b9-46ea-be25-e69b494e164e%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[Eric Nantz]

Thank you Joe!  The solution works perfectly for me.  Now I have a more clear idea of how to sync multiple inputs/reactives in this debouncing/throttling paradigm.