The module module

Level Up with Shiny for R

posit::conf(2024)

2024-08-12

You might not need a module

Why use Shiny modules?

Avoid repeating logic
Make your code more reusable

Why use functions?

Avoid repeating logic
Make your code more reusable

Why use Shiny modules?

Avoid repeating
Shiny UI/Server logic
Make your code more reusable
to Shiny app developers

Maybe you could use a function?

school |>
  filter(
    state == "CA",
    control == "Public",
  ) |>
  count() |>
  pull(n)
#> [1] 188

school |>
  filter(state == "CA") |>
  filter(control == "Public") |>
  count() |>
  pull(n)
#> [1] 188

school |>
  filter(state == "CA") |>
  filter(control == "Public") |>
  count() |>
  pull(n)
#> [1] 188

school |>
  filter(state == "CA") |>
  filter(control == "Nonprofit") |>
  count() |>
  pull(n)
#> [1] 275

school |>
  filter(state == "CA") |>
  filter(control == "Public") |>
  count() |>
  pull(n)
#> [1] 188

school |>
  filter(state == "CA") |>
  filter(control == "Nonprofit") |>
  count() |>
  pull(n)
#> [1] 275

school |>
  filter(state == "CA") |>
  filter(control == "For-profit") |>
  count() |>
  pull(n)
#> [1] 773

school_count_control <- function(school, control) {
  school |>
    filter(control == !!control) |>
    count() |>
    pull(n)
}

Note, { control } or !!control work here. When to embrace and when to double bang? Try one, if it doesn’t work, try the other.

Your Turn `_exercises/07_app.R`

06:00

Refactor the code for the two plots into a single function. You can put this function in this app file in the server section around the ## Put your function here ## line.
Replace the the duplicated code with your new function.
🤔 What logic is encapsulated in your function?
How could your function be used outside of this app?
How well will your function compose with other functions?

Maybe you could UI a function?

Pick your own defaults

card(
  layout_sidebar(
    sidebar = sidebar(
      position = "right",
      open = FALSE,
      selectInput("state", "State", choices = state.abb)
    ),
    plotOutput("plot_state")
  )
)

Pick your own defaults

sidebar_right <- function(...) {
  sidebar(
    position = "right",
    open = FALSE,
    ...
  )
}

card(
  layout_sidebar(
    sidebar = sidebar_right(
      selectInput("state", "State", choices = state.abb)
    ),
    plotOutput("plot_state")
  )
)

Make your own components

Let’s make a Bootstrap badge together.

#| standalone: true
#| components: [editor, viewer]
#| orientation: horizontal
#| viewerHeight: "100%"

library(shiny)
library(bslib)

badge <- function(text) {
  text
}

ui <- page_fluid(
  h2("Example heading", badge("New")),
  h2("Example heading", badge("Draft")),
  h2("Example heading", badge("Live"))
)

server <- function(input, output, session) {

}

shinyApp(ui, server)


## file: notes.R
# Bootstrap: https://getbootstrap.com/docs/5.3/components/badge
#
# <span class="badge text-bg-primary">Primary</span>
#
# <span class="badge text-bg-secondary">New</span>
#
# <span class="badge rounded-pill text-bg-success">Success</span>

## file: solution.R
library(shiny)
library(bslib)

badge <- function(text, theme = "primary", pill = FALSE, ...) {
  span(
    class = "badge",
    class = paste0("text-bg-", theme),
    class = if (pill) "rounded-pill",
    text,
    ...
  )
}

ui <- page_fluid(
  h2("Example heading", badge("New")),
  h2("Example heading", badge("New", "danger")),
  h2("Example heading", badge("Live", "info", pill = TRUE))
)

server <- function(input, output, session) {

}

shinyApp(ui, server)

Your Turn `_exercises/08_app.R`

05:00

Create a card_dark() function to make a dark card with a title and no padding. Use the first “Location” card as a template.
As you fill in the implementation of card_dark(), check your work by comparing the School B card with the School A location card.
Once both cards look the same, use card_dark() for both.

A 🏡 for your functions

Put your functions in `R/`

They’re loaded automatically by Shiny
Or you can load them with shiny::loadSupport()
Or you can create use a local-only package structure:
- usethis::create_package("my-app", check_name = FALSE)
- Adds a DESCRIPTION file
- Now you can use devtools::load_all()
Walk through _exercises/05-modules/02-load-support/

Modules

Am I repeating myself?

# UI ----
selectInput("school_a", "School A", choices = school_names, selected = school_a, width = "100%"),
card(
  card_header("Cost of Tuition (In State)"),
  plotOutput("plot_school_a")
)

# Server ----
output$plot_school_a <- renderPlot({
  req(input$school_a)

  scorecard |>
    filter_scorecard_by_school_name(school, input$school_a) |>
    plot_cost_tuition(colors[1])
})

# UI ----
selectInput("school_a", "School A", choices = school_names, selected = school_a, width = "100%"),
card(
  card_header("Cost of Tuition (In State)"),
  plotOutput("plot_school_a")
)

# Server ----
output$plot_school_b <- renderPlot({
  req(input$school_b)

  scorecard |>
    filter_scorecard_by_school_name(school, input$school_b) |>
    plot_cost_tuition(colors[2])
})

Step 1: Module UI

# UI ----
selectInput("school_a", "School A", choices = school_names, selected = school_a, width = "100%"),
card(
  card_header("Cost of Tuition (In State)"),
  plotOutput("plot_school_a")
)

# UI ----
selectInput("school_a", "School A", choices = school_names, selected = school_a, width = "100%"),
card(
  card_header("Cost of Tuition (In State)"),
  plotOutput("plot_school_a")
)

mod_school_ui <- function(id) {
  list(
    selectInput(paste0("school_", id), "School A", choices = school_names, selected = school_a, width = "100%"),
    card(
      card_header("Cost of Tuition (In State)"),
      plotOutput(paste0("plot_school_", id))
    )
  )
}

mod_school_ui("a")
mod_school_ui("b")

Step 1: Module UI

mod_school_ui <- function(id) {
  list(
    selectInput(NS(id, "school"), "School A", choices = school_names, selected = school_a, width = "100%"),
    card(
      card_header("Cost of Tuition (In State)"),
      plotOutput(NS(id, "plot_school"))
    )
  )
}

mod_school_ui("a")
mod_school_ui("b")

Step 1: Module UI

mod_school_ui <- function(id) {
  ns <- NS(id)

  list(
    selectInput(ns("school"), "School A", choices = school_names, selected = school_a, width = "100%"),
    card(
      card_header("Cost of Tuition (In State)"),
      plotOutput(ns("plot_school"))
    )
  )
}

mod_school_ui("a")
mod_school_ui("b")

Modules aren’t magic 🥱

shiny::NS("a", "plot_school")
#> [1] "a-plot_school"

ns <- shiny::NS("b")
ns("plot_school")
#> [1] "b-plot_school"

Step 1: Module UI

mod_school_ui <- function(id) {
  ns <- NS(id)

  list(
    selectInput(ns("school"), "School A", choices = school_names, selected = school_a, width = "100%"),
    card(
      card_header("Cost of Tuition (In State)"),
      plotOutput(ns("plot_school"))
    )
  )
}

mod_school_ui("a")
mod_school_ui("b")

Step 1: Module UI

mod_school_ui <- function(id, label, choices, selected = NULL) {
  ns <- NS(id)

  list(
    selectInput(ns("school"), label, choices = choices, selected = selected, width = "100%"),
    card(
      card_header("Cost of Tuition (In State)"),
      plotOutput(ns("plot_school"))
    )
  )
}

mod_school_ui("a", "School A", school_names, school_a)
mod_school_ui("b", "School B", school_names, school_b)

Step 1: Module UI

mod_school_ui <- function(id, label, choices, selected = NULL) {
  ns <- NS(id)

  if (is.null(selected)) {
    selected <- sample(choices, 1)
  }

  list(
    selectInput(ns("school"), label, choices = choices, selected = selected, width = "100%"),
    card(
      card_header("Cost of Tuition (In State)"),
      plotOutput(ns("plot_school"))
    )
  )
}

mod_school_ui("a", "School A", school_names)
mod_school_ui("b", "School B", school_names)

inputs: school
outputs: plot_school

Step 2: Module Server

output$plot_school_a <- renderPlot({
  req(input$school_a)

  scorecard |>
    filter_scorecard_by_school_name(school, input$school_a) |>
    plot_cost_tuition(colors[1])
})

output$plot_school_b <- renderPlot({
  req(input$school_b)

  scorecard |>
    filter_scorecard_by_school_name(school, input$school_b) |>
    plot_cost_tuition(colors[2])
})

Step 2: Module Server

server <- function(input, output, session) {
  output$plot_school_a <- renderPlot({
    req(input$school_a)

    scorecard |>
      filter_scorecard_by_school_name(school, input$school_a) |>
      plot_cost_tuition(colors[1])
  })
}

server <- function(input, output, session) {
  output$plot_school_b <- renderPlot({
    req(input$school_b)

    scorecard |>
      filter_scorecard_by_school_name(school, input$school_b) |>
      plot_cost_tuition(colors[2])
  })
}

mod_school_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    output$plot_school_b <- renderPlot({
      req(input$school_b)

      scorecard |>
        filter_scorecard_by_school_name(school, input$school_b) |>
        plot_cost_tuition(colors[2])
    })
  })
}

Step 2: Module Server

moduleServer(id, function(input, output, session) {
  output$plot_school_b <- renderPlot({
    req(input$school_b)

    scorecard |>
      filter_scorecard_by_school_name(school, input$school_b) |>
      plot_cost_tuition(colors[2])
  })
})

Step 2: Module Server

mod_school_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    output$plot_school_b <- renderPlot({
      req(input$school_b)

      scorecard |>
        filter_scorecard_by_school_name(school, input$school_b) |>
        plot_cost_tuition(colors[2])
    })
  })
}

Step 2: Module Server

mod_school_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    output$plot_school <- renderPlot({
      req(input$school)

      scorecard |>
        filter_scorecard_by_school_name(school, input$school) |>
        plot_cost_tuition(colors[2])
    })
  })
}

mod_school_server("a")
mod_school_server("b")

✨ There is some magic in modules, after all ✨

Step 2: Module Server

mod_school_server <- function(id, plot_color) {
  moduleServer(id, function(input, output, session) {
    output$plot_school <- renderPlot({
      req(input$school)

      scorecard |>
        filter_scorecard_by_school_name(school, input$school) |>
        plot_cost_tuition(plot_color)
    })
  })
}

mod_school_server("a", colors[1])
mod_school_server("b", colors[2])

Your Turn `09_modules/app.R`

05:00

Add the school map card to the mod_school ui/server functions. You can find the module in R/mod_school.R.

Having the module in a separate file makes it easier to have both the app and the module open at the same time.

#| standalone: true
#| components: [editor, viewer]
#| orientation: horizontal
#| viewerHeight: "100%"

# ┌ level-up-shiny ──────────────────────────────────┐
# │                                                  │
# │                    Solution 9                    │
# │                                                  │
# └─────────────────────────────── posit::conf(2024) ┘

library(shiny)
library(bslib)
library(dplyr)
library(ggplot2)
library(leaflet)
library(collegeScorecard)

# Setup ----------------------------------------------------------------------

colors <- c("#007bc2", "#f45100", "#bf007f")

theme_set(
  theme_minimal(18) +
    theme(
      panel.grid.minor = element_blank(),
      panel.grid.major.y = element_blank(),
      axis.title = element_text(size = 14)
    )
)

school_100 <-
  scorecard |>
  slice_max(academic_year) |>
  slice_max(n_undergrads, n = 100, with_ties = FALSE) |>
  select(id, n_undergrads) |>
  left_join(school, by = join_by(id))

school_names <- c("Pick a School" = "", school_100$name)

# UI -------------------------------------------------------------------------

ui <- page_fillable(
  layout_columns(
    div(
      mod_school_ui("a", "School A", school_names)
    ),
    div(
      mod_school_ui("b", "School B", school_names)
    )
  )
)

# Server ---------------------------------------------------------------------

server <- function(input, output, session) {
  mod_school_server("a", colors[1])
  mod_school_server("b", colors[2])
}

shinyApp(ui, server)


## file: mod_school.R
mod_school_ui <- function(id, label, choices, selected = NULL) {
  ns <- NS(id)

  if (is.null(selected)) {
    selected <- sample(choices, 1)
  }

  list(
    selectInput(ns("school"), label, choices = choices, selected = selected, width = "100%"),
    card(
      card_header("Cost of Tuition (In State)"),
      plotOutput(ns("plot_school"))
    ),
    card_dark(
      title = "Location",
      leafletOutput(ns("map_school"))
    )
  )
}

mod_school_server <- function(id, plot_color) {
  moduleServer(id, function(input, output, session) {
    output$plot_school <- renderPlot({
      req(input$school)

      scorecard |>
        filter_scorecard_by_school_name(school, input$school) |>
        plot_cost_tuition(plot_color)
    })

    output$map_school <- renderLeaflet({
      req(input$school)
      map_school(school, input$school)
    })
  })
}


## file: functions.R
card_dark <- function(title, ...) {
  card(
    card_header(title),
    class = "text-bg-dark",
    card_body(
      padding = 0,
      ...
    )
  )
}


plot_cost_tuition <- function(scorecard, fill_color = "#007bc2") {
  scorecard |>
    mutate(academic_year = as.integer(substr(academic_year, 1, 4))) |>
    ggplot() +
    aes(x = academic_year, y = cost_tuition_in) +
    geom_col(fill = fill_color, na.rm = TRUE) +
    labs(
      x = "Academic Year",
      y = NULL
    ) +
    scale_y_continuous(labels = scales::label_dollar())
}

filter_scorecard_by_school_name <- function(scorecard, school, name) {
  school_by_name <- 
    school |>
    filter(name == {{ name }})

  scorecard |>
    semi_join(school_by_name, by = "id")
}

map_school <- function(school, name) {
  the_school <- school |> filter(name == {{ name }})

  leaflet() |>
    addTiles() |>
    addMarkers(
      lng = the_school$longitude,
      lat = the_school$latitude,
      popup = the_school$name
    )
}


## file: notes.md
Suppose you put this module into your app and realize that actually, you'd like to

a. Know which college is selected
    * Add a return value to server module
b. Set the college, e.g. pick a random school
    * Pass in a school as a reactive value
    * Update the return value to include an updat "method"

The module module

You might not need a module

Maybe you could use a function?

Your Turn _exercises/07_app.R

Maybe you could UI a function?

Pick your own defaults

Pick your own defaults

Make your own components

Your Turn _exercises/08_app.R

A 🏡 for your functions

Put your functions in R/

Modules

Am I repeating myself?

Step 1: Module UI

Step 1: Module UI

Step 1: Module UI

Modules aren’t magic 🥱

Step 1: Module UI

Step 1: Module UI

Step 1: Module UI

Step 2: Module Server

Step 2: Module Server

Step 2: Module Server

Step 2: Module Server

Step 2: Module Server

Step 2: Module Server

Your Turn 09_modules/app.R

Your Turn `_exercises/07_app.R`

Your Turn `_exercises/08_app.R`

Put your functions in `R/`

Your Turn `09_modules/app.R`