'Do not wipe out (user entered) values of reactive variables when changing input values
I want to collect individual information (name and age) as user input with the attached demo code. The initial number of individuals is 1, and when the user increases/decreases the value of the number of individuals, it will reactively add/reduce corresponding rows to collect individual information. My question is how to avoid wiping out the current input information when increasing/decreasing the number of individuals. For example, screenshot 1 shows the information of individual 1 entered by the user (me). When I changed the values of the number of individuals to 2, the information I entered before was wiped out (screenshot 2), and I had to re-enter the information for individual 1. What I expect will be like screenshot 3 (information for individual 1 is not wiped out) when I increase the number of individuals to 2. Can anyone help me with this? Thanks!
Update on 05/15/2022
The update answer using isolate
is what I am looking for. Thanks again for the help from @jpdugo17.
Example code
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel(
h4("Individual Information"),
fluidRow(column(4,numericInput("ninds",
label = "Number of individuals",
value = 1, min = 1, step = 0.5, width = "300px"))),
br(),
fluidRow(column(2,align = "center",strong("Individual #")),
column(5,align = "center",strong("Individual Name")),
column(5,align = "center",strong("Age"))),
fluidRow(
column(2,wellPanel(uiOutput("indNum"))),
column(5,wellPanel(uiOutput("Name"))),
column(5,wellPanel(uiOutput("Age"))))
)
)
)
server <- function(input, output) {
# create reactive variable paste0("individualNum", i) for further using
output$indNum <- renderUI({
num <- as.integer(input$ninds)
req(num)
lapply(1:num, function(i) {
numericInput(paste0("individualNum", i), value = i, label = "", max = i, min = i)
})
})
# create reactive variable paste0("name", i) for further using
output$Name <- renderUI({
num <- as.integer(input$ninds)
req(num)
lapply(1:num, function(i) {
textInput(paste0("name", i), label = "")
})
})
# create reactie variable paste0("age", i) for further using
output$Age <- renderUI({
num <- as.integer(input$ninds)
req(num)
lapply(1:num, function(i) {
numericInput(paste0("age", i), label = "", value = 0)
})
})
}
# Run the app ----
shinyApp(ui, server)
Solution 1:[1]
Edit:
We can use isolate
with the current value of the input and pass it as the value argument in the numericInput
or textInput
. This will work because any input that doesn't exist yet will yield a NULL
.
server <- function(input, output) {
# create reactive variable paste0("individualNum", i) for further using
num <- reactive({
req(input$ninds)
input$ninds
})
output$indNum <- renderUI({
lapply(1:num(), function(i) {
numericInput(paste0("individualNum", i), value = i, label = "", max = i, min = i)
})
})
# create reactive variable paste0("name", i) for further using
output$Name <- renderUI({
lapply(1:num(), function(i) {
textInput(paste0("name", i), label = "", value = isolate(input[[paste0("name", i)]]))
})
})
# create reactie variable paste0("age", i) for further using
output$Age <- renderUI({
lapply(1:num(), function(i) {
numericInput(paste0("age", i), label = "", value = isolate(input[[paste0("age", i)]]))
})
})
}
Original answer using insertUI
:
We can implement a logic like this: Create a counter to store the current input number, make two buttons, one to add and the other to remove the inputs. We'll have to wrap each input with a div with a unique id (because input functions usually add multiple elements).
library(shiny)
library(purrr)
ui <- fluidPage(
tabsetPanel(
tabPanel(
h4("Individual Information"),
fluidRow(
column(
4, fluidRow(
column(6, numericInput("ninds",
label = "Number of individuals",
value = 1, min = 1, step = 0.5, width = "300px"
)), column(3, actionButton("add_ui", "Add Individual", style = "background-color: green;")),
column(3, actionButton("remove_ui", "Remove Individual", style = "background-color: red;"))
)
)
),
br(),
fluidRow(
column(2, align = "center", strong("Individual #")),
column(5, align = "center", strong("Individual Name")),
column(5, align = "center", strong("Age"))
),
fluidRow(
column(2, wellPanel(id = "IndNumber")),
column(5, wellPanel(id = "Name")),
column(5, wellPanel(id = "Age"))
)
)
)
)
server <- function(input, output) {
# track the number of inputs
ui_counter <- reactiveVal(1)
observeEvent(input$add_ui, {
div_nms <- map_chr(c("individualNum", "name", "age"), ~ paste0("div", .x, ui_counter()))
# individual number
insertUI(
selector = "#IndNumber",
ui = div(
id = div_nms[[1]],
numericInput(paste0("individualNum", ui_counter()),
label = "",
value = ui_counter(),
min = ui_counter(),
max = ui_counter()
)
)
)
# name input
insertUI(
selector = "#Name",
ui = div(id = div_nms[[2]], textInput(paste0("name", ui_counter()),
label = ""
))
)
# age input
insertUI(
selector = "#Age",
ui = div(id = div_nms[[3]], numericInput(paste0("age", ui_counter()),
label = "",
value = 0
))
)
ui_counter(ui_counter() + 1)
})
# observer to remove the divs containing the inputs
observeEvent(input$remove_ui, {
if (ui_counter() > 1) {
walk(c("individualNum", "name", "age"), ~ removeUI(paste0("#div", .x, ui_counter() - 1)))
ui_counter(ui_counter() - 1)
}
})
}
# Run the app ----
shinyApp(ui, server)
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
Solution | Source |
---|---|
Solution 1 |