r - 同步 sliderInput 和 textInput

Question

考虑以下 Shiny 的应用程序:

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)

它允许用户更改 slider 的值 ( sliderInput)，从而更新文本框中的文本 ( textInput):



我希望这些同步工作。因此，除了上面的 slider > 文本框交互之外，我还想要相反的:文本框 > slider 。

如果您取消注释 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)