How to create mutually dependent numeric Input in Shiny?

Question

Please find the working code below. Basically, there are 3 numericInputs which allows the user to change anyone at a time and the other 2 should adapt themselves resulting in 1

A + B + C = 1 However, since they are interlinked, they seems to be unstable. How can we make it stable and allow the user to change any 1 variable: A and other 2 change themselves summing to 1.

Based on the answer here, created a working code as shown below:

Connect mutually dependent shiny input values

Dependent inputs in Shiny application with R

library(shiny)
ui <- shinyUI(fluidPage(
  titlePanel("Mutually Dependent Input Values"),
  sidebarLayout(
    sidebarPanel(
      numericInput("A", "A",.333),
      numericInput("B", "B",.333),
      numericInput("C", "C",.333)
    ),
    mainPanel(
      verbatimTextOutput("result")
    )
  )
)) 
server <- shinyServer(function(input, output,session) {

  observeEvent(input$A,{
    newB <- 1 - input$A - input$C 
    updateNumericInput(session, "B", value = newB) 
    newC <- 1 - input$A - input$B 
    updateNumericInput(session, "C", value = newC) 
  })
  observeEvent(input$B,{
    newC <- 1 - input$B - input$A 
    updateNumericInput(session, "C", value = newC) 
    newA <- 1 - input$B - input$C 
    updateNumericInput(session, "A", value = newA) 
  })
  observeEvent(input$C,{
    newA <- 1 - input$C - input$B 
    updateNumericInput(session, "A", value = newA) 
    newB <- 1 - input$C - input$C 
    updateNumericInput(session, "B", value = newB) 
  })


})
shinyApp(ui,server)

Basically, user will be free to update any of the numericInput: A, B or C. Other 2 numericInput should adapt itself to sum up to 1. Currently, since they are interlinked, they seems to be unstable (please find the above code to regenerate the error)

####### Different approach with own solution

ui <- fluidPage(
  column(6, 
         tags$h2("Set parameters"),
         numericInput("valueA", "Value1", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueB", "Value2", value = .333, min = 0, max = 1, step = .1),
         numericInput("valueC", "Value3", value = .333, min = 0, max = 1, step = .1)
  ),
  column(6,
         uiOutput("ui")
  )
)

server <- function(input, output, session) {
  output$ui <- renderUI( {
    tagList(
      tags$h2("Display in %"),
      numericInput("obs1", "Label1", value = 100 * (input$valueA / (input$valueA + input$valueB + input$valueC))),
      numericInput("obs2", "Label2", value = 100 * (input$valueB / (input$valueA + input$valueB + input$valueC))),
      numericInput("obs2", "Label2", value = 100 * (input$valueC / (input$valueA + input$valueB + input$valueC)))
    )
  })
}

shinyApp(ui, server)   

Answer 1

You need to do two main things:

• First let your initial values stable, so either their sum should be 1 (0.333, 0.333, 0.334), or maybe let the initial values be empty, which will only work if you have some type of error escaping mechanism to allow NA or empty string to be an initial value. As I thought there should be in any case some validation that the input is numeric I chose to use the second option, which works well with the validation.

• Second one way to get rid of these infinite loops of observing and changing the input, is to change one at a time, meaning:

  • if A is changed ---> change B,
  • if B is changed ---> change C, and
  • if C is changed ---> change A

That being said, note that the order of changing the input makes a difference in this approach, this is most noticeable at the start when you give the input their first set of values.

There might be a better approach to solve this, but this is what I can think of, so here it goes.

The UI:

library(shiny)
ui <- shinyUI(fluidPage(
  titlePanel("Mutually Dependent Input Values"),
  sidebarLayout(
    sidebarPanel(
      numericInput("A", "A", NA),
      numericInput("B", "B", NA),
      numericInput("C", "C", NA)
    ),
    mainPanel(
      verbatimTextOutput("result")
    )
  )
)) 

The Server:

server <- shinyServer(function(input, output, session) {
  sum <- reactive({
    validate(
      need(is.numeric(input$A), 'A is not a number, only numbers are allowed'),
      need(is.numeric(input$B), 'B is not a number, only numbers are allowed'),
      need(is.numeric(input$C), 'C is not a number, only numbers are allowed')
    )
    input$A + input$B + input$C})

  observeEvent(input$A,{
      newB <- 1 - input$A - input$C
      updateNumericInput(session, "B", value = newB)
  })

  observeEvent(input$B,{
      newC <- 1 - input$B - input$A
      updateNumericInput(session, "C", value = newC)
  })

  observeEvent(input$C,{
      newA <- 1 - input$C - input$B
      updateNumericInput(session, "A", value = newA)
  })

  output$result <- renderPrint({
    print(sprintf("A=%.3f      B=%.3f      C=%.3f  ---->   A + B + C = %.0f", 
                  input$A, input$B, input$C, sum()))
  })
})

Run:

shinyApp(ui,server)