Beschränken Sie zwei sliderInput in glänzend zu Summe 100

Question

Ich möchte eine glänzende App mit zwei Schiebeeingaben erstellen, die bis zu 100 hinzufügen. Das bedeutet, wenn der Benutzer den Wert eines Schiebereglers ändert, ändert sich der andere Schieberegler automatisch um die Einschränkung zu erfüllen (100 Eingabe $ slider1).

fand ich eine ähnliche Frage hier: Examplecode

mit dem folgenden Code:

Server:

library(shiny) 

# Define server logic required 
shinyServer(function(input, output) { 

    output$slider2 <- reactiveUI(function() { 
    sliderInput("slider2", "Slider 2", min = 0, max = 100 - input$slider1, value = 0) 
    }) 

    output$restable <- renderTable({ 
    myvals<- c(input$slider1, input$slider2, 100-input$slider1-input$slider2) 
    data.frame(Names=c("Slider 1", "Slider 2", "Slider 3"), 
       Values=myvals) 
    }) 
}) 

UI:

library(shiny) 

# Define UI for application 
shinyUI(pageWithSidebar(

    # Application title 
    headerPanel("Sliders should sum to 100!"), 

    # Sidebar with sliders whos sum should be constrained to be 100 
    sidebarPanel(
    sliderInput("slider1", "Slider 1: ", min = 0, max = 100, value = 0, step=1), 
    uiOutput("slider2") 
), 

    # Create table output 
    mainPanel(
    tableOutput("restable") 
) 
)) 

Dies ist bereits eine Lösung, die in Ordnung ist. Aber hier kann man nur Schieberegler 1 ändern, um eine automatische Änderung von Schieberegler 2 zu erhalten. Wenn der Benutzer andererseits Schieberegler 2 ändert, passt Schieberegler 1 nicht zu der Beschränkung. Wie kann ich es möglich machen, dass man beide Schieberegler so ändern kann, dass der andere zum Constraint passt?

Answer 1

Ich habe ein Doppel updateSliderInput zusammen mit renderUI für den zweiten

rm(list = ls()) 
library(shiny) 

ui <-pageWithSidebar(

    # Application title 
    headerPanel("Sliders should sum to 100!"), 
    # Sidebar with sliders whos sum should be constrained to be 100 
    sidebarPanel(
    sliderInput("slider1", "Slider 1: ", min = 0, max = 100, value = 0, step=1), 
    uiOutput("slider")), 

    # Create table output 
    mainPanel(tableOutput("restable")) 
) 

server <- function(input, output,session) { 

    observe({ 
    updateSliderInput(session, "slider1", min =0,max=100, value = 100 - input$slider2) 
    }) 
    output$slider <- renderUI({ 
    sliderInput("slider2", "Slider 2: ", min=0,max=100, value=100 - input$slider1) 
    }) 

    output$restable <- renderTable({ 
    myvals<- c(input$slider1, input$slider2, 100-input$slider1-input$slider2) 
    data.frame(Names=c("Slider 1", "Slider 2", "Slider 3"),Values=myvals) 
    }) 
} 
runApp(list(ui = ui, server = server))