同步slideInput和textInput

Question

考虑以下闪亮的应用程序：

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)

它允许用户更改滑块（sliderInput）的值，该滑块将更新文本框（textInput）中的文本：

我希望这些可以同步工作。因此，我不仅要上面的滑块>文本框交互，还要相反：文本框>滑块。

如果取消注释updateSliderInput组件，则两个小部件将相互竞争；一个更新导致另一个更新，从而导致另一个更新，...

如何在仍然使两者保持同步的同时避免这种情况？

Answer 1

一种方法是使用observeEvent每个输入并添加一个条件if(as.numeric(input$textValue) != input$sliderValue)。这将帮助您从彼此调用的输入中递归更新功能。然后您的应用将如下所示：

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)

希望能帮助到你！