Synchron sliderInput Input-

Question

Betrachten Sie die folgende glänzend 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) 

Es ermöglicht dem Benutzer die Werte eines Schiebers (sliderInput) zu ändern, die den Text in das Textfeld aktualisiert (textInput):

ich möchte diese synchron arbeiten. Also, anstatt nur der obigen Slider> Textfeld Interaktion, möchte ich auch das Gegenteil: Textfeld> Slider.

Wenn Sie die Komponente updateSliderInput auskommentieren, treten die beiden Widgets gegeneinander an; ein Update des einen führt zu einer Aktualisierung des anderen, die zu einer Aktualisierung der anderen führt, ...

Wie dies vermieden werden kann, während immer noch die beiden synchron sein zu machen?

Answer 1

Eine Möglichkeit wäre, für jeden Eingang observeEvent zu verwenden und eine Bedingung if(as.numeric(input$textValue) != input$sliderValue) hinzuzufügen. Dies wird Ihnen helfen, von den Eingängen die Aktualisierungsfunktionen jedes anderen rekursiv aufzurufen. Dann würde Ihre App in etwa so aussehen:

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) 

Hoffe es hilft!