cleaning up my understanding of Shiny modules - r

Question

I have a project and I would like to start modularising my code in my Shiny App. I would like to get my head around a few things regarding modules.
I can pass the UI modules to the user interface without any issue ui_MODULE and ui_MODULE_LOCATIONS. My problem arises when I try to pass the server module to the App server_location_dropdown_filter. How can I fix this issue?
My modules are called ui_MODULE("myMODUEL") and ui_MODULE_LOCATIONS("myMODULE2") - I know the myMODULE and myMODULE2 are passed to the NS but I am still having a little difficulty understanding how this part works intuitively - I thought we could reuse the modules by calling them again but this time passing a new NS to the module - i.e. in the App I pass ui_MODULE_LOCATIONS("USE_AGAIN") - but I do not get the location dropdowns again... How can I correctly re-use the modules?
I would like to understand a bit better how I can correctly modularise my projects. I read a lot about modules online but I find it easier to learn by applying it to my own code. Can you help modularise the following App?
Shiny App:
library(bslib)
library(shiny)
library(dplyr)
library(tidyr)
library(reactable)
################ GENERATE DATA ##############################
# Define the US states and cities
us_states <- c("Alabama", "Alaska", "Arizona", "Arkansas", "California")
alabama_cities <- c("Birmingham", "Huntsville", "Mobile", "Montgomery", "Tuscaloosa")
alaska_cities <- c("Anchorage", "Fairbanks", "Juneau", "Sitka", "Wasilla")
arizona_cities <- c("Phoenix", "Tucson", "Mesa", "Chandler", "Scottsdale")
arkansas_cities <- c("Little Rock", "Fort Smith", "Fayetteville", "Springdale", "Jonesboro")
california_cities <- c("Los Angeles", "San Francisco", "San Diego", "San Jose", "Fresno")
# Set the seed for reproducibility
set.seed(123)
# Generate random price and quantity data
data <- tibble(
state = sample(us_states, 5000, replace = TRUE),
city = case_when(
state == "Alabama" ~ sample(alabama_cities, 5000, replace = TRUE),
state == "Alaska" ~ sample(alaska_cities, 5000, replace = TRUE),
state == "Arizona" ~ sample(arizona_cities, 5000, replace = TRUE),
state == "Arkansas" ~ sample(arkansas_cities, 5000, replace = TRUE),
state == "California" ~ sample(california_cities, 5000, replace = TRUE)
),
price = runif(5000, 10, 100),
quantity = sample(1:10, 5000, replace = TRUE)
)
#############################################################
################# UI ###################
ui_MODULE <- function(id) {
ns <- NS(id)
tagList(
tags$div(
class = "panel-header",
numericInput("price", label = "Price?", value = 10, min = 1, step = 500),
numericInput("quantity", label = "Quantity?", value = 10000, min = 1, step = 50),
sliderInput("discount", label = "Discount", min = 0, max = 0.25, post = " %", value = 0.08, step = 0.001),
actionButton("compute", "Compute!")
)
)
}
################# UI LOCATIONS ###############
ui_MODULE_LOCATIONS = function(id){
ns <- NS(id)
tagList(
tags$div(
class = "panel-header-locations",
selectInput("stateSelect", label = "Select State Data", choices = c()),
selectInput("citySelect", label = "Select City Variable", choices = c()),
)
)
}
################## SERVER MODUEL ############
# This doesn't work correctly...
server_location_dropdown_filter <- function(id){
moduleServer(id, function(input, output, session){
# Changes with changes in the slider input
updatedTable = reactive(
data %>%
filter(state == input$stateSelect) %>%
filter(city == input$citySelect)
)
output$table = DT::renderDT({
updatedTable()
})
})
}
############### FUNCTIONS ###################
myFUNCTION = function(interest){
data %>%
mutate(
p_q = price * quantity,
someOtherCalc = p_q*interest
)
}
# myFUNCTION(0.08)
#############################################
ui <- bootstrapPage(
theme = bs_theme(version = 5, bootswatch = 'minty'),
#titlePanel("Old Faithful Geyser Data"),
navbarPage("App Title",
tabPanel("Plot",
fluidPage(
fluidRow(
column(6,
##### UI #######
ui_MODULE("myMODUEL")
),
column(6,
#### UI Locations ####
ui_MODULE_LOCATIONS("myMODULE2")
)
),
fluidRow(
column(6,
DT::DTOutput('table')
),
column(6,
DT::DTOutput('newTableOUT')
)
)
)
),
tabPanel("use_UI_Again",
fluidPage(
fluidRow(
column(12,
ui_MODULE_LOCATIONS("USE_AGAIN")
)
)
)
)
)
)
server <- function(input, output, session) {
# (1) First observe the states unique values in the data
observe({
choices = data %>% select(state) %>% unique() %>% pull(state)
updateSelectInput(
session,
"stateSelect",
choices = choices
)
})
## (2) ## The cities are then updated to reflect the states selection
observeEvent(input$stateSelect,{
choices = data %>% filter(state == input$stateSelect) %>% select(city) %>% unique() %>% pull(city)
updateSelectInput(
session,
"citySelect",
choices = choices
)
})
#server_location_dropdown_filter("myFILTERS") # here I can't get this working...so I have to run the updatedTable and output$table here
updatedTable = reactive(
data %>%
filter(state == input$stateSelect) %>%
filter(city == input$citySelect)
)
output$table = DT::renderDT({
updatedTable()
})
# Now I want to update the table by using a function...
newTable = reactive(
updatedTable() %>%
myFUNCTION(input$discount)
)
output$newTableOUT = DT::renderDT({
newTable()
})
}
shinyApp(ui = ui, server = server)

Answer 1

You have a few issues. First, you need to use namespace (ns) for each inputID in the module UIs. Second, you need to define a server module to return the input variables from ui_MODULE. Lastly, if you wish to call a ui module again, you need to call the corresponding server module again.
Try this
library(bslib)
library(shiny)
library(dplyr)
library(tidyr)
library(reactable)
library(DT)
################ GENERATE DATA ##############################
# Define the US states and cities
us_states <- c("Alabama", "Alaska", "Arizona", "Arkansas", "California")
alabama_cities <- c("Birmingham", "Huntsville", "Mobile", "Montgomery", "Tuscaloosa")
alaska_cities <- c("Anchorage", "Fairbanks", "Juneau", "Sitka", "Wasilla")
arizona_cities <- c("Phoenix", "Tucson", "Mesa", "Chandler", "Scottsdale")
arkansas_cities <- c("Little Rock", "Fort Smith", "Fayetteville", "Springdale", "Jonesboro")
california_cities <- c("Los Angeles", "San Francisco", "San Diego", "San Jose", "Fresno")
# Set the seed for reproducibility
set.seed(123)
# Generate random price and quantity data
data <- tibble(
state = sample(us_states, 5000, replace = TRUE),
city = case_when(
state == "Alabama" ~ sample(alabama_cities, 5000, replace = TRUE),
state == "Alaska" ~ sample(alaska_cities, 5000, replace = TRUE),
state == "Arizona" ~ sample(arizona_cities, 5000, replace = TRUE),
state == "Arkansas" ~ sample(arkansas_cities, 5000, replace = TRUE),
state == "California" ~ sample(california_cities, 5000, replace = TRUE)
),
price = runif(5000, 10, 100),
quantity = sample(1:10, 5000, replace = TRUE)
)
#############################################################
################# UI ###################
ui_MODULE <- function(id) {
ns <- NS(id)
tagList(
tags$div(
class = "panel-header",
numericInput(ns("price"), label = "Price?", value = 10, min = 1, step = 500),
numericInput(ns("quantity"), label = "Quantity?", value = 10000, min = 1, step = 50),
sliderInput(ns("discount"), label = "Discount", min = 0, max = 0.25, post = " %", value = 0.08, step = 0.001),
actionButton(ns("compute"), "Compute!")
)
)
}
server_module <- function(id){
moduleServer(id, function(input, output, session){
rv <- reactiveValues()
observe({
rv$price <- input$price
rv$discount <- input$discount
})
return(rv)
})
}
################# UI LOCATIONS ###############
ui_MODULE_LOCATIONS = function(id){
ns <- NS(id)
tagList(
tags$div(
class = "panel-header-locations",
selectInput(ns("stateSelect"), label = "Select State Data", choices = c()),
selectInput(ns("citySelect"), label = "Select City Variable", choices = c()),
)
)
}
################## SERVER MODUEL ############
# This doesn't work correctly...
server_location_dropdown_filter <- function(id){
moduleServer(id, function(input, output, session){
# Changes with changes in the slider input
# (1) First observe the states unique values in the data
observe({
choices = data %>% select(state) %>% unique() %>% pull(state)
updateSelectInput(
session,
"stateSelect",
choices = choices
)
})
## (2) ## The cities are then updated to reflect the states selection
observeEvent(input$stateSelect,{
choices = data %>% filter(state == input$stateSelect) %>% select(city) %>% unique() %>% pull(city)
updateSelectInput(
session,
"citySelect",
choices = choices
)
})
updatedTable = reactive(
data %>%
filter(state == input$stateSelect) %>%
filter(city == input$citySelect)
)
return(updatedTable)
})
}
############### FUNCTIONS ###################
myFUNCTION <- function(data,interest){
df <- data %>%
dplyr::mutate(p_q = price * quantity) %>%
dplyr::mutate(
someOtherCalc = p_q * interest
)
return(df)
}
# myFUNCTION(0.08)
#############################################
ui <- bootstrapPage(
theme = bs_theme(version = 5, bootswatch = 'minty'),
#titlePanel("Old Faithful Geyser Data"),
navbarPage("App Title",
tabPanel("Plot",
fluidPage(
fluidRow(
column(6,
##### UI #######
ui_MODULE("myMODULE")
),
column(6,
#### UI Locations ####
ui_MODULE_LOCATIONS("myMODULE2")
)
),
fluidRow(
column(6,
DT::DTOutput('table')
),
column(6,
DT::DTOutput('newTableOUT')
)
)
)
),
tabPanel("use_UI_Again",
fluidPage(
fluidRow(
column(6,
ui_MODULE("USE_AGAIN")
),
column(6,
ui_MODULE_LOCATIONS("USE_AGAIN2")
)
),
fluidRow(
column(6,
DT::DTOutput('table2')
),
column(6,
DT::DTOutput('newTableOUT2')
)
)
)
)
)
)
server <- function(input, output, session) {
updatedTable <- server_location_dropdown_filter("myMODULE2")
output$table = DT::renderDT({
updatedTable()
})
values <- server_module("myMODULE")
newTable = reactive({
req(updatedTable(),values$discount)
myFUNCTION(updatedTable(),values$discount)
})
output$newTableOUT = DT::renderDT({
newTable()
})
### USE MODULES again
updatedTable2 <- server_location_dropdown_filter("USE_AGAIN2")
output$table2 = DT::renderDT(updatedTable2())
values2 <- server_module("USE_AGAIN")
newTable2 = reactive({
req(updatedTable2(),values2$discount)
myFUNCTION(updatedTable2(),values2$discount)
})
output$newTableOUT2 = DT::renderDT(newTable2())
}
shinyApp(ui = ui, server = server)