Shiny Dynamic UI Resetting to Original Values - r

Question

I have created a dynamic UI with the number of rows of a 'table' defined by a slider. I would like to use the numericInputs from the UI to perform further calculations. In the example below I have tried to calculate a rate from the two numeric inputs, which seems to work when new values are entered but immediately defaults back to the original starting values.
I tried using a button and changing the observe to an observeEvent to calculate the rates which worked to generate the result, but did not stop the numericInputs defaulting back to the starting values.
I have also tried to create the textboxes as a reactive and then call it to renderUI which gives the same 'broken' functionality.
output$groupings <- renderUI({ textboxes() })
textboxes <- reactive ({
I think I need to create vector or datatable to store the inputs so that I can call them later, however I've been unsuccessful so far. My working example is below:
library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
sliderInput(inputId = ns("groups"), label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
hr(),
fluidRow(
column(2,
strong("Speed")),
column(2,
strong("Amount")),
column(2,
strong("Run Rates"))
),
hr(),
uiOutput(ns("textboxes")),
)
}
mod1 <- function(input, output, session, data) {
ns <- session$ns
m <- reactiveValues(x=NULL)
output$textboxes <- renderUI ({
req(input$groups)
lapply(1:input$groups, function(i) {
fluidRow(
column(2,
numericInput(inputId = paste0(session$ns("speed"),i), value = 700, label = NULL, width = 80)
),
column(2,
numericInput(inputId = paste0(session$ns("amount"),i), value = 14, label = NULL, width = 80)
),
column(2,
(m$x[[i]])
)
)
})
})
observe({
lapply(1:input$groups, function(i){
m$x[[i]] <- input[[paste0("speed", i)]] * input[[paste0("amount", i)]] * 60
})
})
}
ui <- fluidPage(
fluidRow(
column(12,
mod1UI("input1"))
)
)
server <- function(input, output, session) {
y <- callModule(mod1, "input1")
}
shinyApp(ui, server)

Answer 1

Your problem is that you render all elements to one output, output$textboxes. Changing the input value of one of your numeric inputs leads to the calculation of a new rate, so the reactive Value m gets updated and the output$textboxes is rerendered.
Below I present you a solution where the different columns are rendered separately; you would have to play with HTML/CSS to display the values nicely. However, if you change the numbers of rows with the slider, all inputs are reset. Therefore I also added a solution where every row is a module that can be added.
library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
sliderInput(inputId = ns("groups"), label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
hr(),
fluidRow(
column(2,
strong("Speed")),
column(2,
strong("Amount")),
column(2,
strong("Run Rates"))
),
hr(),
fluidRow(
column(2,
uiOutput(ns("UI_speed"))),
column(2,
uiOutput(ns("UI_amount"))),
column(2,
uiOutput(ns("rates")))
)
)
}
mod1 <- function(input, output, session, data) {
ns <- session$ns
m <- reactiveValues(x=NULL)
output$UI_speed <- renderUI({
req(input$groups)
lapply(1:input$groups, function(i) {
numericInput(inputId = paste0(session$ns("speed"),i), value = 700, label = NULL, width = 80)
})
})
output$UI_amount <- renderUI({
req(input$groups)
lapply(1:input$groups, function(i) {
numericInput(inputId = paste0(session$ns("amount"),i), value = 14, label = NULL, width = 80)
})
})
output$rates <- renderUI({
req(input$groups)
text <- lapply(1:input$groups, function(i) {
m$x[[i]]
})
HTML(paste0(text, collapse = "<br>"))
})
observe({
lapply(1:input$groups, function(i){
m$x[[i]] <- input[[paste0("speed", i)]] * input[[paste0("amount", i)]] * 60
})
})
}
ui <- fluidPage(
fluidRow(
column(12,
mod1UI("input1"))
)
)
server <- function(input, output, session) {
y <- callModule(mod1, "input1")
}
shinyApp(ui, server)
Every row is a module
You get more flexibility if you have the slider in the main app and then add/remove a module. The module UI now consists of a set of inputs for Speed and Amount and an Output for the Rate. You can use insertUI and removeUI to dynamically control the amount of modules and with this the amount of displayed UI elements.
library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
fluidRow(
id = id,
column(2,
uiOutput(ns("UI_speed"))),
column(2,
uiOutput(ns("UI_amount"))),
column(2,
textOutput(ns("rates")))
)
}
mod1 <- function(input, output, session, data) {
ns <- session$ns
output$UI_speed <- renderUI({
numericInput(inputId = ns("speed"), value = 700, label = NULL, width = 80)
})
output$UI_amount <- renderUI({
numericInput(inputId = ns("amount"), value = 14, label = NULL, width = 80)
})
output$rates <- renderText({
get_rate()
})
get_rate <- reactive({
input$speed * input$amount * 60
})
}
ui <- fluidPage(
fluidRow(
column(12,
sliderInput(inputId = "groups", label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
hr(),
fluidRow(
column(2,
strong("Speed")),
column(2,
strong("Amount")),
column(2,
strong("Run Rates"))
),
hr(),
tags$div(id = "insert_ui_here")
)
)
)
number_modules <- 4
current_id <- 1
server <- function(input, output, session) {
# generate the modules shown on startup
for (i in seq_len(number_modules)) {
# add the UI
insertUI(selector = '#insert_ui_here',
ui = mod1UI(paste0("module_", current_id)))
# add the logic
callModule(mod1, paste0("module_", current_id))
# update the id
current_id <<- current_id + 1
}
observeEvent(input$groups, {
# add modules
if (input$groups > number_modules) {
for (i in seq_len(input$groups - number_modules)) {
# add the UI
insertUI(selector = '#insert_ui_here',
ui = mod1UI(paste0("module_", current_id)))
# add the logic
callModule(mod1, paste0("module_", current_id))
# update the id
current_id <<- current_id + 1
}
} else {
# remove modules
for (i in seq_len(number_modules - input$groups)) {
# remove the UI
removeUI(selector = paste0("#module_", current_id - 1))
current_id <<- current_id - 1
}
}
# update the number of modules
number_modules <<- input$groups
}, ignoreInit = TRUE)
}
shinyApp(ui, server)