How to dynamically update dropdown within a modulized shinyalert for each iteration of a for loop, when using html = TRUE? - r

I'm creating a shiny module, where I wish to display some pop-up messages to the user via shinyalerts and include dropdown menus via htlm = TRUE and shinyWidgets::pickerInput. For each shinyalert the options should be different and the alerts should appear right after each other when the user has selected the relevant option.
However, when running the shinyalerts within a for loop, only the first alert shows the drop-down, the following does not. Please have a look at the example below and screenshots. Any ideas what I'm doing wrong?
Module UI:
mod_match_columns_ui <- function(id){
ns <- NS(id)
tagList(
shinyalert::useShinyalert(),
actionButton(ns("run"), label = "Start!")
)
}
Module server:
mod_match_columns_server <- function(input, output, session){
ns <- session$ns
options <- list(c("option_1","option_2"),
c("option_3","option_4"))
observeEvent(input$run, {
for(col in 1:2){
nms <- options[[i]]
output[[paste0("dropdown",col)]] <- renderUI({
shinyWidgets::pickerInput(
inputId = ns(paste0("options",col)),
label = "Options listed below",
choices = nms,
selected = "",
multiple = FALSE,
options = shinyWidgets::pickerOptions(size = 15)
)
})
shinyalert::shinyalert(
title = "Pick an option!",
html = TRUE,
text = tagList(
uiOutput(ns(paste0("dropdown", col)))
),
inputId = ns(paste0("modal", col))
)
}
})
}
Run module:
library(shiny)
ui <- fluidPage(
mod_match_columns_ui("match_columns_ui_1")
)
server <- function(input, output, session) {
callModule(mod_match_columns_server, "match_columns_ui_1")
}
shinyApp(ui = ui, server = server)
First iteration:
Second iteration:
Why is the dropdown not shown in the second iteration?? Thanks

Try this
library(shiny)
library(shinyalert)
mod_match_columns_ui <- function(id){
ns <- NS(id)
tagList(
shinyalert::useShinyalert(),
actionButton(ns("run"), label = "Start!")
)
}
mod_match_columns_server <- function(id) {
moduleServer(id,
function(input, output, session) {
ns <- session$ns
options <- list(c("option_1","option_2"),
c("option_3","option_4"))
lapply(1:2, function(col){
output[[paste0("dropdown",col)]] <- renderUI({
shinyWidgets::pickerInput(
inputId = ns(paste0("options",col)),
label = paste("Options",col,"listed below"),
choices = options[[col]],
selected = "",
multiple = FALSE,
options = shinyWidgets::pickerOptions(size = 15)
)
})
})
observeEvent(input$run, {
shinyalert::shinyalert(
title = "Pick an option!",
html = TRUE,
text = tagList(
lapply(1:2, function(i){uiOutput(ns(paste0("dropdown",i)))})
)
# callbackR = function(x) { message("Hello ", x) },
# inputId = ns(paste0("modal"))
)
})
observe({
print(input$options1)
print(input$options2)
print(input$shinyalert)
})
})
}
ui <- fluidPage(
tagList(
mod_match_columns_ui("match_columns_ui_1")
)
)
server <- function(input, output, session) {
mod_match_columns_server("match_columns_ui_1")
}
shinyApp(ui = ui, server = server)

Related

Best practices for returning a server-side generated value from a Shiny module?

Consider the following example application:
library(shiny)
library(shinyWidgets)
module_UI <- function(id){
tagList(
div(
uiOutput(
outputId = NS(id, "selection")
),
shinyWidgets::dropdown(
uiOutput(outputId = NS(id, "new_option")),
style = "unite",
label = "New",
color = "primary",
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutRightBig
),
up = F,
width = "600px",
inline = T
)
)
)
}
module_server <- function(id){
moduleServer(id, function(input, output, session){
ns <- session$ns
return_values <- reactiveValues(selection=NULL)
output$selection <- renderUI({
selectInput(inputId = ns("selection"), label = "Select:", choices = 1:5)
})
output$new_option <- renderUI({
div(
numericInput(ns("new_option_input"), label = "Add a new option:"),
shinyWidgets::actionBttn(
inputId = ns("submit_new_option"),
label = "Submit",
icon = icon("paper-plane"))
)
})
observeEvent(input$submit_new_option, {
#does not work as intended
updateSelectInput(session = session, inputId = "selection", selected = input$new_option_input)
})
observe({
return_values$selection <- input$selection
})
return(return_values)
})
}
# Define UI for application that draws a histogram
ui <- fluidPage(
title = "Test App",
module_UI("test"),
verbatimTextOutput(outputId = "selection_chosen")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
picker <- module_server("test")
output$selection_chosen <- renderText({
picker$selection
})
}
# Run the application
shinyApp(ui = ui, server = server)
Basically, the module should do two things:
Allow user to select a pre-existing option --> return that value from module
Allow user to create their own, new option --> return that value from module
I have #1 working, but am struggling on #2. Specifically, where I have the "does not work" comment. How can I achieve this functionality? What are/is the best practice(s) for returning server-side created values from a Shiny module? This is an example app; the real one involves reading the selectInput options from a database, as well as saving the newly created options in the database. Appreciate any help on this! A lot of SO answers regarding Shiny modules have the older callModule(...) syntax, which makes researching this topic a bit more confusing.
You just need to provide the default value in numericInput. Perhaps you are looking for this.
library(shiny)
library(shinyWidgets)
module_UI <- function(id){
ns <- NS(id)
tagList(
div(
uiOutput(
outputId = NS(id, "selection")
),
shinyWidgets::dropdown(
uiOutput(outputId = NS(id, "new_option")),
style = "unite",
label = "New",
color = "primary",
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutRightBig
),
up = F,
width = "600px",
inline = T
),
DTOutput(ns("t1"))
)
)
}
module_server <- function(id){
moduleServer(id, function(input, output, session){
ns <- session$ns
return_values <- reactiveValues(selection=NULL,myiris = iris)
output$selection <- renderUI({
selectInput(inputId = ns("selection"), label = "Select:", choices = 1:5)
})
output$new_option <- renderUI({
tagList(
numericInput(ns("new_option_input"), label = "Add a new option:",10, min = 1, max = 100),
shinyWidgets::actionBttn(
inputId = ns("submit_new_option"),
label = "Submit",
icon = icon("paper-plane"))
)
})
observeEvent(input$submit_new_option, {
return_values$myiris <- iris[1:input$new_option_input,]
#does work as intended
updateSelectInput(session = session, inputId = "selection", choices= c(1:input$new_option_input), selected = input$new_option_input)
})
output$t1 <- renderDT({return_values$myiris})
observe({
return_values$selection <- input$selection
})
return(return_values)
})
}
# Define UI for application that draws a histogram
ui <- fluidPage(
title = "Test App",
module_UI("test"),
verbatimTextOutput(outputId = "selection_chosen"),
DTOutput("t2")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
picker <- module_server("test")
output$selection_chosen <- renderText({
picker$selection
})
output$t2 <- renderDT({picker$myiris[,c(3:5)]})
}
# Run the application
shinyApp(ui = ui, server = server)

Having difficulty nesting action button inside bs4card

I am trying to build a modular shiny app and one important component in the app is bs4cards that have a dropdown menu and the in the menu there is a save button that will save the content of the card.
Here is the code for the two modules that I build. The bs4card module will contain the actionbttn module.
mod_actionbttn_ui <- function(id){
ns <- NS(id)
tagList(
uiOutput(ns("button"))
)
}
#' valuebox Server Functions
#'
#'
mod_actionbttn_server <- function(id, label, icon, style, size, block){
moduleServer(id, function(input, output, session){
output$button <- renderUI({
actionBttn(
label = req(rlabel()),
icon = req(ricon()),
style = req(rstyle()),
color = req(zsize()),
block = req(rblock())
)
})
rlabel <- reactive(label)
ricon <- reactive(icon)
rstyle <- reactive(style)
rsize <- reactive(size)
rblock <- reactive(block)
})
}
mod_bs4card_ui <- function(id){
ns <- NS(id)
tagList(
uiOutput(ns("card")),
mod_actionbttn_ui(ns("button"))
)
}
#' valuebox Server Functions
#'
#'
mod_bs4card_server <- function(id, title, status){
moduleServer(id, function(input, output, session){
output$card <- renderUI({
bs4Card(title = req(rtitle()),
status = req(rstatus()),
solidHeader = TRUE,
width = NULL,
collapsible = TRUE,
collapsed = TRUE,
closable = TRUE,
maximizable = TRUE,
dropdownMenu = mod_actionbttn_server("button"))
})
rtitle <- reactive(title)
rstatus <- reactive(status)
})
}
ui <- bs4DashPage(header = bs4DashNavbar(),
sidebar = bs4DashSidebar(),
body = fluidRow(
column(
width = 12,mod_bs4card_ui("bs4c")))
)
server <- function(input,output,session){
mod_bs4card_server("bs4c",
title = "Some Title",
status = "navy")
}
shinyApp(ui = ui, server = server)
The major problem is how to pass the parameters for the action button, I mean the label, icon, style,style and so on.
I am not sure what you looking for. The following works, but you need to update it to your needs.
library(bs4Dash)
mod_actionbttn_ui <- function(id){
ns <- NS(id)
tagList(
uiOutput(ns("button"))
)
}
#' valuebox Server Functions
#'
#'
mod_actionbttn_server <- function(id, label, status, zsize, block){
moduleServer(id, function(input, output, session){
ns <- session$ns
output$button <- renderUI({
actionBttn(inputId = ns("btn4"),
label = "My actionbttn",
#icon = icon("sliders"),
style = "float",
color = req(status()),
size = zsize,
block = block
)
})
return(reactive(input$btn4))
})
}
mod_bs4card_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(column(6, uiOutput(ns("card")) ,
mod_actionbttn_ui(ns("button"))
)),
)
}
#' valuebox Server Functions
#'
mod_bs4card_server <- function(id, title, status){
moduleServer(id, function(input, output, session){
rtitle <- reactive(title)
rstatus <- reactive(status)
mybtn4 <- mod_actionbttn_server("button",rtitle,rstatus,"lg",TRUE)
observe({print(mybtn4())})
output$card <- renderUI({
bs4Card(title = req(rtitle()),
status = req(rstatus()),
solidHeader = TRUE,
width = 12,
collapsible = TRUE,
collapsed = TRUE,
closable = TRUE,
maximizable = TRUE,
#dropdownMenu = mod_actionbttn_server("button",rtitle,rstatus,"lg",TRUE)
p("My Box Content",mybtn4())
)
})
})
}
ui <- bs4DashPage(header = bs4DashNavbar(),
sidebar = bs4DashSidebar(),
body = bs4DashBody(fluidRow(
column(width = 12,mod_bs4card_ui("bs4c"))))
)
server <- function(input,output,session){
mod_bs4card_server("bs4c",
title = "Some Title",
status = "primary")
}
shinyApp(ui = ui, server = server)

How to bookmark and restore dynamically added modules?

I am trying to save and restore an app that uses modules which render UI outputs dynamically.
I hoped the bookmarking function would work with the app and I added the bookmarkButton and enabled bookmarking using enableBookmarking = "server". I've also made the ui a function. I learned that bookmarking works with modules, but I'm unable to find a way to get it working with dynamically created UI inputs and outputs. Only the last input and output are restored. The others are not restored.
Example app:
library(shiny)
histogramUI <- function(id) {
tagList(
fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars)),
numericInput(NS(id, "bins"), "bins", value = 10, min = 1)),
column(8, plotOutput(NS(id, "hist"))))
)
}
histogramServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = input$bins, main = input$var)
}, res = 96)
})
}
ui <- function(request){
fluidPage(
bookmarkButton(),
actionButton("add", "Add"),
div(id = "add_here")
)
}
server <- function(input, output, session) {
observeEvent(input$add, {
histogramServer(paste0("hist_", input$add))
insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add)))
})
}
shinyApp(ui, server, enableBookmarking = "server")
Only the last input and plot output are restored:
One would expect all module instances to be restored, but as you pointed out, only the last one is restored due to addbutton restoration.
As a workaround, you could store the module instances list stored in state$exclude with onBookmark and re-create the instances of the module with onRestore.
histogramUI was modified in order to accept var,bins as new parameters for creation of the modules.
Another important point is to use setBookmarkExclude so that the add button doesn't create the last module at restoration. As the button isn't anymore bookmarked, it's value should be also be saved with onBookmark.
Try:
library(shiny)
histogramUI <- function(id,var,bins) {
tagList(
fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars),selected=var),
numericInput(NS(id, "bins"), "bins", value = bins, min = 1)),
column(8, plotOutput(NS(id, "hist"))))
)
}
histogramServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = input$bins, main = input$var)
}, res = 96)
})
}
ui <- function(request){
fluidPage(
bookmarkButton(),
actionButton("add", "Add Histogram"),
div(id = "add_here")
)
}
server <- function(input, output, session) {
add_id <- reactiveVal(0) # To save 'add' button state
setBookmarkExclude('add') # Don't add new module at restoration
observeEvent(input$add, {
histogramServer(paste0("hist_", input$add+add_id()))
insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add+add_id()),'mpg',10))
})
onBookmark(function(state) {
modules <- state$exclude
state$values$modules <- modules[grepl("hist",modules)] # only 'hist' (without 'add')
state$values$add <- state$input$add + add_id() # add button state
})
onRestore(function(state){
# Restore 'add' last state
add_id(state$values$add)
# Restore 'hist' modules
modules <- state$values$modules
if (length(modules)>0) {
for (i in 1:(length(modules))) {
histogramServer(modules[i])
insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
}
}
})
}
shinyApp(ui, server, enableBookmarking = "server")
Another way to do it:
library(shiny); library(purrr)
histogramUI <- function(id) {
ns <- NS(id)
tagList(
fluidRow(column( 4, selectInput(ns("var"), "Variable", choices = names(mtcars)),
numericInput(ns("bins"), "bins", value = 10, min = 1)),
column(8, plotOutput(ns("hist"))))
)
}
histogramServer <- function(id) {
moduleServer(id, function(input, output, session) {
vals <- reactiveValuesToList(input)
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = input$bins, main = input$var)
}, res = 96)
#to avoid inputs resetting after adding another.
if(length(vals) != 0) {
updateSelectInput(session, 'var', "Variable", choices = names(mtcars), selected = vals$var)
updateNumericInput(session, 'bins', "bins", value = input$bins, min = 1,)
}
})
}
ui <- function(request){
fluidPage(
bookmarkButton(),
actionButton("add", "Add"),
uiOutput('histogram_module')
)
}
server <- function(input, output, session) {
observeEvent(input$add, {
#the server module
map(1:input$add, ~histogramServer(paste0("hist_", .x)))
#the ui module
output$histogram_module <- renderUI({ map(1:input$add, ~histogramUI(id = paste0("hist_", .x))) })
})
}
shinyApp(ui, server, enableBookmarking = "server")

I cant get a shiny module to work as a server . Only works when the server is separated as a separate set of commands

I have a shiny module and I'm having a huge issue getting it to work. I'm trying to create a dashboard with multiple tabs and am exploring modules to reduce the amount of duplication.
I can get the application to work if I hardcode the server explicitly with the code but when I create modules for the server part it doesn't won't work. I would really appreciate any help as I have tried looking everywhere for a workable example, Below is a reproducible example of a proportion of the code that I would like to modulize,
datasetInput <- function(id, Taxhead = NULL) {
ns <- NS(id)
names <- colnames(mtcars)
if (!is.null(Taxhead)) {
pattern <- paste0(Taxhead)
names <-names$name[sapply(names, function(x){ grepl(pattern,x, ignore.case = TRUE)})] #### filter for a match
}
selectInput(ns("dataset"), "Pick a Report", choices = names)
}
#### Server 1
#### Collect the data set based on the selection in datasetInput
datasetServer <- function(id) {
moduleServer(id, function(input, output, session) {
#### Outputs the data set
#### reactive( read.csv(paste0("Data/",input$dataset,".csv")) )
reactive( mtcars )
})}
#### Display the variables of interest
selectVarInput <- function(id){
ns <- NS(id)
tagList(
selectInput(ns("var"), "Select grouping Variables", choices = NULL, multiple = TRUE) ,
selectInput(ns("var2"), "Select Measure Variables", choices = NULL, multiple = TRUE)
) }
##### Server 2
#### Returns the data as a reactive
selectVarServer <- function(id, data) {
find_vars <- function(data, filter) { names(data)}
moduleServer(id, function(input, output, session) {
observeEvent(data(), {
updateSelectInput(session, "var", choices = find_vars(data()))
})
observeEvent(data(), {
updateSelectInput(session, "var2", choices = find_vars(data()))
})
reactive(data() %>% group_by(across(all_of(input$var))) %>% summarise(across(all_of(input$var2),sum), n = n()))
})}
selectDataVarUI <- function(id, Taxhead =NULL) {
ns <- NS(id)
tagList(
datasetInput(ns("data"), Taxhead ),
selectVarInput(ns("var"))
)}
#### Server 3
selectDataVarServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- datasetServer("data")
var <- selectVarServer("var", data)
var })}
Date_Range_UI <- function(id) {
ns <- NS(id)
# Sidebar to demonstrate various slider options ----
tagList(
# Sidebar with a slider input
# # Select form input for checking
radioButtons(ns("Period"),
label = "Select Desired Comparison Period",
choices = c( "Daily", "Monthly","Yearly"),
selected = "Monthly")
,
# Only show this panel if Monthly or Quarterly is selected
conditionalPanel(
condition = "input.Period != 'Yearly'", ns = ns,
dateRangeInput(ns('dateRange'),
label = 'Date range input',
start = Sys.Date()-180,
end = Sys.Date() ,
min = NULL, max = Sys.Date() ,
separator = " - ", format = "MM-yyyy",
startview = 'year', language = 'en', weekstart = 0,autoclose = TRUE))
,
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.Period == 'Yearly'", ns = ns,
sliderInput(ns("yearly"), "Years", min = 2000, max = as.integer(format(Sys.Date(),"%Y")), value = c(2008,2021), round = TRUE,step = 1)),
) ### close side bar layout
### close fluid page layout
}
Date_Range_Server <- function(id ) {
moduleServer(id,
function(input, output, session) {
x <- reactive({input$Period})
return(
list(
Startdate = reactive(if(x() == "Yearly") {input$yearly[1]
}
else if(x() == "Monthly") {
as.integer(format(input$dateRange[1],"%Y%m"))
}else{
as.integer(format(input$dateRange[1],"%Y%m%d"))})
,
Enddate = reactive(if(x() == "Yearly") {input$yearly[2]
}
else if(x() == "Monthly") {
as.integer(format(input$dateRange[2],"%Y%m"))
}else{
as.integer(format(input$dateRange[2],"%Y%m%d"))})
,
Choice = reactive(input$Period )))
})}
###### this won't work!
betting_UI <- function(id) {
ns <- NS(id)
sidebarLayout(
sidebarPanel(
Date_Range_UI("data_range"),
selectDataVarUI(id = "var", Taxhead =NULL)),
mainPanel(
tableOutput(ns("table")),
verbatimTextOutput (ns("test"))
)) }
Betting_Server <- function(input, output, session) {
date_range <- Date_Range_Server("data_range")
output$test <- renderPrint( date_range$Startdate())
output$table <- renderTable(var(), width = 40)
}
ui <- fluidPage(
betting_UI("betting")
)
server <- function(input, output, session) {
Betting_Server("betting")
}
shinyApp(ui, server)**
##### this works fine I thought putting the modules into the server would work as above?????
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
Date_Range_UI("data_range"),
selectDataVarUI(id = "var", Taxhead =NULL)),
mainPanel(
tableOutput("table"),
verbatimTextOutput ("test")
)) )
#### Server
server <- function(input, output, session) {
var <- selectDataVarServer("var")
date_range <- Date_Range_Server("data_range")
output$test <- renderPrint( date_range$Startdate())
output$table <- renderTable(var(), width = 40)
}
shinyApp(ui, server)
You have to use ns() in your module UI
betting_UI <- function(id) {
ns <- NS(id)
sidebarLayout(
sidebarPanel(
Date_Range_UI(ns("data_range")),
selectDataVarUI(id = ns("var"), Taxhead = NULL)
),
mainPanel(tableOutput(ns("table")),
verbatimTextOutput (ns("test")))
)
}
You also have to use moduleServer() to create the module server
Betting_Server <- function(id) {
moduleServer(id,
function(input, output, session) {
var <- selectDataVarServer("var")
date_range <- Date_Range_Server("data_range")
output$test <- renderPrint(date_range$Startdate())
output$table <- renderTable(var(), width = 40)
})
}

R Shiny: How to pass modules as parameters to other modules, and call those modules kin the new module

I am trying to decompose an unwieldy app that I have created, and in doing so I realize that I really need to modularize add/remove buttons. I want to be able to create a shiny module that has an add and remove button, and by clicking those buttons, we can add and remove an instance of another module. To make it simple, I have a toy example that has a simple module that just has a selectInput() IU with 3 choices. I want to be able to add as many of these selectInput() UI elements as desired and be able to access the results of these selections for use in the main server logic. So I created "firstUI()" and firstServer()" modules, as well as "addRmBtnUI()" and "addRmBtnServer()" modules. The addRmBtn modules accept parameters serverModToCall and uiModToCall, which are the names of the ui and server modules that we want to call with the addRmBtn modules. I seem to be getting tripped up on the passing of these modules as parameters to the addRmBtn modules. Code is below. How can I get this to work as intended? Thanks!
suppressWarnings(library(shiny))
firstUI <- function(id) {
ns <- NS(id)
tags$div(
fluidRow(
column(12,
uiOutput(ns("first"))
)
)
)
}
firstServer <- function(input, output, session) {
ns = session$ns
output$first <- renderUI({
selectInput(ns("select"), label = h4("Select"),
choices = list("Selection1" = 1, "Selection2" = 2,
"Selection3" = 3), selected = 1)
})
}
addRmBtnUI <- function(id) {
ns <- NS(id)
tags$div(
fluidRow(
column(2,
uiOutput(ns("insertParamBtn"))
),
column(2,
uiOutput(ns("removeParamBtn"))
)
),
hr(),
tags$div(id = 'placeholder')
)
}
addRmBtnServer <- function(input, output, session, serverModToCall, uiModToCall) {
ns = session$ns
params <- reactiveValues(btn = 0)
output$insertParamBtn <- renderUI({
actionButton(inputId = ns('insertParamBtn'),
label = "Add", offset = 3)
})
output$removeParamBtn <- renderUI({
actionButton(inputId = ns('removeParamBtn'),
label = "Remove", offset = 3)
})
params <- reactiveValues(btn = 0)
observeEvent(input$insertParamBtn, {
params$btn <- params$btn + 1
callModule(do.call(serverModToCall, args = list(id = params$btn)))
insertUI(
selector = '#placeholder',
ui = do.call(uiModToCall, args = list(id = params$btn)) #********# This line is issue
)
})
observeEvent(input$removeParamBtn, {
removeUI(
## pass in appropriate div id
selector = paste0('#param', params$btn)
)
params$btn <- params$btn - 1
})
}
ui <- function(request) {
fluidPage(
fluidRow(
addRmBtnUI(1)
),
fluidRow(
uiOutput("result")
)
)
}
server <- function(input, output, session) {
callModule(addRmBtnServer, id = 1,
serverModToCall = 'firstServer',
uiModToCall = 'firstUI')
res <- reactive({ })
output$result <- renderUI({
verbatimTextOutput(paste0(input[[NS(1, "select")]]), placeholder = T)
})
}
shinyApp(ui = ui, server = server)
It seems there were somme errors in the code
First, the call to firstServer was
callModule(do.call(firstServer, args = list(id = params$btn)))
which translates to
callModule(firstServer(params$btn))
callModule should however be invoked like this:
callModule(firstServer, params$btn)
The version below passes functions rather than function names, so the differences might be hard to spot at first glance.
Second, you need to namespace the ids for insertUI/removeUI. You can read more about this in the "nesting modules" section of this article.
## in addRmBtnServer/observe add button
insertUI(
selector = paste('#', ns('placeholder')),
ui = uiModToCall(ns(params$btn))
)
## in addRmBtnServer/observe remove button
removeFirstUI(ns(params$btn))
## in global scope
removeFirstUI <- function(id){
removeUI(selector = paste0('#', NS(id, "first") ))
}
Third, i am not sure what output$result was supposed to show, so I omitted it in the version below.
library(shiny)
firstUI <- function(id){uiOutput(NS(id, "first"))}
firstServer <- function(input, output, session){
output$first <- renderUI({
selectInput(session$ns("select"), h4("Select"), letters[1:4])
})
}
removeFirstUI <- function(id){
removeUI(selector = paste0('#', NS(id, "first")))
}
addRmBtnUI <- function(id) {
ns <- NS(id)
tags$div(
actionButton(inputId = ns('insertParamBtn'), label = "Add"),
actionButton(ns('removeParamBtn'), label = "Remove"),
hr(),
tags$div(id = ns('placeholder'))
)
}
addRmBtnServer <- function(input, output, session, moduleToReplicate) {
ns = session$ns
params <- reactiveValues(btn = 0)
observeEvent(input$insertParamBtn, {
params$btn <- params$btn + 1
callModule(moduleToReplicate$server, id = params$btn)
insertUI(
selector = paste0('#', ns('placeholder')),
ui = moduleToReplicate$ui(ns(params$btn))
)
})
observeEvent(input$removeParamBtn, {
moduleToReplicate$remover(ns(params$btn))
params$btn <- params$btn - 1
})
}
ui <- fluidPage(addRmBtnUI("addRm"))
server <- function(input, output, session) {
callModule(
addRmBtnServer, id = "addRm",
moduleToReplicate = list(
ui = firstUI,
server = firstServer,
remover = removeFirstUI
)
)
}
shinyApp(ui = ui, server = server)

Resources