The Reactive Graph

Level Up with Shiny for R

posit::conf(2024)

2024-08-12

Your Turn

Your Turn (with a partner)

04:00

• Play with the app in the Reactivity page.
  (It’s also _examples/08-reactivity/01-simple, but don’t look at the code.)

• How are the inputs connected to the outputs?

• Draw a picture mapping inputs to the outputs.
  Do you think there are any hidden dependencies?

The three atoms of reactivity

Reactive values

Reactive expressions

Observers

Invalidated

Evaluating

Ready

Using reactlog

reactlog::reactlog_enable()

shiny::runApp("app.R")

💡 While the app is running, press Cmd/Ctrl + F4
to add markers in the timeline.

Close the app and run shiny::reactlogShow() in the console.

#| standalone: true
#| components: [viewer]
#| viewerHeight: "100%"

library(shiny)
library(bslib)
library(dplyr)
library(collegeScorecard)
reactlog::reactlog_enable()


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

ui <- page_sidebar(
  theme = bs_theme(version = 5),
  title = "College Affordability Analyzer",
  fill = FALSE,
  sidebar = sidebar(
    open = list(mobile = "always-above"),
    selectInput("state", "State", choices = setNames(state.abb, state.name), selected = "WA"),
    sliderInput("sat_score", "Minimum SAT Score", min = 800, max = 1200, value = 1000, step = 10),
    radioButtons(
      "income_bracket",
      "Income Bracket",
      inline = TRUE,
      choices = c(
        "< $30k" = "cost_avg_income_0_30k",
        "$30 - $48k" = "cost_avg_income_30_48k",
        "$48 - $75k" = "cost_avg_income_48_75k",
        "$75 - $110k" = "cost_avg_income_75_110k",
        "$110k+" = "cost_avg_income_110k_plus"
      )
    )
  ),
  value_box(
    "Average 10-year Median Earnings",
    textOutput("txt_amnt_earnings"),
    showcase = bsicons::bs_icon("wallet-fill")
  ),
  value_box(
    "Average 4-year Cost",
    textOutput("txt_four_year_cost"),
    "For the selected income bracket",
    showcase = bsicons::bs_icon("cash-stack")
  ),
  card(
    reactlog::reactlog_module_ui()
  )
)


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

server <- function(input, output, session) {
  reactlog::reactlog_module_server()
  
  filtered_data <- reactive({
    scorecard |>
      filter(
        academic_year == "2020-21",
        !is.na(cost_avg),
        !is.na(amnt_earnings_med_10y)
      ) |>
      select(id, cost_avg, amnt_earnings_med_10y, score_sat_avg, starts_with("cost_avg_income")) |>
      left_join(school, by = join_by(id)) |>
      filter(
        state == input$state,
        score_sat_avg >= input$sat_score
      )
  })

  output$txt_amnt_earnings <- renderText({
    filtered_data() |>
      pull(amnt_earnings_med_10y) |>
      mean(na.rm = TRUE) |> 
      scales::dollar(accuracy = 10)
  })

  output$txt_four_year_cost <- renderText({
    avg_cost <- 
      filtered_data() |>
      pull(!!input$income_bracket) |>
      mean(na.rm = TRUE)

    scales::dollar(avg_cost * 4, accuracy = 10)
  })
}


shinyApp(ui, server)

#| standalone: true
#| components: [viewer]
#| viewerHeight: "100%"

library(shiny)
library(bslib)
library(dplyr)
library(collegeScorecard)
reactlog::reactlog_enable()


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

ui <- page_sidebar(
  theme = bs_theme(version = 5),
  title = "College Affordability Analyzer",
  sidebar = sidebar(
    open = list(mobile = "always-above"),
    selectInput("state", "State", choices = setNames(state.abb, state.name), selected = "WA"),
    sliderInput("sat_score", "Minimum SAT Score", min = 800, max = 1200, value = 1000, step = 10),
    input_switch("by_income_bracket", "By Income Bracket", value = TRUE),
    radioButtons(
      "income_bracket",
      "Income Bracket",
      inline = TRUE,
      choices = c(
        "< $30k" = "cost_avg_income_0_30k",
        "$30 - $48k" = "cost_avg_income_30_48k",
        "$48 - $75k" = "cost_avg_income_48_75k",
        "$75 - $110k" = "cost_avg_income_75_110k",
        "$110k+" = "cost_avg_income_110k_plus"
      )
    )
  ),
  value_box(
    "Average 10-year Median Earnings",
    textOutput("txt_amnt_earnings"),
    showcase = bsicons::bs_icon("wallet-fill"),
    fill = FALSE
  ),
  value_box(
    "Average 4-year Cost",
    textOutput("txt_four_year_cost"),
    "For the selected income bracket",
    showcase = bsicons::bs_icon("cash-stack"),
    fill = FALSE
  ),
  card(
    reactlog::reactlog_module_ui()
  )
)

# Server ------------------------------------------------------------------
server <- function(input, output, session) {
  reactlog::reactlog_module_server(height = "100%")

  filtered_data <- reactive({
    scorecard |>
      filter(
        academic_year == "2020-21",
        !is.na(cost_avg),
        !is.na(amnt_earnings_med_10y)
      ) |>
      select(id, amnt_earnings_med_10y, score_sat_avg, starts_with("cost_avg")) |>
      left_join(school, by = join_by(id)) |>
      filter(
        state == input$state,
        score_sat_avg >= input$sat_score
      )
  })

  output$txt_amnt_earnings <- renderText({
    filtered_data() |>
      pull(amnt_earnings_med_10y) |>
      mean(na.rm = TRUE) |> 
      scales::dollar(accuracy = 10)
  })

  output$txt_four_year_cost <- renderText({
    cost_var <- if (input$by_income_bracket) {
      input$income_bracket
    } else {
      "cost_avg"
    }

    avg_cost <- 
      filtered_data() |>
      pull(!!cost_var) |>
      mean(na.rm = TRUE)

    scales::dollar(avg_cost * 4, accuracy = 10)
  })
}


shinyApp(ui, server)

Your Turn

Invent this app

04:00

Describe the app

Extra bits

I'm working on an example Shiny for R app for a workshop. I'm using the US College Scorecard dataset from the `collegeScorecard` package which provides the data separated into "school" and "scorecard" tables with these columns:

school: id, name, city, state, zip, latitude, longitude, url, deg_predominant, deg_highest, control, locale_type, locale_size, adm_req_test, is_hbcu, is_pbi, is_annhi, is_tribal, is_aanapii, is_hsi, is_nanti, is_only_men, is_only_women, is_only_distance, religious_affiliation

scorecard: id, academic_year, n_undergrads, cost_tuition_in, cost_tuition_out, cost_books, cost_room_board_on, cost_room_board_off, cost_avg, cost_avg_income_0_30k, cost_avg_income_30_48k, cost_avg_income_48_75k, cost_avg_income_75_110k, cost_avg_income_110k_plus, amnt_earnings_med_10y, rate_completion, rate_admissions, score_sat_avg, score_act_p25, score_act_p75, score_sat_verbal_p25, score_sat_verbal_p75, score_sat_math_p25, score_sat_math_p75

I'd like to have a VERY SIMPLE app that has:
* Four inputs
* Two reactive expressions. The first uses only two inputs. The second uses the third input and the first reactive expression.
* The fourth input is used in an observer to update an input.
* There are two outputs, each powered by one of the reactive expressions.

This app...

#| standalone: true
#| components: [viewer]
#| viewerHeight: "100%"

library(shiny)
library(bslib)
library(dplyr)
library(collegeScorecard)
reactlog::reactlog_enable()


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

ui <- page_sidebar(
  theme = bs_theme(version = 5),
  title = "College Affordability Analyzer",
  sidebar = sidebar(
    open = list(mobile = "always-above"),
    selectInput("state", "State", choices = setNames(state.abb, state.name), selected = "WA"),
    sliderInput("sat_score", "Minimum SAT Score", min = 800, max = 1200, value = 1000, step = 10),
    input_switch("by_income_bracket", "By Income Bracket", value = TRUE),
    radioButtons(
      "income_bracket",
      "Income Bracket",
      inline = TRUE,
      choices = c(
        "< $30k" = "cost_avg_income_0_30k",
        "$30 - $48k" = "cost_avg_income_30_48k",
        "$48 - $75k" = "cost_avg_income_48_75k",
        "$75 - $110k" = "cost_avg_income_75_110k",
        "$110k+" = "cost_avg_income_110k_plus"
      )
    )
  ),
  value_box(
    "Average 10-year Median Earnings",
    textOutput("txt_amnt_earnings"),
    showcase = bsicons::bs_icon("wallet-fill"),
    fill = FALSE
  ),
  value_box(
    "Average 4-year Cost",
    textOutput("txt_four_year_cost"),
    "For the selected income bracket",
    showcase = bsicons::bs_icon("cash-stack"),
    fill = FALSE
  ),
  card(
    reactlog::reactlog_module_ui()
  )
)


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

server <- function(input, output, session) {
  reactlog::reactlog_module_server(height = "100%")
  
  filtered_data <- reactive({
    scorecard |>
      filter(
        academic_year == "2020-21",
        !is.na(cost_avg),
        !is.na(amnt_earnings_med_10y)
      ) |>
      select(id, amnt_earnings_med_10y, score_sat_avg, starts_with("cost_avg")) |>
      left_join(school, by = join_by(id)) |>
      filter(
        state == input$state,
        score_sat_avg >= input$sat_score
      )
  })

  observeEvent(input$state, {
    output$txt_amnt_earnings <- renderText({
      filtered_data() |>
        pull(amnt_earnings_med_10y) |>
        mean(na.rm = TRUE) |>
        scales::dollar(accuracy = 10)
    })
  })

  output$txt_four_year_cost <- renderText({
    cost_var <- if (input$by_income_bracket) {
      input$income_bracket
    } else {
      "cost_avg"
    }

    avg_cost <- 
      filtered_data() |>
      pull(!!cost_var) |>
      mean(na.rm = TRUE)

    scales::dollar(avg_cost * 4, accuracy = 10)
  })
}


shinyApp(ui, server)