代码之家 › 专栏 › 技术社区 › Werner RDyego

同步sliderInput和textInput

slider shiny textbox dynamic r

Werner RDyego · 技术社区 · 7 年前

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

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 组件,这两个小部件相互竞争;一个更新导致另一个更新,而另一个更新导致另一个更新。。。

如何在保持两者同步的同时避免这种情况?

2 回复 | 直到 7 年前

Nimantha Thatkookooguy 3 年前

一种方法是使用 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)

Tinku 5 年前

可以稍微修改上述代码,以解决当测试框中的输入为空时关闭应用程序的问题

   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)