---
title: "The module module"
subtitle: Level Up with Shiny for R
author: <code>posit::conf(2024)</code>
date: 2024-08-12

format:
  utopia-slides-revealjs:
    html-math-method: plain
    revealjs-url: slides/assets/reveal.js-4.5.0
    slide-level: 2
    # chalkboard: true
    theme:
      - slides.scss
      - assets/code-blocked.scss
    css:
      - ../auto-dark-mode.css

revealjs-plugins:
  - utopia-slides

knitr:
  opts_chunk: 
    collapse: true
    comment: "#>"

filters:
  - webr

webr:
  show-startup-message: false
  packages:
    - dplyr
    - collegeScorecard
    - htmltools

editor:
  render-on-save: true
---

# You might not need a module {.middle .text-center}

## {.middle}

::: {.flex-ns}
::: w-50
[Why use **Shiny modules**?]{.fs-step-2 .font-heading .b}

::: {.fragment}
* Avoid repeating logic \
  &nbsp;

* Make your code more reusable \
  &nbsp;
:::
:::
:::

## {.middle}

::: {.flex-ns}
::: w-50
[Why use [functions]{.b .orange}?]{.fs-step-2 .font-heading .b}

* Avoid repeating logic \
  &nbsp;

* Make your code more reusable \
  &nbsp;
:::

::: {.w-50 .fragment}
[Why use [Shiny modules]{.b .blue}?]{.fs-step-2 .font-heading .b}

::: {.incremental}
* Avoid repeating \
  **Shiny UI/Server logic**

* Make your code more reusable \
  **to Shiny app developers**
:::
:::
:::

# Maybe you could use a function? {.text-center .middle .bg-gradient-yellow-peach style="--slide-heading-color: white"}

```{=html}
<style>
.bg-gradient-yellow-peach {
  background: hsla(29, 92%, 55%, 1);
  background: linear-gradient(315deg, hsla(29, 92%, 55%, 1) 0%, hsla(0, 87%, 62%, 1) 57%);
  background: -moz-linear-gradient(315deg, hsla(29, 92%, 55%, 1) 0%, hsla(0, 87%, 62%, 1) 57%);
  background: -webkit-linear-gradient(315deg, hsla(29, 92%, 55%, 1) 0%, hsla(0, 87%, 62%, 1) 57%);
}
</style>
```

## {auto-animate=true}

```{r}
library(dplyr)
library(collegeScorecard)
```

```{r}
#| echo: true
school |>
  filter(
    state == "CA",
    control == "Public",
  ) |>
  count() |>
  pull(n)
```

## {auto-animate=true}

```{r}
#| echo: true
school |>
  filter(state == "CA") |>
  filter(control == "Public") |>
  count() |>
  pull(n)
```

## {auto-animate=true}

```{r}
#| echo: true
#| code-line-numbers: true
school |>
  filter(state == "CA") |>
  filter(control == "Public") |>
  count() |>
  pull(n)

school |>
  filter(state == "CA") |>
  filter(control == "Nonprofit") |>
  count() |>
  pull(n)
```

## {auto-animate=true}

```{r}
#| echo: true
#| code-line-numbers: "|1,2,4,5,8,9,11,12,15,16,18,19|3,10,17|1-2|3-5"
school |>
  filter(state == "CA") |>
  filter(control == "Public") |>
  count() |>
  pull(n)

school |>
  filter(state == "CA") |>
  filter(control == "Nonprofit") |>
  count() |>
  pull(n)

school |>
  filter(state == "CA") |>
  filter(control == "For-profit") |>
  count() |>
  pull(n)
```

## 

::: {.fs-step-1}
```{webr-r}
school |>
  filter(state == "CA") |>
  filter(control == "Public") |>
  count() |>
  pull(n)
```
:::

::: notes
```{.r}
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` {#your-turn-1 .slide-your-turn}

{{< countdown 6:00 bottom="2rem" right="2rem" >}}

::: w-90
1. **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.

2. **Replace the the duplicated code** with your new function.

3. 🤔 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? {.text-center .middle .bg-gradient-yellow-peach style="--slide-heading-color: white"}

## Pick your own defaults {auto-animate=true}

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

## Pick your own defaults {auto-animate=true}

```{.r}
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](https://getbootstrap.com/docs/5.3/components/badge/) together.

## {#my-turn-badge .fullscreen}

```{shinylive-r}
#| standalone: true
#| components: [editor, viewer]
#| orientation: horizontal
#| viewerHeight: "100%"

{{< include ../../_examples/05-modules/01_app.R >}}

## 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
{{< include ../../_examples/05-modules/01_solution_app.R >}}
```

## Your Turn `_exercises/08_app.R` {#your-turn-8-inst .slide-your-turn}

{{< countdown 5:00 bottom="2rem" right="2rem" >}}

::: w-80
1. Create a `card_dark()` function to make a dark card with a title and no
   padding. Use the first "Location" card as a template.

2. As you fill in the implementation of `card_dark()`, check your work by
   comparing the School B card with the School A location card.

3. Once both cards look the same, use `card_dark()` for both.
:::


# A 🏡 for your functions {.middle}

## Put your functions in `R/`

::: incremental
* 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 {.middle}

## Am I repeating myself?

::: {.easy-columns .gap-s}
::: {.col}
```{.r}
# 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])
})
```
:::

::: {.col}
```{.r}
# 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

::: {.easy-columns}
::: {.col}
```{.r}
# 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")
)
```
:::

::: {.col}
```{.r}
# 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")
)
```
:::
:::

::: {.w-two-thirds-ns .fragment .center}
```{.r}
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

::: {.w-80-ns .center}
```{.r}
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

::: {.w-80-ns .center}
```{.r}
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 🥱

::: {.fs-step-2}
```{r}
#| echo: true
shiny::NS("a", "plot_school")

ns <- shiny::NS("b")
ns("plot_school")
```
:::

## Step 1: Module UI

::: {.w-80-ns .center}
```{.r}
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

::: {.w-80-ns .center}
```{.r}
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

::: {.w-80-ns .center}
```{.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"))
    )
  )
}

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

::: {.fragment .bg-white .b--black-60 .ba .br3 .bw1 .p-s .absolute .bottom-2 .right-2 .shadow-2}
inputs: **school** \
outputs: **plot_school**
:::

## Step 2: Module Server

::: {.easy-columns}
::: {.col}
```{.r}
output$plot_school_a <- renderPlot({
  req(input$school_a)

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

::: {.col}
```{.r}
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

::: {.easy-columns}
::: {.col}
```{.r}
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])
  })
}
```
:::

::: {.col}
```{.r}
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])
  })
}
```
:::
:::

::: {.w-75-ns .fragment .center}
```{.r}
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

::: {.w-75-ns .center}
```{.r}
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

::: {.w-75-ns .center}
```{.r code-line-numbers="|3,4,7"}
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

::: {.w-75-ns .center}
```{.r}
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")
```
::: {.fragment .text-center}
✨ There is some magic in modules, after all ✨
:::
:::

## Step 2: Module Server

::: {.w-75-ns .center}
```{.r}
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])
```
:::

::: notes
Working app at this point: `_examples/05-modules/03_app.R`
:::

## Your Turn `09_modules/app.R` {#your-turn-9 .slide-your-turn}

{{< countdown 5:00 bottom="2rem" right="2rem" >}}


::: w-80-ns
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.
:::

## {#my-turn-module .fullscreen}

```{shinylive-r}
#| standalone: true
#| components: [editor, viewer]
#| orientation: horizontal
#| viewerHeight: "100%"

{{< include ../../_exercises/09_modules/solution/app_solution.R >}}

## file: mod_school.R
{{< include ../../_exercises/09_modules/solution/R/mod_school.R >}}

## file: functions.R
{{< include ../../_exercises/09_modules/solution/R/functions.R >}}

## 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"
```