Reputation: 552
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)
Upvotes: 1
Views: 1079
Reputation: 7635
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)
Upvotes: 2