13 Shiny modules for repeated structures
If you find yourself making nearly identical UIs or server functions over and over in the same app, you might benefit from modules. This is a way to define a pattern to use repeatedly.
Figure 13.1: Modules Demo App. You can also access this app with shinyintro::app("modules_demo")or view it in a separate tab with the showcase interface.
13.1 Modularizing the UI
The two tabPanels below follow nearly identical patterns. You can often identify a place where modules might be useful when you use a naming convention like "{base}_{type}" for the ids.
iris_tab <- tabPanel(
"iris",
selectInput("iris_dv", "DV", choices = names(iris)[1:4]),
plotOutput("iris_plot"),
DT::dataTableOutput("iris_table")
)
mtcars_tab <- tabPanel(
"mtcars",
selectInput("mtcars_dv", "DV", choices = c("mpg", "disp", "hp", "drat")),
plotOutput("mtcars_plot"),
DT::dataTableOutput("mtcars_table")
)The first step in modularising your code is to make a function that creates the UIs above from the base ID and any other changing aspects. In the example above, the choices are different for each selectInput(), so we'll make a function that has the arguments id and choices.
The first line of a UI module function is always ns <- NS(id), which creates a shorthand way to add the base id to the id type. So instead of the selectInput()'s name being "iris_dv" or "mtcars_dv", we set it as ns(dv). All ids need to use ns() to add the namespace to their ID.
tabPanelUI <- function(id, choices) {
ns <- NS(id)
tabPanel(
id,
selectInput(ns("dv"), "DV", choices = choices),
plotOutput(ns("plot")),
DT::dataTableOutput(ns("table"))
)
}Now, you can replace two tabPanel definitions with just the following code.
13.2 Modularizing server functions
In our original code, we have four functions that create the two output tables and two output plots, but these are also largely redundant.
output$iris_table <- DT::renderDataTable({
iris
})
output$iris_plot <- renderPlot({
ggplot(iris, aes(x = Species,
y = .data[[input$iris_dv]],
fill = Species)) +
geom_violin(alpha = 0.5, show.legend = FALSE) +
scale_fill_viridis_d()
})
output$mtcars_table <- DT::renderDataTable({
mtcars
})
output$mtcars_plot <- renderPlot({
# handle non-string grouping
mtcars$vs <- factor(mtcars$vs)
ggplot(mtcars, aes(x = vs,
y = .data[[input$mtcars_dv]],
fill = vs)) +
geom_violin(alpha = 0.5, show.legend = FALSE) +
scale_fill_viridis_d()
})The second step to modularising code is creating a server function. You can put all the functions the relate to the inputs and outputs in the UI function here, so we will include one to make the output table and one to make the output plot.
The server function takes the base id as the first argument, and then any arguments you need to specify things that change between base implementations. Above, the tables show different data and the plots use different groupings for the x axis and fill, so we'll add arguments for data and group_by.
A server function always contains moduleServer() set up like below.
tabPanelServer <- function(id, data, group_by) {
moduleServer(id, function(input, output, session) {
# code ...
})
}No you can copy in one set of server functions above, remove the base name (e.g., "iris_" or "mtcars_") from and inputs or outputs, and replace specific instances of the data or grouping columns with data and group_by.
tabPanelServer <- function(id, data, group_by) {
moduleServer(id, function(input, output, session) {
output$table <- DT::renderDataTable({
data
})
output$plot <- renderPlot({
# handle non-string groupings
data[[group_by]] <- factor(data[[group_by]])
ggplot(data, aes(x = .data[[group_by]],
y = .data[[input$dv]],
fill = .data[[group_by]])) +
geom_violin(alpha = 0.5, show.legend = FALSE) +
scale_fill_viridis_d()
})
})
}In the original code, the grouping variables were unquoted, but it's tricky to pass unquoted variable names to custom functions, and we already know how to refer to columns by a character object using .data[[char_obj]].
The grouping column Species in iris is already a factor, but recasting it as a factor won't hurt, and is required for the mtcars grouping column vs.
Now, you can replace the four functions inside the server function with these two lines of code.
tabPanelServer("iris", data = iris, group_by = "Species")
tabPanelServer("mtcars", data = mtcars, group_by = "vs")Our example only reduced our code by 4 lines, but it can save a lot of time, effort, and debugging on projects with many similar modules. For example, if you want to change the plots in your app to use a different geom, now you only have to change one function instead of two.
13.4 Exercises
Repeat Example
Try to implement the code above on your own.
- Clone "no_modules_demo"
shinyintro::clone("no_modules_demo") - Run the app and see how it works
- Create the UI module function and use it to replace
iris_tabandmtcars_tab - Create the server function and use it to replace the server functions
New Instance
Add a new tab called "diamonds" that visualises the diamonds dataset. Choose the columns you want as choices in the selectInput() and the grouping column.
You can choose any of the numeric columns for the choices.
diamonds_tab <- tabPanelUI("diamonds", c("carat", "depth", "table", "price"))You can group by any of the categorical columns: cut, color, or clarity.
tabPanelServer("diamonds", data = diamonds, group_by = "cut")Altering modules
- Add another
selectInput()to the UI that allows the user to select the grouping variable. (irisonly has one possibility, butmtcarsanddiamondsshould have several)
You need to add a new selectInput() to the tabPanel(). Remember to use ns() for the id. The choices for this select will also differ by data set, so you need to add group_choices to the arguments of this function.
tabPanelUI <- function(id, choices, group_choices) {
ns <- NS(id)
tabPanel(
id,
selectInput(ns("dv"), "DV", choices = choices),
selectInput(ns("group_by"), "Group By", choices = group_choices),
plotOutput(ns("plot")),
DT::dataTableOutput(ns("table"))
)
}- Update the plot function to use the value of this new input instead of "Species", "vs", and whatever you chose for
diamonds.
You no longer need group_by in the arguments for this function because you are getting that info from an input.
Instead of changing group_by to input$group_by in three places in the code below, I just added the line group_by <- input$group_by at the top of moduleServer().
tabPanelServer <- function(id, data) {
moduleServer(id, function(input, output, session) {
group_by <- input$group_by
# rest of the code is the same ...
})
}New module
There is a fluidRow() before the tabsetPanel() in the ui that contains three infoBoxOutput() and three renderInfoBoxOutput() functions in the server function.
Modularise the info boxes and their associated server functions.
infoBoxUI <- function(id, width = 4) {
ns <- NS(id)
infoBoxOutput(ns("box"), width)
}
infoBoxServer <- function(id, title, fmt, icon, color = "purple") {
moduleServer(id, function(input, output, session) {
output$box <- renderInfoBox({
infoBox(title = title,
value = format(Sys.Date(), fmt),
icon = icon(icon),
color = color)
})
})
}In the ui, replace the fluidRow() with this:
fluidRow(
infoBoxUI("day"),
infoBoxUI("month"),
infoBoxUI("year")
)In server(), replace the three renderInfoBox() with this:
infoBoxServer("year", "Year", "%Y", "calendar")
infoBoxServer("month", "Month", "%m", "calendar-alt")
infoBoxServer("day", "Day", "%d", "calendar-day")