Limit interval between selected slider inputs-CodePudding

Given a sliderInput, I would like to be able to restrict the possible values that a user can select based on the length (range) between the selection. For instance, given a sliderInput with possible values 1:100, I would like to allow a user to select any range provided the difference between the first and last is less than 5.

The following does not work as expected

library(shiny)
ui <- fluidPage(
  sliderInput(
    "test_slider",
    "Test Me",
    value = c(1,2),
    min = 1,
    max = 100,
    step = 1
  ),
  textOutput("what_selected")
)

server <- function(input, output, session){
  observe({
    selected <- req(input$test_slider[1]):req(input$test_slider[2])

    
  
output$what_selected <- renderText(
  if(all(length(selected)>1,max(selected)-min(selected) > 5)){
    
    print("You selected a range that is greater than 5,
            choosing the first five")
    selected <- selected[1:5]
    
  }
  selected)
   
    
  })
}



shinyApp(ui, server)

I have looked at

CodePudding user response：

I think I do understand your problem, but I'm not sure about your desired way to solve it:

You do not want to restrict the choices. You do not want to just update the sliders on the server side, without the user noticing whats going on, correct?

Then the only thing I can think of is {shinyFeedback}. Just use the first five values, and if the range between min and max is larger than five, let the user know, but don't change the slider.

Would that be a way to go about it?

library(shiny)
library(shinyFeedback)

shinyApp(ui = fluidPage(
  
  useShinyFeedback(), # include shinyFeedback
  
  br(),
  
  sliderInput(
    "test_slider",
    "Test Me",
    value = c(1,2),
    min = 1,
    max = 100,
    step = 1
  ),
  
  verbatimTextOutput(outputId = "result")
  
  ),
  
  server = function(input, output, session) {
    
    r <- reactiveValues(slider = NULL)
    
    observeEvent(input$test_slider, {
      
      if (input$test_slider[2] - input$test_slider[1] >= 5) {
        
        
        showFeedbackWarning(
          inputId = "test_slider",
          text = "Only the first five values will be selected."
        )
      
        r$slider <- input$test_slider[1]   c(0:4)
        
      } else {
        
        hideFeedback("test_slider")
        
        r$slider <- c(input$test_slider[1]:input$test_slider[2])
          
      }
      
    })
    
    output$result <- renderPrint(r$slider)
    
  })