In sync sliderInput and textInput

问题

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?

回答1:

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)

Hope it helps!

来源：https://stackoverflow.com/questions/47822736/in-sync-sliderinput-and-textinput

标签

dynamic

textbox

Shiny

slider