In sync sliderInput and textInput

Question

Consider the following shiny app:

library('shiny')

# User Interface/UI

ui <- fluidPage(

  titlePanel(
    'Slider and Text input update'
  ), # titlePanel

  mainPanel(

    # Slider input
    sliderInput(
      inputId = 'sliderValue',
      label = 'Slider value',
      min = 0,
      max = 1000,
      value = 500
    ), # sliderInput

    # Text input
    textInput(
      inputId = 'textValue',
      label = NULL
    ) # textInput

  ) # mainPanel

) # fluidPage


# Server logic

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

  observe({
    # Update vertical depth text box with value of slider
    updateTextInput(
      session = session,
      inputId = 'textValue',
      value = input$sliderValue
    ) # updateTextInput

#    updateSliderInput(
#      session = session,
#      inputId = 'sliderValue',
#      value = input$textValue
#    ) # updateSliderInput

  }) # observe

}

# Run the application 
shinyApp(ui = ui, server = server)

It allows the user to change the values of a slider (sliderInput), which updates the text in the text box (textInput):

I want these to work in sync. So, instead of just the above slider > text box interaction, I want the opposite as well: text box > slider.

If you uncomment the updateSliderInput component, the two widgets compete against one another; an update of the one leads to an update of the other which leads to an update of the other, ...

How can this be avoided while still making the two be in sync?

I have a feeling there is a need for [`isolate(...)`](https://shiny.rstudio.com/articles/isolation.html) somewhere... — Werner, Dec 15 '17 at 00:07

score 12 · Accepted Answer · edited Dec 09 '21 at 04:28

One way to do it would be using observeEvent for each input and adding a condition if(as.numeric(input$textValue) != input$sliderValue). This will help you from the inputs calling each others update functions recursively. Then your app would look something like this:

library('shiny')
  
  # User Interface/UI
  
  ui <- fluidPage(
    
    titlePanel(
      'Slider and Text input update'
    ), # titlePanel
    
    mainPanel(
      
      # Slider input
      sliderInput(
        inputId = 'sliderValue',
        label = 'Slider value',
        min = 0,
        max = 1000,
        value = 500
      ), # sliderInput
      
      # Text input
      textInput(
        inputId = 'textValue',
        value = 500,
        label = NULL
      ) # textInput
      
    ) # mainPanel
    
  ) # fluidPage
  
  
  # Server logic

  server <- function(input, output, session)
  {
    observeEvent(input$textValue,{
      if(as.numeric(input$textValue) != input$sliderValue)
      {
        updateSliderInput(
          session = session,
          inputId = 'sliderValue',
          value = input$textValue
        ) # updateSliderInput
      }#if
      
      
    })
    
    observeEvent(input$sliderValue,{
      if(as.numeric(input$textValue) != input$sliderValue)
      {
        updateTextInput(
          session = session,
          inputId = 'textValue',
          value = input$sliderValue
        ) # updateTextInput
        
      }#if
     
    })
    
    
  }
  
  # Run the application 
  shinyApp(ui = ui, server = server)

I just tried this, it works, but if a user want to enter a value by deleting the existing input, the app closes.Is there a way to avoid this? — ACE, Dec 11 '19 at 22:23

score 0 · Answer 2 · answered Jan 09 '20 at 22:36

The above code can be modified a bit to fix the issue of application getting closed when the input in the test box is empty

   library('shiny')
   ui <- fluidPage(titlePanel('Slider and Text input update'),

                    mainPanel(
                      sliderInput(
                        inputId = 'sliderValue',
                        label = 'Slider value',
                        min = 0,
                        max = 1000,
                        value = 500
                      ),


                      textInput(
                        inputId = 'textValue',
                        value = 500,
                        label = NULL
                      )

                    ))


    # Server logic

    server <- function(input, output, session)
    {
      observeEvent(input$textValue, {
        print(input$textValue)
        if ((as.numeric(input$textValue) != input$sliderValue) &
            input$textValue != "" &  input$sliderValue != "")
        {
          updateSliderInput(
            session = session,
            inputId = 'sliderValue',
            value = input$textValue
          )
        } else {
          if (input$textValue == "") {
            updateSliderInput(session = session,
                              inputId = 'sliderValue',
                              value = 0)

          }
        }


      })

      observeEvent(input$sliderValue, {
        if ((as.numeric(input$textValue) != input$sliderValue) &
            input$sliderValue != "" & input$textValue != "")
        {
          updateTextInput(
            session = session,
            inputId = 'textValue',
            value = input$sliderValue
          )

        }

      })


    }

    # Run the application
    shinyApp(ui = ui, server = server)

Gundog · Answer 3 · 2023-02-04T22:11:55.697

I am a little late to this discussion, but I have recently been having similar trouble. Only I was wanting to sync numeric inputs with slider values... Using the latest example posted here, I still had issues with infinite loops. I think that I finally found a solution to the infinite loops. Following on from Tinku's answer, I add a time delay in the part of the code where the numeric input is updated by the slider value. I believe that the slider value updates slightly slower than the numeric input, so if changing the numeric input too fast, the lag can become too much and looping occurs. I add the code below…. I set the lag to 0.3 s, which is good enough to avoid the infinite loops on my computer….

library('shiny')
library('shinyvalidate')


ui <- fluidPage(titlePanel('Slider and numeric input'),
            
            mainPanel(
              sliderInput(
                inputId = 'sliderValue',
                label = 'Slider value',
                min = 0,
                max = 1000,
                value = 500,
                step = 5,
              ),
              
              
              numericInput(
                inputId = 'numericValue',
                min = 0,
                max = 1000,
                value = 500,
                step = 5,
                label = "Numeric value"
              ),
              
              actionButton("Set", "Apply"),
              textOutput("value") #Paste the 'Set' value
            ))

    # Server logic
server <- function(input, output, session)
{

 v <- reactiveValues()
 #Register the current time
 v$now = Sys.time() 
 v$when = Sys.time() 

 #The saved numeric value to use in further functions/plots
 v$num = 500 # Initial value

 observeEvent(input$numericValue, {
  v$when = Sys.time()
  req(input$numericValue) 
   if (input$numericValue != input$sliderValue)
  {
    updateSliderInput(
      session = session,
      inputId = 'sliderValue',
      value = input$numericValue
    )
  } 
})

  observeEvent(input$sliderValue, {
    v$now = Sys.time() 
    req(input$numericValue)
    if (input$numericValue != input$sliderValue  & v$now - v$when > 0.3) #I found 0.3 s a good lag to give (I believe that the slidervalue updates ~0.25 s slower than numericinput)
 {
   updateNumericInput(
     session = session,
     inputId = 'numericValue',
     value = input$sliderValue
    )   
  }

})

 #Only update the reactive value (v$num) if within the specified numeric range....
 isolate(
   observeEvent(input$Set, {
   i <- InputValidator$new()
   i$add_rule("numericValue", sv_required(message = "Number must be provided"))
   i$add_rule("numericValue", sv_gte(0))
   i$add_rule("numericValue", sv_lte(1000))
   i$enable()
   req(i$is_valid())
   v$num <- input$numericValue  #Use this reactive value in further functions/plots.....
   output$value <- renderText({paste("The syncronised value is:", v$num)})
  })
 )

}

# Run the application
shinyApp(ui = ui, server = server)

In sync sliderInput and textInput

3 Answers3

Linked