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:
How do I fix these two issues?
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.
All these thoughts are helpful, but my instinct is to use the tagList
. The algorithm runs thus,
observe {...}
, identify which widget.x/(n-1)
.Hope this helps. Will update with code as soon as possible.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With