app.R

# Shiny app: State‐based County Population Pyramid with background mapgl storymap

load_pkg <- function(pkg) {
  if (!require(pkg, character.only = TRUE)) {
    install.packages(pkg)
    library(pkg, character.only = TRUE)
  } else {
    library(pkg, character.only = TRUE)
  }
}

# Now just call the function for each package
load_pkg("shiny")
load_pkg("dplyr")
load_pkg("tidyr")
load_pkg("glue")
load_pkg("stringr")
load_pkg("ggplot2")
load_pkg("scales")
load_pkg("sf")
load_pkg("mapgl")
load_pkg("tigris")
load_pkg("tidycensus")

# Set up Census API key
# tidycensus::census_api_key("YOUR_API_KEY_HERE", install = TRUE)

# Cache option for tigris
options(tigris_use_cache = TRUE)

# Prepare simple state geometries
states_sf <- tigris::states(cb = TRUE) |>
  sf::st_transform(crs = 3857) |>
  sf::st_zm(drop = TRUE, what = "ZM")  # drop Z/M dims if present

# UI: Storymap with background map and two sections: state select and county pyramid
ui <- shiny::fluidPage(
  tags$link(
    href = "https://fonts.googleapis.com/css2?family=Poppins:wght@300;400;600&display=swap",
    rel="stylesheet"
  ),
  mapgl::story_maplibre(
    map_id = "map",
    font_family = "Poppins",
    sections = list(
      # Section 1: Choose a state
      "intro" = mapgl::story_section(
        title = "US State Population Pyramid Explorer",
        content = list(
          shiny::selectInput(
            inputId = "year",
            label   = "Select a year:",
            choices = 2015:2023,
            selected = 2023
          ),
          shiny::selectInput(
            inputId = "state",
            label   = "Select a state:",
            choices = state.name
          ),
          shiny::p("Scroll down to select a county and view its population pyramid.")
        )
      ),
      # Section 2: County selector and pyramid
      "state_detail" = mapgl::story_section(
        title = NULL,
        width = 650,
        content = list(
          h3(shiny::uiOutput("county_header")),
          # Switched to selectizeInput with server-side loading
          shiny::selectizeInput(
            inputId = "county",
            label   = "Select a county:",
            choices = NULL,
            # multiple = TRUE,
            options = list(
              placeholder = 'Type to search counties...'
            )
          ),
          shiny::plotOutput("pyramid_plot", height = "600px"),
          shiny::p("Scroll up to return to the overview")
        )
      )
    )
  )
)

# Server logic
server <- function(input, output, session) {

  # Reactive: geometry for selected state
  sel_state <- reactive({
    states_sf |> dplyr::filter(NAME == input$state)
  })

  # Reactive: load county geometries for selected state
  state_age <- shiny::reactive({
    shiny::req(input$state)
    tidycensus::get_acs(
      geography = "tract",
      state     = tidycensus:::validate_state(state = input$state),
      variables = "B01002_001",
      year      = as.integer(input$year),
      geometry  = TRUE
    ) |>
      tidyr::separate_wider_delim(
        NAME,
        delim = stringr::regex(", |; "),
        names = c("tract", "county", "state")
      ) |>
      dplyr::mutate(
        popup = glue::glue(
          "<strong>COUNTY: </strong>{county}<br><strong>Median Age: </strong>{estimate}"
        )
      ) |>
      sf::st_sf()
  })

  # Render background map once; layers updated via proxy
  output$map <- mapgl::renderMaplibre({
    mapgl::maplibre(
      mapgl::carto_style("voyager"),
      center = c(-98.5, 39.5), # Center of US
      zoom = 3,
      scrollZoom = FALSE
    ) |>
      mapgl::set_projection(projection = "globe") |>
      mapgl::add_globe_control() |>
      mapgl::add_navigation_control(visualize_pitch = TRUE) |>
      mapgl::add_globe_minimap(position = "bottom-right") |>
      mapgl::add_line_layer(
        id = "states",
        source = states_sf,
        line_color = "#425e7a",
        line_width = 2
      )
  })

  # Map interactions: zoom to state on intro, then highlight county
  mapgl::on_section("map", "intro", {
    # Show full state on intro
    mapgl::maplibre_proxy("map") |>
      mapgl::set_filter("states", NULL) |>
      mapgl::clear_layer("county_age") |>
      mapgl::clear_layer("county_bound") |>
      mapgl::clear_legend() |>
      mapgl::fly_to(
        center = c(-98.5, 39.5),
        zoom = 3,
        bearing = 0,
        pitch = 0,
        duration = 1500
      )
  })

  # Update county choices when state changes
  shiny::observeEvent(sel_state(), {
    county_names <- tidycensus::fips_codes[tidycensus::fips_codes$state_name == input$state, "county"]

    shiny::updateSelectizeInput(
      session, "county",
      choices = county_names,
      selected = county_names[1],
      server = TRUE)
  })

  # County header
  output$county_header <- shiny::renderText({
    paste0(input$county, " – Population Pyramid (", input$year,")")
  })

  mapgl::on_section("map", "state_detail", {
    shiny::req(input$county)

    # Get county data
    # sel_county <- dplyr::filter(state_age(), county == input$county) |>
    #   sf::st_union()

    # First, set the filter to highlight the selected county
    mapgl::maplibre_proxy("map") |>
      mapgl::add_fill_layer(
        id         = "county_age",
        source     = state_age(),
        fill_color = mapgl::interpolate(
          column = "estimate",
          values = c(20, 30, 40, 50, 60),
          stops  = c("#f46d43", "#fee08b", "#e6f598", "#66c2a5", "#5e4fa2"),
          na_color = "lightgrey"
        ),
        fill_opacity = 0.6,
        popup = "popup",
        tooltip = "estimate",
        hover_options = list(
          fill_color = "red",
          fill_opacity = 1
        )
      ) |>
      mapgl::add_legend(
        "Median Age",
        layer_id = "county_age",
        values   = c(20, 30, 40, 50, 60),
        colors   = c("#f46d43", "#fee08b", "#e6f598", "#66c2a5", "#5e4fa2"),
        position = "bottom-left"
      ) |>
      mapgl::set_filter(
        "states",
        filter = list("==", "NAME", input$state)
      ) |>
      # mapgl::add_line_layer(
      #   id = "county_bound",
      #   source = state_age(),
      #   line_color = "red",
      #   line_width = 2,
      #   filter = list("==", "county", input$county)
      # ) |>
      # Then make sure to fit the bounds to the filtered data
      mapgl::fit_bounds(
        sel_state(),
        animate = TRUE,
        padding = 20  # Add some padding to ensure visibility
      )
  })

  # Reactive: fetch and process pyramid data for selected county
  sel_pyramid <- shiny::reactive({
    shiny::req(input$state, input$county)
    tidycensus::get_estimates(
      geography        = "county",
      state            = tidycensus:::validate_state(state = input$state),
      county           = tidycensus:::validate_county(state = input$state, county = input$county),
      product          = "characteristics",
      vintage          = as.integer(input$year),
      breakdown        = c("SEX", "AGEGROUP"),
      breakdown_labels = TRUE
    ) |>
      dplyr::filter(stringr::str_detect(AGEGROUP, "^Age"), SEX != "Both sexes") |>
      dplyr::mutate(
        # Negative values for males
        value = ifelse(SEX == "Male", -value, value),
        # Compute age_min for ordering
        age_min = ifelse(
          stringr::str_detect(AGEGROUP, "under"), 0,
          as.numeric(stringr::str_extract(AGEGROUP, "\\d+"))
        )
      ) |>
      dplyr::group_by(SEX, AGEGROUP, age_min) |>
      dplyr::summarize(value = sum(value, na.rm = TRUE), .groups = "drop") |>
      dplyr::arrange(age_min) |>
      dplyr::mutate(AGEGROUP = factor(AGEGROUP, levels = unique(AGEGROUP)))
  })

  # Render population pyramid
  output$pyramid_plot <- shiny::renderPlot({
    df <- sel_pyramid()
    ggplot2::ggplot(df, ggplot2::aes(x = value, y = AGEGROUP, fill = SEX)) +
      ggplot2::geom_col(width = 0.8, alpha = 0.8) +
      ggplot2::geom_text(
        ggplot2::aes(
          x = 0,
          label = scales::comma(abs(value)),
          hjust = ifelse(value >= 0, -0.2, 1.2)
        ),
        vjust = 0.5,
        color = "gray99", size = 3.2, fontface = "bold"
      ) +
      ggplot2::scale_x_continuous(labels = ~ scales::number_format(scale = 1/1000, suffix = "k")(abs(.x)),
                                  expand = ggplot2::expansion(mult = c(0.1, 0.1))) +
      ggplot2::scale_y_discrete(labels = ~ stringr::str_remove_all(.x, "Age\\s|\\syears")) +
      ggplot2::scale_fill_manual(values = c("Male" = "navy", "Female" = "darkred"),
                                 name = "Sex") +
      ggplot2::theme_minimal(base_size = 14) +
      ggplot2::labs(
        x = "Population (thousands)",
        y = "Age Group",
        caption = paste0("Data: US Census Bureau ACS ", input$year)
      ) +
      ggplot2::theme(
        text = ggplot2::element_text(family = "Futura Md BT"),
        title = ggplot2::element_blank(),
        axis.title = ggplot2::element_text(size = 10, face = "bold"),
        axis.text = ggplot2::element_text(size = 9),
        axis.line.y = ggplot2::element_blank(),
        axis.line.x = ggplot2::element_line(color = "gray44"),
        panel.grid.major = ggplot2::element_blank(),
        panel.grid.minor.y = ggplot2::element_line(color = "gray44"),
        legend.position = "top",
        legend.title = ggplot2::element_text(size = 10, face = "bold"),
        legend.text = ggplot2::element_text(size = 9, color = "gray44"),
        plot.caption = ggplot2::element_text(face = "italic", color = "gray44", size = 9)
      )
  }, res = 96)
}

# Run the app
shiny::shinyApp(ui, server)