Ограничьте множественный слайдерВыход в блестящий, чтобы суммировать до 100

Я боролся с этим весь день, и я как бы решил это (ужасный взлом). Однако опыт не является гладким и отображает побочные эффекты.

Я хочу, чтобы три ползунка с диапазоном от 0 до 100 были ограничены, чтобы их сумма всегда составляла 100.

Это скриншот того, как он выглядит как

Здесь блестящий код server.R.

library(shiny)

oldState<-NULL
newState<-NULL

getState<-function(input) c(input$slider1, input$slider2, input$slider3)

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

  observe({
    newState<<-getState(input)
    i<-which(oldState-newState != 0)[1]
    if(!is.na(i)){
      rem <- 100-newState[i]
      a<-sum(newState[-i])
      if(a==0) newState[-i]<<-rem/length(newState[-i])
      else newState[-i]<<-rem*(newState[-i]/a)
      for(j in 1:length(newState))
        if(j!=i)
          updateSliderInput(session, paste0("slider", j), value=newState[j])
    }
    oldState<<-newState
  })

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

и вот блестящий код ui.R

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 = 40, step=1),
    sliderInput("slider2", "Slider 2: ", min = 0, max = 100, value = 30, step=1),
    sliderInput("slider3", "Slider 3: ", min = 0, max = 100, value = 30, step=1)
  ),

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

Теперь это делает многое, что нужно, кроме двух вещей:

Это похоже на взлом, т.е. должен быть лучший способ сделать это.
Когда я перемещаю ползунок в положение, он иногда перескакивает в несколько более низкое или более высокое положение. Я понятия не имею, почему.

Как исправить эти две проблемы?

Ответ 1

Я думаю, что использование dynamicUI может решить вашу проблему.

Если вы знаете, что должно быть ровно 3 входа, сумма которых равна 1, тогда вы можете ограничить пользователя только двумя входами ползунка и сделать второй вход слайдера на первом, следующим образом. Использование шаблона кода:

server.R

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

Ключ здесь - это функция reactiveUI, которая ищет значение input$slider1, чтобы ограничить значение slider2 (и, следовательно, slider3)

ui.R

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

Как видно (если вы косоглазие) на прикрепленном изображении, slider2 ограничено 0-35, один раз slider1 установлен на 65.