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