Constrain multiple sliderInput in shiny to sum to 100

Question

I've been struggling with this all day and I've kind of solved it (horrible hack). However there experience is not smooth and displays side-effects.

What I want is three sliders with a range of 0 to 100 constrained such that their sum should always be 100.

This is a screenshot of what it looks like

Here's the server.R shiny code.

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

and here is the ui.R shiny code

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

Now this does pretty much what it should except two things:

• It feels like a hack i.e. there should be a better way of doing this
• When I move a slider into a position it sometimes jumps to a slightly lower or higher position. I have no idea why.

How do I fix these two issues?

Answer 1

I think using dynamicUI might solve your problem.

If you know that there need to be exactly 3 inputs that sum to 1, then you can restrict your user to just two slider inputs and make the 2nd slider input contingent on the first, as follows. Using your code template:

server.R

library(shiny)

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

  output$slider2 <- renderUI {
    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)
  })
})

The key here is the renderUI function which looks up the input$slider1 value to constrain the value of slider2 (and hence 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")
  )
))

As seen (if you squint) in the attached image, slider2 is restricted to 0-35, once slider1 has been set at 65.

Answer 2

All these thoughts are helpful, but my instinct is to use the tagList. The algorithm runs thus,

1. Keep all sliders in a tag list
2. Let n be the length of the tag list
3. Populate all slider widgets from the tag list
4. If a slider widget changes (in the server) under observe {...} , identify which widget.
5. Let x be 100 minus the value of the widget changed from the tag list (3) and (4).
6. Set the value property of the remaining sliders in the tag list to x/(n-1).

Hope this helps. Will update with code as soon as possible.