R Shiny - Combine The Slider Bar With A Text Input To Make The Slider Bar More User-friendly

When I try to select the range that has a extremely huge gap(such as 2000), it will be a little bit difficult for me to make a small step forward using the build-in sliderInput (su

Solution 1:

I wuld recommend using the functions updateSliderInput and updateTextInput for that. Those functions let you update the given Values elements like this

updateSliderInput(session, "slider_id", value = c(0,1))
updateTextInput(session, "text_id", placeholder = "placeholder")

Alternatively, you can also use renderUI, but in most usecases, the update-functions are should be preferred for performance reasons.

The working solution below creates shiny module called controledSlider. This module takes min, max and value as an argument and displays a slider, two text boxes and an actionbutton.

library(shiny)

controlledSliderUI <- function(id){
  ns = NS(id)
  wellPanel(
    sliderInput(ns("slider"), NULL, 0, 1, c(0, 1)),
    textInput(ns("min"), "min", 0, "50%"),
    textInput(ns("max"), "max", 100, "50%"),
    actionButton(ns("update"), "update slider")
  )
}

controlledSlider <- function(input, output, session, min, max, value){
  reactiveRange <- reactiveValues(min = value[1], max = value[2])
  updateSliderInput(session, "slider", min = min, max = max)

  ## observe slider
  observeEvent(input$slider,{
    reactiveRange$min <- input$slider[1]
    reactiveRange$max <- input$slider[2]
  }, ignoreInit = TRUE)

  ## observe button
  observeEvent(input$update,{reactiveRange$min <- as.numeric(input$min)})
  observeEvent(input$update,{reactiveRange$max <- as.numeric(input$max)})

  ## observe reactive
  observeEvent({reactiveRange$min; reactiveRange$max},{
    updateSliderInput(
      session, "slider", value = c(reactiveRange$min, reactiveRange$max))
    updateTextInput(session, "min", value = reactiveRange$min)
    updateTextInput(session, "max", value = reactiveRange$max)
  })

  return(reactiveRange)
}

The module returns a reactiveValue object that can be read and updated from the main server function.

shinyApp(
  fluidPage(
    controlledSliderUI("mySlider"),
    verbatimTextOutput("text")
  ),
  function(input, output, session){
    range <- callModule(controlledSlider, "mySlider", 0, 1200, c(100,1000))
    range$max <- 1001  ## update max
    output$text <- renderPrint({
      print(range$min)
      print(range$max)
    })
  }
)