How to format user inputs into a matrix using percentage and decimal formatting, while passing the values through as numerics for calculations?

46 views Asked by At

The below R Shiny code has 3 linked user input matrixes: the first, base_input, allows the user to make static inputs and the next 2 user input matrixes, var_1_input and var_2_input (collectively, "var_x_input"), are reactively fed values from base_input and the slider input (input$periods) for time horizon, and allow the user to alter the time dimension in their respective left-most user input columns labeled "X". The image below shows the data flows.

I am trying to automatically format all default values and user inputs in base_input and in the second columns of downstream user input matrixes var_1_input and var_2_input, with percentages and a minimum of 2 decimal places shown with no rounding. This formatting must apply when first invoking the App, when the user makes a change to an existing value in either base_input or in the second column of either var_x_input matrix, or when the user inserts a new value into any new cell in the second column of either var_x_input since they automatically expand vertically. The formatting needs to be with percentage sign and a minimum of 2 decimal places with no rounding. If user enters 20 what is shown should be 20.00% and processed as 0.20; if user enters 212 what is shown should be 212.00% and processed as 2.12; if user enters 15.45 what is shown should be 15.45% and processed as .1545; if the user enters 0.2 what is shown should be 0.20% and processed as 0.002. Numeric values need to be transmitted for the "Sum Outputs" calculations to work. This formatting needs to persist no matter what the user inputs.

Any suggestions for how to do this? I have fiddled with js, sprintf(), format(), etc., with no luck yet. This has to be a common problem! I am trying to preserve the overall structure of the code so important features are retained, such as for example a change to base_input[1,1] only resets var_1_input and not both var_x_input (and vice versa with respect to a user change to base_input[2,1]), the reactivity flows, etc.

enter image description here

Code:

library(shiny)
library(shinyMatrix)

matInputBase <- function(name) {
  matrixInput(
    name,
    value = matrix(rep(20, 2), 2, 1, dimnames = list(c("A", "B"), NULL)),
    rows = list(extend = FALSE, names = TRUE),
    cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
    class = "numeric"
  )
}

matInputVary <- function(name, x, y) {
  matrixInput(
    name,
    value = matrix(c(x, y), 1, 2, dimnames = list(NULL, c("X", "Y"))),
    rows = list(extend = TRUE, names = FALSE),
    cols = list(extend = TRUE, delta = 0, names = TRUE, editableNames = FALSE),
    class = "numeric"
  )
}

ui <- fluidPage(
  sliderInput("periods", "Time window (W):", min = 1, max = 10, value = 5),
  h5(strong("Variable (Y) over window (W):")),
  matInputBase("base_input"),
  uiOutput("Vectors"),
  h4("Sum Outputs"),
  textOutput("sumBaseInput"),
  textOutput("sumVar1Input"),
  textOutput("sumVar2Input")
)

server <- function(input, output, session) {
  prev_base_input <- reactiveValues(data = matrix(NA, nrow = 2, ncol = 1))
  
  observeEvent(input$base_input, {
    for (i in 1:2) {
      if (is.na(prev_base_input$data[i, 1]) || input$base_input[i, 1] != prev_base_input$data[i, 1]) {
        updateMatrixInput(
          session,
          paste0("var_", i, "_input"),
          value = matrix(c(input$periods, input$base_input[i, 1]), 1, 2, dimnames = list(NULL, c("X", "Y")))
        )
        prev_base_input$data[i, 1] <- input$base_input[i, 1]
      }
    }
  }, ignoreInit = FALSE)
  
  output$Vectors <- renderUI({
    varNames <- c("A", "B")
    lapply(1:2, function(i) {
      list(
        h5(strong(paste("Adjust", varNames[i], "(Y) at time X:"))),
        matInputVary(paste0("var_", i, "_input"), input$periods, isolate(input$base_input)[i, 1])
      )
    })
  })
  
  output$sumBaseInput <- renderText({sum(input$base_input[, 1])})
  output$sumVar1Input <- renderText({sum(input$var_1_input[, 2])})
  output$sumVar2Input <- renderText({sum(input$var_2_input[, 2])})
}

shinyApp(ui, server)
0

There are 0 answers