R Shiny Module does not update input value on different tabs - r

I have an app which works with tabpanels that use many of the same inputs, and must be rendered using renderUI to respond to user data. I've noticed my modulated inputs give priority to the first menu they're rendered in and disregard changes made in different panels
The following is a simplified working example of the basic issue
library(shiny)
addexButtons <- function(id, label = "ROCParam") {
ns <- NS(id)
uiOutput(ns("roccondicionals"), label = label)
}
numbmod <- function(input, output, session, ndata) {
output$roccondicionals <- renderUI({
tagList(numericInput('numb', 'Choose Num', value = 0,))
})
}
ui <- fluidPage(navbarPage(
'App',
tabPanel(title = 'Menu 1',
sidebarLayout(
sidebarPanel(addexButtons("counter1", "Adder")),
mainPanel(textOutput('sumtotal'))
)),
tabPanel(title = 'Menu 2',
sidebarLayout(
sidebarPanel(addexButtons("counter2", "Multiplier"),),
mainPanel(textOutput('multiplytotal'))
))
))
server <- function(input, output) {
callModule(numbmod, "counter1")
callModule(numbmod, "counter2")
output$sumtotal <-
renderText(paste0('5 + ', input$numb, ' = ', input$numb + 5))
output$multiplytotal <-
renderText(paste0('5 x ', input$numb, ' = ', input$numb * 5))
}
shinyApp(ui = ui, server = server)
If you run this example you will see that, by changing to menu 2 the value retains the information modified in Menu 1 (which is intended) however if I choose to modify this same value in the same tab I can't and must return to Menu 1 to do so.
Is there a way to be able to modify the same rendered input on two different tabs where the last modification is the one retained?

As #YBS has already mentioned you cannot define two inputs with the same id. I would use updateNumericInput to automatically update the inputs when of the inputs is changed (triggered).
library(shiny)
addexButtons <- function(id, label = "ROCParam") {
ns <- NS(id)
uiOutput(ns("roccondicionals"), label = label)
}
numbmod <- function(input, output, session, ndata, n) {
output$roccondicionals <- renderUI({
numericInput(paste0("numb",n), 'Choose Num', value = 0)
})
}
ui <- fluidPage(navbarPage(
'App', id = "App",
tabPanel(title = 'Menu1',
tab_id = "tab1",
sidebarLayout(
sidebarPanel(addexButtons("counter1", "Adder")),
mainPanel(textOutput('sumtotal'))
)),
tabPanel(title = 'Menu2',
tab_id = "tab2",
sidebarLayout(
sidebarPanel(addexButtons("counter2", "Multiplier"),),
mainPanel(textOutput('multiplytotal'))
))
))
server <- function(input, output, session) {
observeEvent(input$numb1, {
updateNumericInput(session, "numb2", value = input$numb1)
updateNavbarPage(session,"App", "Menu2")
})
observeEvent(input$numb2, {
updateNumericInput(session, "numb1", value = input$numb2)
updateNavbarPage(session,"App", "Menu1")
})
callModule(numbmod, "counter1",n = 1)
callModule(numbmod, "counter2",n = 2)
output$sumtotal <-
renderText(paste0('5 + ', input$numb1, ' = ', input$numb1 + 5))
output$multiplytotal <-
renderText(paste0('5 x ', input$numb2, ' = ', input$numb2 * 5))
}
shinyApp(ui = ui, server = server)

Related

ModuleServer combined with modalDialog - modalDialog quits after first usage

In my Shiny application, I have the functionality to insert a new line of information, this is done via InsertUI. Then for every added line, the source of that line can be updated via an actionButton. The actionButton leads to a modalDialog, allowing the user to insert the text for the source there.
To prevent multiple lines getting the same source after updating, a moduleServer is used for the part around the modalDialog. That works well, with the only exception that after the first time the modalDialog is used (with inside an action button that updates the text after insertion), the modalDialog closes directly after clicking. Reclicking does give the pop-up again, but is somewhat annoying.
Any suggestions to prevent this?
Example UI and server with this behaviour:
UI.R
library(shiny)
shinyUI(fluidPage(
div(id = "input_add_div_block"),
br(),
# Input for the new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
textInput(inputId = "input_new_line",
label = "Give description of new line")
),
# Adding a new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
id = "input_add_div",
actionButton("input_add", "Add new line")
)
))
Server.R
library(shiny)
shinyServer(function(input, output, session) {
data <- reactiveValues(
lines = list()
)
observeEvent(input$input_add, {
current_lines <- length(data$lines)
n <- current_lines + 1
insertUI(selector = "#input_add_div_block",
where = "beforeEnd", # insert after last element
ui = fluidPage(
div(style="display:inline-block"), # div inline-block is used to get two input boxes on the same line
# Adding input field
numericInput(inputId = paste0("input_", n),
label = paste0(input$input_new_line, " - % of previous line"),
value = 10,
min = 0,
max = 100
),
actionButton(inputId = paste0("input_", n,"_source"),
label = "No source")
)
)
observeEvent(input[[paste0("input_", current_lines+1,"_source")]],{
update_source_UI(id = paste0("source",n), data = data, n = n)
update_source_Server(id = paste0("source",n), data = data, n = n, original_session = session)
})
})
})
update_source_UI <- function(id, data, label = "Update UI", n){
ns <- NS(id)
showModal(
modalDialog(
title = "Update source",
textInput(inputId = ns("new_source"), label = "Update the source",
value = "Assumption"),
actionButton(inputId = ns("add_source"),
label = "Update the source"),
"\n",
actionButton(inputId = ns("cancel"),
label = "Cancel"),
easyClose = TRUE,
footer = NULL
)
)
}
# Pop-up to change the source of the funnel line input
update_source_Server <- function(id, data, n, original_session){
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
# When the user clicks "Update the source", the source is updated
observeEvent(input$add_source,{
updateActionButton(session = original_session,
inputId = paste0("input_", n,"_source"),
label = paste0("Source: ", input$new_source))
removeModal()
data$button_status[[1]] <- FALSE
})
# When the user clicks "Cancel", the modal is removed without changes
observeEvent(input$cancel,{
removeModal()
})
}
)
}
A few points:
I've never seen showModule in the UI part, normally you use it in the server; it's interesting that it works nevertheless
at least in your example, n is always 1, therefore you don't have unique ids which leads to problems
I find passing session objects to modules to refer to something defined in the main server quite complicated
I propose to pack everything for one line into a module and then handle the logic there. I think it's easier and you already work with modules.
My take:
library(shiny)
one_line_UI <- function(id, input_new_line){
ns <- NS(id)
tagList(
div(style="display:inline-block"), # div inline-block is used to get two input boxes on the same line
# Adding input field
numericInput(inputId = ns("input_number"),
label = paste0(input_new_line(), " - % of previous line"),
value = 10,
min = 0,
max = 100
),
actionButton(inputId = ns("input_source"),
label = "No source")
)
}
# Pop-up to change the source of the funnel line input
one_line_Server <- function(id, data){
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
observeEvent(input$input_source, {
showModal(
modalDialog(
title = "Update source",
textInput(inputId = ns("new_source"), label = "Update the source",
value = "Assumption"),
actionButton(inputId = ns("add_source"),
label = "Update the source"),
"\n",
actionButton(inputId = ns("cancel"),
label = "Cancel"),
easyClose = TRUE,
footer = NULL
)
)
})
# When the user clicks "Update the source", the source is updated
observeEvent(input$add_source,{
updateActionButton(inputId = "input_source",
label = paste0("Source: ", input$new_source))
removeModal()
data$button_status[[1]] <- FALSE
})
# When the user clicks "Cancel", the modal is removed without changes
observeEvent(input$cancel,{
removeModal()
})
}
)
}
ui <- fluidPage(
div(id = "input_add_div_block"),
br(),
# Input for the new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
textInput(inputId = "input_new_line",
label = "Give description of new line")
),
# Adding a new line
div(style="display:inline-block", # div inline-block is used to get two input boxes on the same line
id = "input_add_div",
actionButton("input_add", "Add new line")
)
)
server <- function(input, output, session) {
data <- reactiveValues(
lines = list(),
n = 0
)
observeEvent(input$input_add, {
n <- data$n + 1
insertUI(selector = "#input_add_div_block",
where = "beforeEnd", # insert after last element
ui = one_line_UI(id = n,
input_new_line = reactive({input$input_new_line}))
)
one_line_Server(id = n, data = data)
data$n <- n
})
}
shinyApp(ui, server)
If you want more information, you can also check out my tutorial how to dynamically add modules.

How to save and load state with insertUI modules?

I'm trying to save and load state of a shiny app using bookmarks. However, it doesn't work and I wonder whether it is because of inserting dynamic UI. If there are other ways to save and load dynamically rendered ui and resulting output, that would be great too. I don't know where to start and this is as far as I could come.
Simple example
library(shiny)
ui <- function(request){fluidPage(
actionButton("add", "Add UI"),
bookmarkButton()
)}
# Server logic
server <- function(input, output, session) {
observeEvent(input$add, {
insertUI(
selector = "#add",
where = "afterEnd",
ui = textInput(paste0("txt", input$add),
"Insert some text")
)
})
}
# Complete app with UI and server components
shinyApp(ui, server, enableBookmarking = "server")
Complex example
library(shiny)
one_plotUI <- function(id) {
ns <- NS(id)
plotOutput(ns("plot"))
}
one_plot <- function(id, x, y, type, breaks, break_counts) {
moduleServer(
id,
function(input, output, session) {
output$plot <- renderPlot({
if (type == "scatter") {
plot(x, y)
} else {
if (breaks == "custom") {
breaks <- break_counts
}
hist(x, breaks = breaks)
}
})
}
)
}
ui <- fluidPage(
sidebarPanel(
bookmarkButton(),
selectInput("plotType", "Plot Type",
c(Scatter = "scatter", Histogram = "hist")
),
# Only show this panel if the plot type is a histogram
conditionalPanel(
condition = "input.plotType == 'hist'",
selectInput(
"breaks", "Breaks",
c("Sturges", "Scott", "Freedman-Diaconis", "[Custom]" = "custom")
),
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.breaks == 'custom'",
sliderInput("breakCount", "Break Count", min = 1, max = 50, value = 10)
)
),
actionButton("make_plot", "Insert new plot")
),
mainPanel(
div(id = "add_here")
)
)
server <- function(input, output) {
x <- rnorm(100)
y <- rnorm(100)
counter_plots <- 1
observeEvent(input$make_plot, {
current_id <- paste0("plot_", counter_plots)
# call the logic for one plot
one_plot(id = current_id,
x = x,
y = y,
type = input$plotType,
breaks = input$breaks,
break_counts = input$breakCount)
# show the plot
insertUI(selector = "#add_here",
ui = one_plotUI(current_id))
# update the counter
counter_plots <<- counter_plots + 1
})
}
shinyApp(ui, server, enableBookmarking = "server")
edit: Found another solution emulating what insertUI does but with renderUI:
library(shiny)
library(purrr)
ui <- function(request){fluidPage(
actionButton("add", "Add UI"),
uiOutput('dynamic_ui'),
bookmarkButton()
)}
# Server logic
server <- function(input, output, session) {
input_contents <- reactive({reactiveValuesToList(input)})
observeEvent(input$add, {
# a new ui will be rendered with one extra input each time add button is pressed
output$dynamic_ui <- renderUI({
map(1:input$add, ~textInput(inputId = paste0("txt", .x), label = paste0("txt", .x) ))
})
#add the old values, otherwise all the inputs will be empty agin.
input_contents() %>%
names() %>%
map(~ updateTextInput(session = session, inputId = .x, label = .x, value = input_contents()[[.x]]))
})
}
# Complete app with UI and server components
shinyApp(ui, server, enableBookmarking = "server")
insertUI might be broken. The only way i could "fix" it was to drop function(request) of the ui, that caused that all the values in the inputs have to be saved between stances (in state$values$input_restore). Also a warning is showed in the console, but it doesn't affect the functionality.
library(shiny)
library(tidyverse)
library(stringr)
ui <- fluidPage(
actionButton("add", "Add UI"),
uiOutput('restored_ui'), #this is very important
bookmarkButton())
# Server logic
server <- function(input, output, session) {
counter <- reactiveValues()
counter$n <- c(0) #This value is only used to initialize the object.
total_ui_count <- reactiveValues()
total_ui_count$info <- 0 #because input$add will reset to zero this will count the number of uis to remember.
#When bookmark button is pressed
onBookmark(function(state) {
state$values$currentCounter <- counter$n
state$values$input_restore <- reactiveValuesToList(input)
print(names(input) %>% str_subset('^txt'))
state$values$total_uis_to_restore <- counter$n[[length(counter$n)]]
})
#rerender the previous outputs and their values
onRestore(function(state) {
#restore values from previous state
counter$n <- state$values$currentCounter
vals <- state$values$input_restore
print(str_subset(names(vals), '^txt.*$')) #for debugging
total_ui_count$info <- state$values$total_uis_to_restore
print(total_ui_count$info)
#render back a ui with the previous values.
output$restored_ui <- renderUI({
str_subset(names(vals), '^txt.*$') %>%
sort(decreasing = TRUE) %>% #to avoid order reversal of the inputs
map(~ textInput(.x, label = .x, value = vals[[.x]])) #render the last inputs
})
})
observeEvent(input$add, {
#input$add starts as 1 in the next state (because ui is not wrapped in function(request)) that's why total_ui_count is present
counter$n <- c(counter$n, input$add + total_ui_count$info)
print(counter$n) #for debugging
insertUI(
selector = "#add",
where = "afterEnd",
ui = textInput(inputId = paste0("txt", counter$n[[length(counter$n)]]),
label = "Insert some text")
)})
}
# Complete app with UI and server components
shinyApp(ui, server, enableBookmarking = "server")

shiny module with observeEvent updates based on previous inputs

I have an app which creates boxes. Each box has a button that triggers a modal. The modal has inputs which the user changes and then a button which triggers an action based on those inputs (basically just uploading to a database). Because each box has a different specification, I wrote a module and then loop thru a list, creating a box for each element. This works fine.
However, the flow in the modal and observeEvent has a flaw: the first run thru I get the desired results, but on the second occasion in the same box (same id module), after pressing the modal button to update, it will not use the new inputs, but rather what happened in the first run. I am guessing it has something to do with the namespace/observeEvent combination as I might be triggering the event with a "stored" namespace? Would I need to somehow "flush" the namespace after every update? Anyway, any help appreciated as it gets confusing fast with all the namespace/modules combinations.
library(shiny)
library(shinyWidgets)
ui <- navbarPage(
'page', collapsible = TRUE,
tabPanel("test",
useSweetAlert(),
sidebarLayout(
sidebarPanel(),
mainPanel(
uiOutput('all_products_ui')
)
)
)) # end navbar
server <- shinyServer(function(input, output) {
list_products <- c(1,2,3,4,5)
# Now, I will create a UI for all the products
output$all_products_ui <- renderUI({
r <- tagList()
progress_move <- 0
for(k in 1:length( list_products )){
r[[k]] <- ExistingProductUI(id = k, product = list_products[[k]] )
}
r
})
# handlers duplicate a call to module depending on the id of ExistingProductUI
handlers <- list()
observe(
handlers <<- lapply(seq.int(length( list_products )),
function(i) {
callModule(ExistingProductUpdate,
id = i,
product = list_products[[i]] )
})
)
handlers
}) # end of server ----
# UI module ------------------------------------------------------
ExistingProductUI <- function(id, product){
ns <- NS(id)
box(title = as.character(p$title),
product["title"],
footer = tagList(
actionBttn(
inputId = ns("change_selected"), label = "change"),
)
)
}
# server module ------------------------------------------------------
ExistingProductUpdate <- function(input, output, session, product){
ns <- session$ns
observeEvent(input$change_selected, {
# when box button is clicked for this product (id)
# FIRST: show a modal
showModal(
modalDialog(
title = "what do you want to change?",
tagList(
radioGroupButtons(inputId = ns("change_selected_choice"), labels = "change x", choices = c(1,2,3,4)),
sliderInput(ns("change_selected_pct"), "change y:", min = -50, max = 100, value = 0, step = 5)
),
easyClose = TRUE,
footer = tagList(
actionButton(ns("change_selected_submit"), "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
# SECOND: when change_selected_submit is clicked,
observeEvent(input$change_selected_submit, {
# do some calculations with product using what I inputed in modal ---
# then, update a table ----
functionToUploadThings(product, input$change_selected_choice)
# THIRD: Close with a confirmation
sendSweetAlert(
session,
title = "Success!",
type = "success",
btn_labels = "Ok",
closeOnClickOutside = TRUE,
width = NULL
)
})
})
}
Below is a solution that works. The problem was that you nested your observeEvent in the module. I'm not entirely sure why this led to problems, some values weren't processed correctly. However, you don't need to nest the observeEvent, the second one gets also triggered by the actionButton in the modal when it is by its own. Additionally, I included a removeModal before the success notification is shown:
library(shiny)
library(shinyWidgets)
library(shinydashboard)
ui <- navbarPage(
'page', collapsible = TRUE,
tabPanel("test",
useSweetAlert(),
sidebarLayout(
sidebarPanel(),
mainPanel(
uiOutput('all_products_ui')
)
)
)) # end navbar
server <- shinyServer(function(input, output) {
list_products <- c(1,2,3,4,5)
# Now, I will create a UI for all the products
output$all_products_ui <- renderUI({
r <- tagList()
progress_move <- 0
for(k in 1:length( list_products )){
r[[k]] <- ExistingProductUI(id = k, product = list_products[[k]] )
}
r
})
# handlers duplicate a call to module depending on the id of ExistingProductUI
handlers <- list()
observe(
handlers <<- lapply(seq.int(length( list_products )),
function(i) {
callModule(ExistingProductUpdate,
id = i,
product = list_products[[i]] )
})
)
handlers
}) # end of server ----
# UI module ------------------------------------------------------
ExistingProductUI <- function(id, product){
ns <- NS(id)
box(title = as.character(product),
product,
footer = tagList(
actionBttn(
inputId = ns("change_selected"), label = "change"),
)
)
}
# server module ------------------------------------------------------
ExistingProductUpdate <- function(input, output, session, product){
ns <- session$ns
observeEvent(input$change_selected, {
# when box button is clicked for this product (id)
# FIRST: show a modal
showModal(
modalDialog(
title = "what do you want to change?",
tagList(
radioGroupButtons(inputId = ns("change_selected_choice"), label = "change x", choices = c(1,2,3,4)),
sliderInput(ns("change_selected_pct"), "change y:", min = -50, max = 100, value = 0, step = 5)
),
easyClose = TRUE,
footer = tagList(
actionButton(ns("change_selected_submit"), "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
})
# SECOND: when change_selected_submit is clicked,
observeEvent(input$change_selected_submit, {
# do some calculations with product using what I inputed in modal ---
# then, update a table ----
# functionToUploadThings(product, input$change_selected_choice)
# THIRD: Close with a confirmation
removeModal()
sendSweetAlert(
session,
title = "Success!",
type = "success",
btn_labels = "Ok",
closeOnClickOutside = TRUE,
width = NULL
)
})
}
shinyApp(ui, server)
Please note: I made some modifications to make your MWE work:
include library(shinydashboard)
p$title and product["title"] to product
change labels to label in radioGroupButtons
comment out functionToUploadThings(product, input$change_selected_choice)
Edit
I'm still not super sure what happens when nesting the observeEvents. I made a small toy example and played around with the reactlog. It seems that nesting the observers generates a new observer for button2 every time button1 is clicked. These observers are not removed and lead to unwanted behaviour. In contrast, when using separate observeEvents, the observer for button2 is only created once.
library(shiny)
library(reactlog)
ui <- fluidPage(
actionButton("button1", "click")
)
server <- function(input, output, session) {
observeEvent(input$button1, {
print("from first observer")
print(input$button2)
showModal(
modalDialog(
title = "what do you want to change?",
"some text",
easyClose = TRUE,
footer = tagList(
actionButton("button2", "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
# nested observer -> leads to remaining observers
observeEvent(input$button2, {
print("from second observer")
print(input$button2)
removeModal()
})
})
# independent observer -> generates only one observer
# observeEvent(input$button2, {
# print("from second observer")
# print(input$button2)
# removeModal()
# })
}
shinyApp(ui, server)

Append / remove input text (words) in Shiny without overwriting

I want to be able to add or remove new words every time I click the "Add words"/"Remove words" buttons. But I want the app to save the previously added/removed words. For example, if I add 'hello' as my first word, and then I add 'bye', I want my vector of words to be ['hello', 'bye']. If I then remove 'hello', my vector should be ['bye']
This is what I have been able to achieve so far
# Define UI ----------
ui <- fluidPage(
# Sidebar panel
sidebarLayout(
sidebarPanel(
selectInput('addrm',
label = h3('Remove or add words'),
choices = list('Remove words' = 1,
'Add words' = 2)),
textInput('words',
label = 'You can introduce multiple words separated by comma',
placeholder = 'Enter words...'),
uiOutput('button')
),
# Main panel
mainPanel(
textOutput('removeWords')
)
)
)
# Define server logic required ------------
server <- function(input, output){
output$button <- renderUI({
if (input$addrm == 1){
actionButton('button', label = 'Remove words')
} else{
actionButton('button', label = 'Add words')
}
})
stopwords <- c()
output$removeWords <- renderText({
input$button
isolate({ # Only runs when the button is clicked
stopwords <- unique(c(stopwords, unlist(strsplit(gsub(' ', '', input$words), ','))))
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Nevermind, I was able to find what I was looking for in the following post
Just in case anyone wants the answer:
# Define UI ----------
ui <- fluidPage(
# Sidebar panel
sidebarLayout(
sidebarPanel(
selectInput('addrm',
label = h3('Remove or add words'),
choices = list('Remove words' = 1,
'Add words' = 2)),
textInput('words',
label = 'You can introduce multiple words separated by comma',
placeholder = 'Enter words...'),
uiOutput('button')
),
# Main panel
mainPanel(
textOutput('removeWords')
)
)
)
# Define server logic required ------------
server <- function(input, output){
output$button <- renderUI({
if (input$addrm == 1){
actionButton('button', label = 'Remove words')
} else{
actionButton('button', label = 'Add words')
}
})
values <- reactiveValues()
values$stopwords <- c()
output$removeWords <- renderText({
input$button
isolate({ # Only runs when the button is clicked
values$stopwords <- unique(c(values$stopwords, unlist(strsplit(gsub(' ', '', input$words), ','))))
})
})
}
# Run the application
shinyApp(ui = ui, server = server)

R Shiny - Dynamically adding dependent inputs using insertUI

The app below contains an actionButton, Add, that inserts two inputs when clicked.
The first input is a selectInput with choices A and B. The second input is a textInput if the user selects A and a numericInput if they select B. I'm not sure how to capture this dependency.
I tried attaching an event handler (the second observeEvent in the code below) to each selectInput that listens to the value of that selectInput and renders the second input accordingly using renderUI. This doesn't work though. I am also wary about using a render function inside an observeEvent since I have read that using a render inside an observer is not good practice (not exactly sure why). It also looks messy.
The app:
library(shiny)
ui <- fluidPage(
actionButton('add', 'Add'),
div(id = 'placeholder')
)
server <- function(input, output, session) {
rv = reactiveValues(ctn = NULL)
observeEvent(input$add, {
rv$ctn = rv$ctn + 1
Id = function(id, ctn = rv$ctn) paste0(id, ctn)
insertUI(
selector = '#placeholder',
ui = div(
id = Id('div'),
selectInput(Id('letter'), 'Letter:', LETTERS[1:2]),
uiOutput(Id('input'))
)
)
observeEvent(Id('letter'), {
output[[Id('input')]] <- renderUI({
switch(
input[[Id('letter')]],
'A' = textInput(Id('text'), '', ''),
'B' = numericInput(Id('numeric'), '', '')
)
})
})
})
}
shinyApp(ui = ui, server = server)
The first UI chunk that is inserted works as expected - both inputs are rendered. However, in subsequent chunks (chunks 2 and 3 in the screenshot below) only the selectInput is rendered.
Here is a screenshot:
Below is a working code. The main problem was your ctn reactive value initialized to NULL, because NULL + 1 = numeric(0) and numeric(0) + 1 = numeric(0).
library(shiny)
ui <- fluidPage(
actionButton('add', 'Add'),
div(id = 'placeholder')
)
server <- function(input, output, session) {
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
paste0(id, ctn())
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
insertUI(
selector = '#placeholder',
ui = div(
id = Id()('div'),
selectInput(Id()('letter'), 'Letter:', LETTERS[1:2]),
uiOutput(Id()('input'))
)
)
})
observeEvent(ctn(), {
id <- Id()('input')
selection <- Id()('letter')
output[[id]] <- renderUI({
req(input[[Id()('letter')]])
switch(
input[[selection]],
'A' = textInput(Id()('text'), 'ENTER TEXT', ''),
'B' = numericInput(Id()('numeric'), 'ENTER NUMBER', '')
)
})
}, ignoreInit = TRUE)
}

Resources