Reactive sliderInput ends in same slider

Viewed 348

I'd like to create a range slider where when selecting one end of the slider updates the other end of the same slider. I know the trick is in observing a change at one end and using it to update the other end. However, I am getting a behaviour where the sliders are flipping back and forth, and I can't figure out why it's not settling.

For the sake of this example, I'd like the sliders to be centred within a 0-100 scale, so that when input$slider[1] is set to 10 then input$slider[2] moves to 90, and when input$slider[2] is moved to 80, input$slider[1] is moved to 20. Example (buggy) code below:

library(shiny)

ui <- fluidPage(
  uiOutput("slidertest"),
  verbatimTextOutput("values")
)

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

  sliderends <- reactiveValues(end=c(NULL,NULL))

  observe({
    sliderends$end[1] <- 100-input$slider[2]
  })

  observe({
    sliderends$end[2] <- 100-input$slider[1]
  })

  output$slidertest <- renderUI({
    sliderInput("slider","Update Ends?", min = 0, max=100, value=c(sliderends$end[1],sliderends$end[2]))
  })

  output$values <- renderText({paste(input$slider[1], input$slider[2], sliderends$end[1], sliderends$end[2], sep=";")})
}

shinyApp(ui, server)

An explanation of what I'm doing wrong and working suggestions would be greatly appreciated.

Thanks!

1 Answers

It seems your slider input get into an infinite loop.

input$slider[1] change → input$slider[2] change → input$slider[1] change ......

You can use reactiveValues to check whether the start value of sliderinput changed or the end value of sliderinput changed, then use updateSliderInput to update the value of your sliderinput.

See the following code :

library(shiny)

ui <- fluidPage(
  # uiOutput("slidertest"),
  sliderInput("slider","Update Ends?", min = 0, max=100,value=c(0,100) ),
  verbatimTextOutput("values")
)

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

  sliderends <- reactiveValues(start=0,end=100)

  observeEvent(input$slider,{
    if(input$slider[1]!=sliderends$start){
      #start value change
      sliderends$start<-input$slider[1]
      updateSliderInput( session,"slider","Update Ends?", min = 0, max=100,value=c( input$slider[1] , 100-input$slider[1] ) )
    }else if(input$slider[2]!=sliderends$end){
      #end value chagne 
      sliderends$end<-input$slider[2]
      updateSliderInput( session,"slider","Update Ends?", min = 0, max=100,value=c( 100-input$slider[2] , input$slider[2] ) )
    }
  })

  output$values <- renderText({paste(input$slider[1], input$slider[2], sliderends$start, sliderends$end, sep=";")})
}

shinyApp(ui, server)
Related