Ограничить два слайдера в блестящем виде до 100

Question

Я хочу создать блестящее приложение с двумя слайд-входами, которые добавляют до 100. Это означает, что если пользователь изменяет значение одного слайдера, другой слайдер автоматически изменяется, чтобы выполнить ограничение (100-input$slider1).

Я нашел похожий вопрос здесь: Пример кода

со следующим кодом:

Сервер:

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")
  )
))

Это уже решение, которое в порядке. Но здесь можно только изменить ползунок 1, чтобы получить автоматическое изменение ползунка 2. С другой стороны, если пользователь меняет ползунок 2, тогда ползунок 1 не соответствует ограничению. Как я могу сделать так, чтобы можно было менять оба ползунка так, чтобы другой соответствовал ограничению?

Answer 1

Я добавил двойной updateSliderInput вместе с renderUI для второго

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))