# =============================================================================
# NOAA Storm Events Explorer
# A heavily commented Shiny example for MaDS 36-613 Data Visualization
# =============================================================================
#
# READING GUIDE
# -------------
# A Shiny app has three main parts:
#
#   1. Data and setup: objects shared by every visitor to the app.
#   2. User interface (UI): the controls and output placeholders in the browser.
#   3. Server: the reactive instructions that fill those placeholders.
#
# Search for the numbered section headings below if you want to read the app in
# that order. The app is intentionally kept in one file so students can see the
# complete input -> reactive -> output path without jumping between ui.R and
# server.R.


# -----------------------------------------------------------------------------
# 1. PACKAGES
# -----------------------------------------------------------------------------
# `rsconnect` is NOT loaded here. It is needed to publish the app, but it is not
# a runtime dependency of the dashboard itself.

library(shiny)     # reactive web applications
library(bslib)     # modern page, sidebar, card, and value-box components
library(dplyr)     # readable data summaries
library(ggplot2)   # charts and map rendering
library(scales)    # compact number and dollar labels
library(maps)      # published U.S. state polygon geometry


# -----------------------------------------------------------------------------
# 2. DATA AND SHARED HELPERS
# -----------------------------------------------------------------------------
# These lines run once when an R process starts. They do NOT rerun every time a
# visitor moves a slider. Loading the data here keeps interactions quick.

source("R/dashboard_helpers.R", local = TRUE)

events <- readRDS("data/noaa-dashboard-events-2024.rds")

# Put the most frequent hazards first in the selection menu. This makes common
# choices easier to find while retaining every NOAA event type in the dataset.
event_type_choices <- events |>
  count(event_type, sort = TRUE) |>
  pull(event_type)


# -----------------------------------------------------------------------------
# 3. VISUAL THEME
# -----------------------------------------------------------------------------
# A small set of named colors is easier to maintain than scattering hex values
# throughout every plot. The blue-green accent is used for the selected data;
# the warm color calls attention to the month being played or selected.

theme_noaa <- bs_theme(
  version = 5,
  bg = "#f5f8fa",
  fg = "#172a33",
  primary = "#0b6f78",
  secondary = "#55727e",
  base_font = font_collection("Aptos", "Segoe UI", "Helvetica Neue", "Arial")
)

COLOR_SELECTED <- "#0b6f78"
COLOR_FOCUS <- "#d97706"
COLOR_CONTEXT <- "#b8c8cf"
COLOR_MAP_LOW <- "#e2f1f1"
COLOR_MAP_HIGH <- "#07525a"


# -----------------------------------------------------------------------------
# 4. USER INTERFACE
# -----------------------------------------------------------------------------
# The UI declares *where* outputs belong but does not calculate their values.
# For example, textOutput("event_count") is an empty placeholder until the
# server creates output$event_count.

ui <- page_sidebar(
  # Files in www/ are publicly served by Shiny, but custom CSS still needs to
  # be linked into the document. includeCSS() reads and inserts it here.
  tags$head(includeCSS("www/dashboard.css")),

  title = div(
    class = "dashboard-title",
    div("NOAA Storm Events Explorer"),
    tags$small("A reactive dashboard demo for MaDS 36-613")
  ),
  window_title = "NOAA Storm Events Explorer",
  theme = theme_noaa,
  # A scrollable document is easier to embed and prevents a laptop-height
  # viewport from squeezing the map and charts into unreadably short cards.
  fillable = FALSE,

  # The sidebar contains only controls that materially change the analysis.
  sidebar = sidebar(
    width = 315,
    open = "desktop",

    h2("Choose a view", class = "sidebar-heading"),

    selectizeInput(
      inputId = "event_types",
      label = "Hazards",
      choices = event_type_choices,
      selected = DEFAULT_EVENT_TYPES,
      multiple = TRUE,
      options = list(
        plugins = list("remove_button"),
        placeholder = "Choose one or more hazards"
      )
    ),

    radioButtons(
      inputId = "metric",
      label = "Measure",
      # Shiny uses names as labels and values as the server-side input. Reverse
      # our key -> label lookup so visitors see prose while the server receives
      # a short stable key such as "events" or "property".
      choices = setNames(names(METRIC_LABELS), unname(METRIC_LABELS)),
      selected = "events"
    ),

    # The built-in play button turns the map into a restrained month-by-month
    # animation. Zero preserves a useful static "all year" starting view.
    sliderInput(
      inputId = "month",
      label = "Focus month (0 = all year)",
      min = 0,
      max = 12,
      value = 0,
      step = 1,
      ticks = TRUE,
      animate = animationOptions(interval = 1100, loop = TRUE)
    ),

    div(class = "month-readout", textOutput("month_readout", inline = TRUE)),

    actionButton(
      inputId = "reset",
      label = "Reset filters",
      class = "btn-outline-primary"
    ),

    tags$hr(),
    h3("Audience task"),
    p(
      "Compare where and when different hazards create exposure, then inspect",
      "the incidents behind the summary."
    ),
    p(
      class = "sidebar-note",
      "Source: NOAA Storm Events Database, 2024 teaching extract. Damage values",
      "are reported estimates and should not be read as complete loss totals."
    )
  ),

  # This sentence changes with the controls and helps a screen-reader user (or
  # a hurried reader) understand the current state before reaching the charts.
  div(
    class = "selection-summary",
    role = "status",
    `aria-live` = "polite",
    textOutput("selection_summary", inline = TRUE)
  ),

  # Three values are central to the dashboard's monitoring task. The value
  # boxes are deliberately limited to those outcomes rather than filling the
  # page with every number available in the data.
  layout_columns(
    value_box(
      title = "Event records",
      value = textOutput("event_count", inline = TRUE),
      theme = "primary"
    ),
    value_box(
      title = "People harmed",
      value = textOutput("people_count", inline = TRUE),
      p("Injuries + deaths", class = "value-note"),
      theme = "secondary"
    ),
    value_box(
      title = "Reported damage",
      value = textOutput("damage_total", inline = TRUE),
      p("Property + crops", class = "value-note"),
      theme = "secondary"
    ),
    col_widths = c(4, 4, 4)
  ),

  # The map is the dominant visual because the primary task is spatial.
  card(
    full_screen = TRUE,
    card_header(
      uiOutput("map_heading"),
      span("Use the play button beside the month slider to animate.", class = "card-hint")
    ),
    div(
      role = "img",
      `aria-label` = paste(
        "Choropleth map of the selected NOAA Storm Events measure by state.",
        "The map updates when the hazard, measure, or month changes."
      ),
      plotOutput(outputId = "state_map", height = "500px")
    ),
    card_footer(
      "The map shows the contiguous United States. Alaska, Hawaii, territories,",
      "and marine zones remain in the totals above."
    )
  ),

  # These two compact charts answer complementary questions: when do the
  # selected hazards happen, and which selected hazard contributes most?
  layout_columns(
    card(
      card_header("When do the selected hazards occur?"),
      div(
        role = "img",
        `aria-label` = "Bar chart of the selected metric by month for all of 2024.",
        plotOutput("season_chart", height = "330px")
      )
    ),
    card(
      card_header("Which selected hazards contribute most?"),
      div(
        role = "img",
        `aria-label` = "Horizontal bar chart ranking selected hazard types.",
        plotOutput("hazard_chart", height = "330px")
      )
    ),
    col_widths = c(6, 6)
  ),

  card(
    card_header(
      "Largest reported incidents in the current view",
      span("Ranked by property + crop damage", class = "card-hint")
    ),
    div(class = "table-responsive", tableOutput("incident_table"))
  )
)


# -----------------------------------------------------------------------------
# 5. SERVER
# -----------------------------------------------------------------------------
# The server function runs once per browser session. Everything inside it is
# private to that visitor: two students can use different filters at the same
# time without changing each other's view.

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

  # ----- Reset control --------------------------------------------------------
  # `observeEvent()` is for an action that causes a side effect. Here, clicking
  # the button changes three inputs back to their starting values.
  observeEvent(input$reset, {
    updateSelectizeInput(session, "event_types", selected = DEFAULT_EVENT_TYPES)
    updateRadioButtons(session, "metric", selected = "events")
    updateSliderInput(session, "month", value = 0)
  })


  # ----- Core reactive datasets ----------------------------------------------
  # A `reactive()` is a cached recipe. It reruns only when one of the inputs it
  # reads changes. Every output below can reuse these filtered rows.

  selected_events_all_year <- reactive({
    filter_events(
      events = events,
      event_types = input$event_types,
      month = 0L
    )
  })

  selected_events <- reactive({
    filter_events(
      events = events,
      event_types = input$event_types,
      month = input$month
    )
  })


  # ----- Labels and accessible state -----------------------------------------

  output$month_readout <- renderText({
    month_label(input$month)
  })

  output$selection_summary <- renderText({
    hazard_count <- length(input$event_types)
    hazard_phrase <- if (hazard_count == 1L) "1 hazard" else paste(hazard_count, "hazards")

    paste0(
      month_label(input$month), " · ", hazard_phrase, " · ",
      format(nrow(selected_events()), big.mark = ","), " matching event records"
    )
  })

  output$map_heading <- renderUI({
    req(input$metric)

    tags$div(
      tags$strong(METRIC_LABELS[[input$metric]]),
      tags$span(paste("by state ·", month_label(input$month)), class = "map-subtitle")
    )
  })


  # ----- Value boxes ----------------------------------------------------------

  output$event_count <- renderText({
    format(nrow(selected_events()), big.mark = ",")
  })

  output$people_count <- renderText({
    total <- sum(
      selected_events()$injuries_total + selected_events()$deaths_total,
      na.rm = TRUE
    )
    scales::comma(total)
  })

  output$damage_total <- renderText({
    total <- sum(
      selected_events()$prop_usd_zero + selected_events()$crop_usd_zero,
      na.rm = TRUE
    )
    scales::dollar(total, scale_cut = scales::cut_short_scale())
  })


  # ----- State choropleth -----------------------------------------------------

  output$state_map <- renderPlot({
    state_summary <- summarise_states(selected_events(), input$metric)
    map_data <- state_map_data(state_summary)
    label_metric <- metric_formatter(input$metric)

    ggplot(map_data, aes(long, lat, group = group, fill = value)) +
      geom_polygon(color = "white", linewidth = 0.25) +
      coord_quickmap(xlim = c(-125, -66), ylim = c(24, 50), expand = FALSE) +
      scale_fill_gradient(
        low = COLOR_MAP_LOW,
        high = COLOR_MAP_HIGH,
        trans = "sqrt",
        labels = label_metric,
        name = METRIC_LABELS[[input$metric]]
      ) +
      labs(
        x = NULL,
        y = NULL,
        caption = "Source: NOAA Storm Events Database · 2024 teaching extract"
      ) +
      theme_void(base_size = 13) +
      theme(
        legend.position = "bottom",
        legend.title = element_text(face = "bold"),
        legend.key.width = grid::unit(3, "cm"),
        plot.caption = element_text(color = "#55727e", margin = margin(t = 8))
      )
  }, res = 110)


  # ----- Seasonal context chart ----------------------------------------------
  # This chart always uses all twelve months. When a month is selected for the
  # map, that same month is emphasized here so context is never lost.

  output$season_chart <- renderPlot({
    monthly <- summarise_months(selected_events_all_year(), input$metric) |>
      mutate(
        is_focus = input$month != 0L & month == input$month,
        bar_color = if_else(is_focus, COLOR_FOCUS, COLOR_SELECTED)
      )

    ggplot(monthly, aes(month_name, value)) +
      geom_col(aes(fill = bar_color), width = 0.72, show.legend = FALSE) +
      scale_fill_identity() +
      scale_y_continuous(
        labels = metric_formatter(input$metric),
        expand = expansion(mult = c(0, 0.08))
      ) +
      labs(x = NULL, y = METRIC_LABELS[[input$metric]]) +
      theme_minimal(base_size = 12) +
      theme(
        panel.grid.major.x = element_blank(),
        panel.grid.minor = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1),
        plot.margin = margin(8, 12, 8, 8)
      )
  }, res = 110)


  # ----- Hazard ranking -------------------------------------------------------

  output$hazard_chart <- renderPlot({
    hazards <- summarise_hazards(selected_events(), input$metric)

    validate(
      need(nrow(hazards) > 0L, "Choose at least one hazard to draw this chart.")
    )

    ggplot(hazards, aes(value, reorder(event_type, value))) +
      geom_col(fill = COLOR_SELECTED, width = 0.68) +
      scale_x_continuous(
        labels = metric_formatter(input$metric),
        expand = expansion(mult = c(0, 0.08))
      ) +
      labs(x = METRIC_LABELS[[input$metric]], y = NULL) +
      theme_minimal(base_size = 12) +
      theme(
        panel.grid.major.y = element_blank(),
        panel.grid.minor = element_blank(),
        plot.margin = margin(8, 14, 8, 8)
      )
  }, res = 110)


  # ----- Details table --------------------------------------------------------

  output$incident_table <- renderTable({
    largest_incidents(selected_events(), n = 8L)
  },
  striped = FALSE,
  bordered = FALSE,
  hover = TRUE,
  spacing = "s",
  # renderTable expects one alignment string, one character per column.
  align = "llllrr",
  digits = 0,
  na = "—"
  )
}


# -----------------------------------------------------------------------------
# 6. ASSEMBLE THE APP
# -----------------------------------------------------------------------------
# `shinyApp()` pairs the UI declaration with the server instructions. Keeping
# this final line explicit also makes the file easy to deploy with rsconnect.

shinyApp(ui = ui, server = server)