hurricane_normalization_app/dashboard.Rmd

---
title: "Hurricane Normalization App"
runtime: shiny
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    theme: 
      version: 4
      bootswatch: litera
---

```{r global, include=FALSE}

library(flexdashboard)
library(shiny)
library(leaflet)
library(DT)
library(dplyr)
library(DBI)
library(tidyr)
library(ggplot2)
library(plotly)
library(viridis)
library(lubridate)
library(scales)
library(readr)
library(stringr)
library(kableExtra)
library(bslib)
library(dygraphs)
library(tidyverse)
library(sf)
library(shinyBS)
library(xts)
library(tigris)
library(caret)
library(scales)
library(billboarder)
library(shinyWidgets)
library(paletteer)
library(shinyjs)

source(file = "queries.R")

useShinyjs()

# pull static data
loss_storms <- get_all_loss_storms()

latest_normalized_losses <- get_latest_aggregate_losses()

all_conus_landfalls <- get_all_conus_landfalls()

all_lf_type_storms <- get_all_lf_type_landfalls()

onStop(function() {
  disconnect_db()
})
```

```{r}
storm_selection <- reactiveValues(
  storm_year = NULL,
  storm_name = NULL,
  storm_basin = NULL,
)
```

Home
=============================================

Col {data-width=500}
----------------------------------------------

### {}
```{r}
# Home - Intro

HTML(
  '
  <h4>Welcome to the Hurricane Cost Normalization Web App</h4>
  
  <p>Our platform provides access to normalized hurricane damage data spanning from 1900 to 2024, allowing researchers, policymakers, insurance professionals, and the public to better understand how hurricane costs have changed over time.</p>
  
  <h6>Our Data</h6>
  
  <p>The core datasets used in this app are based on research by Muller et al. (2025) published in <i>Bulletin of the American Meteorlogical Society</i>. This study updates and refines hurricane damage normalization methodologies to provide a more accurate picture of how historical hurricanes would impact today\'s society.</p>
  
  <ul>
    <li><b>MMP24:</b> The Muller-Mooney Population (2024) normalization with RMW weighting on affected population.</li>
    
    <li><b>MMH24:</b> The Muller-Mooney Housing (2024) normalization with RMW weighting on affected housing units.</li>
  </ul>
  
  <h6>Methodology Innovations</h6>
  
  <p>Our platform incorporates several methodological innovations over previously used cost normalization formulas:
  
  <ul>
    <li><b>Radius of Maximum Wind (RMW) Data:</b> Using landfalling RMWs to identify impacted coastal counties.</li>
    
    <li><b>RMW Affected Area Weighting:</b> Determining affected population and housing unit figures based on RMW.</li>
    
    <li><b>Expanded Storm Coverage:</b> Including over 200 storms analyzed with interactive data.</li>
    
    <li><b>Up-to-date Data:</b> Using the latest population, housing unit, and economic data through 2024.</li>
  </ul>
  '
)
```

Col {data-width=500}
----------------------------------------------

### Storm Selector {data-height=500}
```{r}
# Home - Storm Selector

fluidRow(
  column(
    6,
    div(
      selectInput("stormBasin", "Basin", choices = "AL", width = "100%"),
      selectInput(
        "stormYear",
        "Year",
        choices = loss_storms$storm_year,
        width = "100%"
      ),
      selectInput("stormName", "Name", choices = NULL, width = "100%"),
      actionButton(
        "selectStorm",
        "Submit",
        class = "btn-primary rounded",
        width = "100%"
      )
    )
  ),
  column(
    6,
    HTML(
      '
      <h5>Select a Storm</h5>
      
      We are currently tracking 201 CONUS storms with over $3T in losses spanning from 1900 to 2024
      
      <hr>
      
      Use the storm selector to the left or the table below to select a storm to analyze
    '
    )
  )
)

observeEvent(input$stormYear, {
  stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ]

  stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear)

  updateSelectInput(
    session,
    "stormName",
    choices = stormsByYear$storm_name,
    selected = NULL
  )
})

observeEvent(input$selectStorm, {
  storm_selection$storm_basin <- input$stormBasin
  storm_selection$storm_year <- input$stormYear
  storm_selection$storm_name <- input$stormName
  storm_selection$is_selected <- TRUE

  showNotification("Storm selection updated!", type = "message")
})
```

### All Storms {data-height=500 .no-padding}
```{r}
# Home - Storm Table

output$normalized_storms_table <- renderDT({
  datatable(
    latest_normalized_losses %>% select(-hurdatId),
    rownames = F,
    colnames = c("Storm", "Year", "MMH24", "MMP24"),
    selection = "single",
    options = list(
      pageLength = 1000,
      order = list(2, 'desc'),
      searching = F,
      paging = F,
      info = F,
      lengthChange = F,
      server = T
    )
  ) %>%
    formatCurrency(c("mmh", "mmp"), "$", digits = 0)
})

DTOutput("normalized_storms_table")
```



Storm Overview {data-navmenu="Storm Details"}
====================================

```{r}
# Storm Overview - Setup

observe({
  req(storm_selection$is_selected)

  unique_lfs <- get_unique_lf_ids(storm_selection)

  updateVirtualSelect(
    session = session,
    "storm_overview_cost_index_lf_select",
    choices = prepare_choices(unique_lfs, full_lf_id, full_lf_id, lf_type),
    selected = unique_lfs$full_lf_id[1]
  )

  updateSelectInput(
    session,
    "growth_trend_lf_select",
    choices = unique_lfs$full_lf_id,
    selected = unique_lfs$full_lf_id[1]
  )
})
```

Col {data-width=500}
------------------------------------

### Track Map {.no-padding}
```{r}
# Overview - Track Map
# TODO: implement hurricane category status

storm_track <- reactive({
  req(storm_selection, storm_selection$is_selected)
  result <- get_hurdat_track(storm_selection)

  # HURDAT storm status
  # TD – Tropical cyclone of tropical depression intensity (< 34 knots)
  # TS – Tropical cyclone of tropical storm intensity (34-63 knots)
  # HU – Tropical cyclone of hurricane intensity (> 64 knots)
  # EX – Extratropical cyclone (of any intensity)
  # SD – Subtropical cyclone of subtropical depression intensity (< 34 knots)
  # SS – Subtropical cyclone of subtropical storm intensity (> 34 knots)
  # LO – A low that is neither a tropical cyclone, a subtropical cyclone, nor an extratropical cyclone (of any intensity)
  # WV – Tropical Wave (of any intensity)
  # DB – Disturbance (of any intensity)

  # Line Color          Storm Type                Status    Pressure (mb) Wind (mph)  Wind (knots)
  # Blue	              Subtropical Depression	  SD        --	          <=38 	      <=33
  # Light Blue	        Subtropical Storm	        SS        --	          39-73	      34-63
  # Green	              Tropical Depression (TD)	TD        --	          <=38	      <=33
  # Yellow	            Tropical Storm (TS)	      TS        980+	        39-73	      34-63
  # Red	                Hurricane (Cat 1)	        HU        <=980	        74-95	      64-82
  # Pink	              Hurricane (Cat 2)	        HU        965-980	      96-110	    83-95
  # Magenta	            Major Hurricane (Cat 3)	  HU        945-965	      111-129	    96-112
  # Purple	            Major Hurricane (Cat 4)	  HU        920-945	      130-156	    113-136
  # White	              Major Hurricane (Cat 5)	  HU        <=920	        157+	      137+
  # Green dashed (- -)  Wave/Low/Disturbance	    WV/LO/DB  --	          --	        --
  # Black hatched (++)  Extratropical Cyclone	    EX        --	          --	        --

  # Category  Sustained Windspeed (knots)
  # 1         64-82
  # 2         83-95
  # 3         96-112
  # 4         113-136
  # 5         137+

  # Preprocess the track data with colors
  result <- result %>%
    mutate(
      hurricane_category = case_when(
        # Hurricane Cat 1
        storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1,

        # Hurricane Cat 2
        storm_status == "HU" & windspeed >= 83 & windspeed <= 95 ~ 2,

        # Hurricane Cat 3
        storm_status == "HU" & windspeed >= 96 & windspeed <= 112 ~ 3,

        # Hurricane Cat 4
        storm_status == "HU" & windspeed >= 113 & windspeed <= 136 ~ 4,

        # Hurricane Cate 5
        storm_status == "HU" & windspeed >= 137 ~ 5,
      ),
      line_color = case_when(
        # Tropical Depression - Green
        storm_status == "TD" ~ "#2AFF00",

        # Tropical Storm - Yellow
        storm_status == "TS" ~ "#FFD020",

        # Hurricane Cat 1 - Red
        hurricane_category == 1 ~ "#FF4343",

        # Hurricane Cat 2 - Pink
        hurricane_category == 2 ~ "#FF6FFF",

        # Hurricane Cat 3 - Magenta
        hurricane_category == 3 ~ "#FF23D3",

        # Hurricane Cat 4 - Purple
        hurricane_category == 4 ~ "#C916FF",

        # Hurricane Cate 5 - White
        hurricane_category == 5 ~ "#FFFFFF",

        # Extratropical Cyclone
        storm_status == "EX" ~ "#202020",

        # Subtropical Depression
        storm_status == "SD" ~ "#0055FF",

        # Subtropical Storm
        storm_status == "SS" ~ "#6CE2FF",

        # Low
        storm_status == "LO" ~ "#A1A1A1",

        # Wave
        storm_status == "WV" ~ "#A1A1A1",

        # Disturbance
        storm_status == "DB" ~ "#A1A1A1",

        # Missing
        TRUE ~ "#FF5C00"
      ),
      popup_category = case_when(
        storm_status == "TD" ~ "TD",
        storm_status == "TS" ~ "TS",
        hurricane_category == 1 ~ "H1",
        hurricane_category == 2 ~ "H2",
        hurricane_category == 3 ~ "H3",
        hurricane_category == 4 ~ "H4",
        hurricane_category == 5 ~ "H5",
        storm_status == "EX" ~ "EX",
        storm_status == "SD" ~ "SD",
        storm_status == "SS" ~ "SS",
        storm_status == "LO" ~ "LO",
        storm_status == "WV" ~ "WV",
        storm_status == "DB" ~ "DB",
        TRUE ~ "NA"
      )
    ) %>%
    arrange(datetime)

  return(result)
})

output$track_map <- renderLeaflet({
  track_data <- storm_track()

  map <- leaflet() %>%
    addProviderTiles("Stadia.AlidadeSmooth") %>%
    fitBounds(
      lng1 = min(track_data$lon),
      lng2 = max(track_data$lon),
      lat1 = min(track_data$lat),
      lat2 = max(track_data$lat)
    )

  map <- map %>%
    leaflet::addLegend(
      position = "bottomleft",
      colors = c(
        "#2AFF00", # TD
        "#FFD020", # TS
        "#FF4343", # Cat 1
        "#FF6FFF", # Cat 2
        "#FF23D3", # Cat 3
        "#C916FF", # Cat 4
        "#FFFFFF", # Cat 5
        "#202020", # EX
        "#0055FF", # SD
        "#6CE2FF", # SS
        "#A1A1A1", # LO/WV/DB
        "#FF5C00" # Missing
      ),
      labels = c(
        "Tropical Depression (TD)",
        "Tropical Storm (TS)",
        "Hurricane Category 1",
        "Hurricane Category 2",
        "Hurricane Category 3",
        "Hurricane Category 4",
        "Hurricane Category 5",
        "Extratropical Cyclone (EX)",
        "Subtropical Depression (SD)",
        "Subtropical Storm (SS)",
        "Low/Wave/Disturbance (LO/WV/DB)",
        "Missing Data"
      ),
      opacity = 1,
      title = "Track Legend"
    )

  if (nrow(track_data) >= 2) {
    for (i in 1:(nrow(track_data) - 1)) {
      segment_data <- track_data[i:(i + 1), ]

      map <- map %>%
        addPolylines(
          data = segment_data,
          lng = ~lon,
          lat = ~lat,
          weight = 2,
          color = track_data$line_color[i],
          opacity = 1
        )
    }
  }

  map <- map %>%
    addCircleMarkers(
      data = track_data,
      lng = ~lon,
      lat = ~lat,
      radius = 2,
      color = ~line_color,
      fillOpacity = 1,
      popup = ~ paste0(
        "<b>DATE</b>",
        "<br>",
        datetime,
        "<br>",
        "<b>CATEGORY</b>",
        "<br>",
        popup_category,
        "<br>",
        "<b>WINDSPEED</b>",
        "<br>",
        windspeed,
        "kt",
        "<br>",
        "<b>PRESSURE</b>",
        "<br>",
        pressure,
        "mb"
      )
    )

  landfall_data <- track_data %>%
    filter(record_identifier == "L")

  if (nrow(landfall_data) > 0) {
    map <- map %>%
      addCircleMarkers(
        data = landfall_data,
        lng = ~lon,
        lat = ~lat,
        radius = 5,
        weight = 0,
        color = ~line_color,
        fillColor = ~line_color,
        fillOpacity = 1,
        popup = ~ paste0(
          "<b>LANDFALL</b>",
          "<br>",
          "<b>DATE</b>",
          "<br>",
          datetime,
          "<br>",
          "<b>CATEGORY</b>",
          "<br>",
          popup_category,
          "<br>",
          "<b>WINDSPEED</b>",
          "<br>",
          windspeed,
          "kt",
          "<br>",
          "<b>PRESSURE</b>",
          "<br>",
          pressure,
          "mb",
          "<br>",
          "<b>RMW</b>",
          "<br>",
          rmw,
          "nm"
        )
      ) %>%
      addCircles(
        data = landfall_data,
        lng = ~lon,
        lat = ~lat,
        radius = ~rmw_meters,
        weight = 2,
        color = ~line_color,
        fillColor = ~line_color,
        fillOpacity = 0.3,
        popup = ~ paste0(
          "<b>LANDFALL</b>",
          "<br>",
          "<b>DATE</b>",
          "<br>",
          datetime,
          "<br>",
          "<b>CATEGORY</b>",
          "<br>",
          popup_category,
          "<br>",
          "<b>WINDSPEED</b>",
          "<br>",
          windspeed,
          "kt",
          "<br>",
          "<b>PRESSURE</b>",
          "<br>",
          pressure,
          "mb",
          "<br>",
          "<b>RMW</b>",
          "<br>",
          rmw,
          "nm"
        )
      )
  }

  return(map)
})

leafletOutput("track_map", height = "100%")
```

Col {data-width=500 .tabset}
------------------------------------

### Normalization and Landfalls {}
```{r}
# Overview - Normalization and Landfalls

storm_yearly_normalization <- reactive({
  req(storm_selection$is_selected)

  result <- get_all_normalized_cost_index(storm_selection)

  return(result)
})

output$cost_index_chart <- renderDygraph({
  req(
    storm_yearly_normalization,
    input$storm_overview_cost_index_lf_select,
    input$storm_overview_cost_index_mmh_mmp,
    input$storm_overview_cost_index_scale,
    input$storm_overview_cost_index_y_scale
  )

  if (input$storm_overview_cost_index_y_scale == "Log") {
    is_y_log <- T
  } else {
    is_y_log <- F
  }

  normalized_data <- storm_yearly_normalization() %>%
    rename(
      "MMH Index" = mmh_index,
      "MMH Loss" = mmh_loss,
      "MMP Index" = mmp_index,
      "MMP Loss" = mmp_loss
    )

  selected_lf <- input$storm_overview_cost_index_lf_select
  selected_normalization <- input$storm_overview_cost_index_mmh_mmp
  selected_scale <- input$storm_overview_cost_index_scale

  method_map <- c("MMH", "MMP")
  selected_methods <- method_map[method_map %in% selected_normalization]

  if (selected_scale == "Index") {
    value_columns <- paste0(selected_methods, " Index")

    y_label <- "Cost Index"
  } else if (selected_scale == "Loss") {
    value_columns <- paste0(selected_methods, " Loss")

    y_label <- "Normalized Loss"
  }

  normalization_index <- normalized_data %>%
    filter(
      full_lf_id %in% selected_lf
    ) %>%
    mutate(
      normalization_year = as.Date(paste0(normalization_year, "-01-01"))
    ) %>%
    select(
      normalization_year,
      full_lf_id,
      all_of(value_columns)
    ) %>%
    pivot_wider(
      names_from = full_lf_id,
      values_from = all_of(value_columns),
      names_glue = "{full_lf_id} {.value}"
    )

  normalization_index_ts <- normalization_index %>%
    select(-normalization_year) %>%
    xts(order.by = normalization_index$normalization_year)

  dygraph(normalization_index_ts, ylab = y_label) %>%
    dyOptions(
      colors = paletteer_d(
        "ggthemes::Classic_Purple_Gray_12",
        ncol(normalization_index - 1)
      ),
      fillGraph = T,
      fillAlpha = .2,
      labelsKMB = T,
      logscale = is_y_log
    ) %>%
    dyAxis("x", drawGrid = F) %>%
    dyRangeSelector()
})

output$landfalls_table <- renderDT({
  req(storm_selection$is_selected)

  hurdat_landfalls <- get_hurdat_landfalls(storm_selection)

  datatable(
    hurdat_landfalls,
    rownames = F,
    colnames = c(
      "Date",
      "Longitude",
      "Latitude",
      "RMW",
      "Pressure",
      "Windspeed"
    ),
    options = list(
      order = list(0, 'asc'),
      paging = F,
      searching = F,
      info = F,
      lengthChange = F,
      server = T
    )
  ) %>%
    formatDate(columns = "datetime", method = "toUTCString")
})

fillCol(
  flex = c(0.7, 0.3),
  div(
    fluidRow(
      style = "height: 100%",
      column(
        3,
        virtualSelectInput(
          "storm_overview_cost_index_lf_select",
          "Landfalls",
          choices = NULL,
          showValueAsTags = T,
          multiple = T,
          autoSelectFirstOption = T
        ),
        radioGroupButtons(
          "storm_overview_cost_index_scale",
          label = "Value",
          choices = c("Index", "Loss"),
          status = "outline-primary rounded-0",
          justified = T
        ),
        checkboxGroupButtons(
          "storm_overview_cost_index_mmh_mmp",
          label = "MMH/MMP",
          choices = c("MMH", "MMP"),
          selected = c("MMH", "MMP"),
          status = "outline-primary rounded-0",
          justified = T
        ),
        radioGroupButtons(
          "storm_overview_cost_index_y_scale",
          label = "Y-Axis Scale",
          choices = c("Linear", "Log"),
          status = "outline-primary rounded-0",
          justified = T
        )
      ),
      column(9, dygraphOutput("cost_index_chart"))
    )
  ),
  div(
    DTOutput("landfalls_table")
  )
)

```

### Track Data {.no-padding}
```{r}
# Overview - Track Data

output$track_data <- renderDT({
  datatable(
    storm_track() %>%
      select(
        formatted_datetime,
        storm_status,
        lon,
        lat,
        rmw,
        pressure,
        windspeed
      ),
    rownames = F,
    colnames = c(
      "Date",
      "Status",
      "Lon",
      "Lat",
      "RMW",
      "Pressure",
      "Windspeed"
    ),
    selection = "none",
    options = list(
      pageLength = 1000,
      order = list(0, 'asc'),
      searching = F,
      paging = F,
      info = F,
      lengthChange = F,
      server = T
    )
  )
})

DTOutput("track_data")
```


Growth Trends {data-navmenu="Storm Details"}
================================

Column {data-width=550}
-------------------------------

### Growth Year {data-height=100}
```{r}

observe({
  req(storm_selection$is_selected)

  updateSliderInput(
    session,
    "growth_trend_map_slider",
    min = storm_selection$storm_year,
    value = storm_selection$storm_year
  )
})

sliderInput(
  "growth_trend_map_slider",
  label = NULL,
  min = 1926,
  max = 2024,
  step = 1,
  animate = list(
    interval = 250,
    loop = F
  ),
  value = 1926,
  sep = "",
  width = "100%",
  ticks = F
)
```

### Growth Map {data-height=700 .no-padding}

```{r}
# Growth - Growth Map
# TODO: implement data loading

growth_counties <- reactive({
  req(
    storm_selection$is_selected,
    input$growth_trend_lf_select
  )

  selected_lf <- input$growth_trend_lf_select

  counties <- get_normalized_metric_growth(storm_selection, selected_lf)

  result <- counties %>%
    #filter(year == 2024) %>%
    mutate(
      population_opacity = rescale(
        normalized_population,
        to = c(0.2, 0.8),
        from = range(normalized_population, na.rm = T)
      ),
      housing_opacity = rescale(
        normalized_housing,
        to = c(0.2, 0.8),
        from = range(normalized_housing, na.rm = T)
      )
    ) %>%
    st_as_sf(wkt = "geom_wkt")

  return(result)
})

output$growth_map <- renderLeaflet({
  leaflet() %>%
    addProviderTiles("Stadia.AlidadeSmooth")
})

observe({
  req(
    growth_counties,
    input$growth_trend_map_slider,
    input$growth_map_metric
  )

  growth_year <- input$growth_trend_map_slider

  growth_county_year <- growth_counties() %>%
    filter(
      year == growth_year
    )

  if (input$growth_map_metric == "Population") {
    leafletProxy("growth_map", data = growth_county_year) %>%
      clearShapes() %>%
      addPolygons(
        fillColor = "red",
        color = "red",
        fillOpacity = ~population_opacity,
        weight = 2
      )
  } else {
    leafletProxy("growth_map", data = growth_county_year) %>%
      clearShapes() %>%
      addPolygons(
        fillColor = "blue",
        color = "blue",
        fillOpacity = ~housing_opacity,
        weight = 2
      )
  }
})

leafletOutput("growth_map", height = "100%")
```

### Map Control {data-height=200}
```{r}
fluidRow(
  column(
    6,
    selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL)
  ),
  column(
    6,
    radioGroupButtons(
      "growth_map_metric",
      label = "Display Metric",
      choices = c("Population", "Housing"),
      selected = "Population",
      status = "outline-primary rounded-0",
      justified = T
    )
  )
)
```

Column {data-width=450}
----------------------------------

### Landfall Growth {data-height=550}
```{r}
# Growth - Trend Chart

dygraphOutput("test_dy")

output$test_dy <- renderDygraph({
  req(growth_counties)

  aggregated_growth <- growth_counties() %>%
    st_drop_geometry() %>%
    group_by(year) %>%
    summarize(
      avg_normalized_population = mean(normalized_population, na.rm = TRUE),
      avg_normalized_housing = mean(normalized_housing, na.rm = TRUE)
    ) %>%
    mutate(year = as.Date(paste0(year, "-01-01")))

  result <- aggregated_growth %>%
    select(year, avg_normalized_population, avg_normalized_housing)

  result_ts <- result %>%
    select(-year) %>%
    xts(order.by = result$year)

  dygraph(result_ts, main = "Normalized Growth") %>%
    dySeries("avg_normalized_population", label = "Population", color = "red") %>%
    dySeries("avg_normalized_housing", label = "Housing Units", color = "blue") %>%
    dyRangeSelector()
})

#output$popHu <- renderDygraph({
#  dygraph(aggregate_normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>%
#    dySeries("normalized_population", label = "Population") %>%
#    dySeries("normalized_housing_units", label = "Housing Units") %>%
#    dyRangeSelector()
#3})
```

### County Data {data-height=450 .no-padding}
```{r include=FALSE}
# Growth - County Table

output$county_growth_dt <- renderDT({
  req(growth_counties, input$growth_trend_map_slider, storm_selection$is_selected)

  base_year <- storm_selection$storm_year
  current_year <- input$growth_trend_map_slider

  # Get county names
  county_names <- public.counties %>%
    select(statefp, countyfp, namelsad) %>%
    collect()

  county_data <- growth_counties() %>%
    st_drop_geometry() %>%
    filter(year %in% c(base_year, current_year)) %>%
    left_join(
      county_names,
      by = c("state_fips" = "statefp", "county_fips" = "countyfp")
    ) %>%
    select(namelsad, year, population, housing_units) %>%
    pivot_wider(
      names_from = year,
      values_from = c(housing_units, population),
      names_glue = "{.value}_{year}"
    )

  housing_base <- paste0("housing_units_", base_year)
  housing_current <- paste0("housing_units_", current_year)
  pop_base <- paste0("population_", base_year)
  pop_current <- paste0("population_", current_year)

  county_data <- county_data %>%
    select(
      namelsad,
      all_of(c(housing_base, housing_current, pop_base, pop_current))
    )

  datatable(
    county_data,
    rownames = FALSE,
    options = list(
      order = list(0, 'asc'),
      paging = FALSE,
      searching = FALSE,
      info = FALSE,
      lengthChange = FALSE,
      server = TRUE
    ),
    colnames = c(
      "County",
      paste0(base_year, " HU"),
      paste0(current_year, " HU"),
      paste0(base_year, " POP"),
      paste0(current_year, " POP")
    )
  ) %>%
    formatStyle(
      columns = c(housing_base, housing_current),
    ) %>%
    formatStyle(
      columns = c(pop_base, pop_current),
    ) %>%
    formatCurrency(
      columns = c(housing_base, housing_current, pop_base, pop_current),
      digits = 0,
      before = FALSE
    )
})

DTOutput("county_growth_dt")
```

Normalization Calculator {data-navmenu="Compute"}
===

```{r}
# Calculator - Setup Code

calculator_storm_selection <- reactiveValues(
  storm_year = NULL,
  storm_name = NULL,
  storm_basin = NULL,
  full_lf_id = NULL,
)

observeEvent(input$impact_populate_storm, {
  calculator_storm_selection$storm_basin = input$impact_storm_basin
  calculator_storm_selection$storm_year = input$impact_storm_year
  calculator_storm_selection$storm_name = input$impact_storm_name
  calculator_storm_selection$full_lf_id = input$impact_storm_full_lf_id

  calculator_storm_details <- get_lf_type_factors(calculator_storm_selection)

  updateTextInput(
    session,
    "impact_lat",
    value = calculator_storm_details$lat
  )

  updateTextInput(
    session,
    "impact_lon",
    value = calculator_storm_details$lon
  )

  updateTextInput(
    session,
    "impact_rmw",
    value = calculator_storm_details$rmw
  )

  updateSliderInput(
    session,
    "impact_rmw_slider",
    value = calculator_storm_details$rmw
  )

  updateTextInput(
    session,
    "impact_base_year",
    value = calculator_storm_details$storm_year
  )

  updateTextInput(
    session,
    "impact_ref_year",
    value = "2024"
  )

  updateTextInput(
    session,
    "impact_base_damage",
    value = calculator_storm_details$mwr
  )
})
```

Column {data-width=700}
---

### Impact Map {.no-padding}
```{r}
# Calculator - Impact Map

output$impact_analysis_map <- renderLeaflet({
  leaflet() %>%
    addProviderTiles("Stadia.AlidadeSmooth") #%>%
    #setView(lng = -80.3, lat = 25.6, zoom = 10) %>%
    #addCircles(
    #  lng = -80.3,
    #  lat = 25.6,
    #  radius = 37040,
    #  color = "blue",
    #  weight = 2,
    #  opacity = 0.3
    #) %>%
    #addCircleMarkers(
    #  lng = -80.3,
    #  lat = 25.6,
    #  radius = 5,
    #  weight = 0,
    #  color = "blue",
    #  fillColor = "blue",
    #  fillOpacity = 0.6
    #)
})

leafletOutput("impact_analysis_map", height = "100%")
```

Column {data-width=300}
---

### {}
```{r}
# Calculator - Input
# TODO: add data population and compute

observeEvent(input$impact_storm_year, {
  stormsByChosenYear <- all_lf_type_storms[all_lf_type_storms$storm_year == input$impact_storm_year, ]

  stormsByYear <- all_lf_type_storms %>% filter(storm_year == input$impact_storm_year)

  updateSelectInput(
    session,
    "impact_storm_name",
    choices = stormsByYear$storm_name,
    selected = NULL
  )
})

observeEvent(input$impact_storm_name, {
  uniqueLfs <- all_lf_type_storms %>% 
    filter(
      storm_basin == input$impact_storm_basin,
      storm_year == input$impact_storm_year,
      storm_name == input$impact_storm_name
    )

  updateSelectInput(
    session,
    "impact_storm_full_lf_id",
    choices = uniqueLfs$full_lf_id
  )
})

observe({
  req(
    input$impact_lat,
    input$impact_lon
  )

  new_lat <- as.numeric(input$impact_lat)
  new_lon <- as.numeric(input$impact_lon)

  if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) {
    rmw_meters <- input$impact_rmw_slider * 1852

    leafletProxy("impact_analysis_map") %>%
      setView(lat = new_lat, lng = new_lon, zoom = 9) %>% 
      clearShapes() %>%
      clearMarkers() %>% 
      addCircleMarkers(
        lng = new_lon,
        lat = new_lat,
        radius = 2,
        weight = 0,
        color = "blue",
        fillColor = "blue",
        fillOpacity = 0.5
      ) %>%
      addCircles(
        lng = new_lon,
        lat = new_lat,
        radius = rmw_meters,
        weight = 1,
        color = "blue",
        fillColor = "blue",
        fillOpacity = 0.05
      )
  }
})

observe({
  req(input$impact_rmw)

  if(as.numeric(input$impact_rmw) > 0) {
    updateSliderInput(
      session,
      "impact_rmw_slider", 
      value = input$impact_rmw
    )
  }
})

observe({
  req(input$impact_rmw_slider)

  updateTextInput(
    session,
    "impact_rmw",
    value = input$impact_rmw_slider
  )
})

observe({
  req(input$impact_rmw, input$impact_rmw_slider)

  rmw_meters <- input$impact_rmw_slider * 1852

  new_lon = input$impact_storm_lon
  new_lat = input$impact_storm_lat

  req(new_lon, new_lat)

  if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) {
    leafletProxy("impact_analysis_map") %>%
      clearShapes() %>%
      clearMarkers() %>% 
      addCircleMarkers(
        lng = new_lon,
        lat = new_lat,
        radius = 2,
        weight = 0,
        color = "blue",
        fillColor = "blue",
        fillOpacity = 0.5
      ) %>%
      addCircles(
        lng = new_lon,
        lat = new_lat,
        radius = rmw_meters,
        weight = 1,
        color = "blue",
        fillColor = "blue",
        fillOpacity = 0.05
      )
  }
})

div(
  h6("Storm Selector"),

  fluidRow(
    column(
      6,
      selectInput(
        "impact_storm_basin",
        label = NULL,
        choices = "AL",
        width = "100%"
      ),
    ),
    column(
      6,
      selectInput(
        "impact_storm_year",
        label = NULL,
        choices = all_lf_type_storms$storm_year,
        width = "100%"
      ),
    )
  ),
  fluidRow(
    column(
      6,
      selectInput(
        "impact_storm_name",
        label = NULL,
        choices = NULL,
        width = "100%"
      ),
    ),
    column(
      6,
      selectInput(
        "impact_storm_full_lf_id",
        label = NULL,
        choices = "1",
        width = "100%"
      )
    )
  ),

  actionButton(
    "impact_populate_storm",
    label = "Populate",
    width = "100%",
    class = "btn-primary rounded"
  )
)

hr()

div(
  fluidRow(
    column(
      6,
      textInput(
        "impact_lat",
        placeholder = "Lat",
        value = "25.6",
        label = "Latitude",
        width = "100%"
      )
    ),
    column(
      6,
      textInput(
        "impact_lon",
        placeholder = "Lon",
        value = "-80.3",
        label = "Longitude",
        width = "100%"
      )
    )
  ),

  fluidRow(
    column(
      4,
      textInput(
        "impact_rmw",
        placeholder = "RMW",
        value = "20",
        label = "RMW (NM)",
        width = "100%"
      )
    ),
    column(
      8,
      sliderInput(
        "impact_rmw_slider",
        label = NULL,
        min = 1,
        max = 150,
        value = 20,
        ticks = F,
        width = "100%"
      )
    )
  ),

  radioGroupButtons(
    "impact_rmw_multiplier",
    label = "RMW Multiplier",
    choices = c("1x", "2x", "3x"),
    selected = "2x",
    status = "outline-primary rounded-0",
    justified = T
  ),

  fluidRow(
    column(
      6,
      textInput(
        "impact_base_year",
        placeholder = "Impact Year",
        value = "1926",
        label = "Base Year",
        width = "100%"
      )
    ),
    column(
      6,
      textInput(
        "impact_ref_year",
        placeholder = "Reference Year",
        value = "2024",
        label = "Ref Year",
        width = "100%"
      )
    )
  ),

  textInput(
    "impact_base_damage",
    placeholder = "Storm Base Damage",
    label = "Base Damage",
    value = "76,000,000",
    width = "100%"
  ),

  actionButton(
    "impact_calculate",
    label = "Calculate",
    width = "100%",
    class = "btn-primary rounded"
  )
)
```

Data Export {data-navmenu="Compute"}
===

```{r}
# Export - Mock Data

datasets_info <- data.frame(
  id = c(
    "hurricane_costs",
    "population_housing",
    "fatalities",
    "storm_tracks",
    "affected_areas",
    "economic_data"
  ),
  name = c(
    "Hurricane Cost Normalization",
    "Population & Housing",
    "Storm Fatalities",
    "Hurricane Best Track",
    "Affected Areas",
    "Yearly Economics"
  ),
  description = c(
    "Normalized economic damage estimates for US landfalling hurricanes 1900-2023 using updated RMW methodology",
    "County-level population and housing unit data used for normalization calculations",
    "Direct and indirect fatalities from hurricane impacts by location and storm",
    "Best track data including storm positions, intensities, and wind radii from HURDAT2",
    "Geographic areas impacted by hurricane landfalls with RMW coverage percentages",
    "Yearly economic data used in normalization calculations"
  ),
  size = c(
    "~200 storms",
    "3,000+ counties",
    "150+ storms",
    "2,000+ storms",
    "5,000+ records",
    "100+ years"
  ),
  last_updated = c(
    "2024-12-01",
    "2024-11-15",
    "2024-10-30",
    "2024-12-15",
    "2024-11-30",
    "2025-01-01"
  ),
  tables = c(
    "econ.normalized_landfalls, econ.storm_base_loss",
    "metrics.pop_and_housing",
    "fatal.storm_total_fatalities, fatal.storm_fatalities_type",
    "hurdat.best_track, hurdat.hurdat_storms",
    "gis.affected_area_landfalls",
    "econ.usa_yearly"
  ),
  stringsAsFactors = FALSE
)

# Reactive values to store selected datasets
values <- reactiveValues(selected_datasets = character(0))
```

Column {data-width=600}
-------------------------------------

### Available Datasets

```{r}
# Export - Datasets
create_dataset_card <- function(dataset_row) {
  card_id <- paste0("card_", dataset_row$id)

  div(
    class = "dataset-card",
    id = card_id,
    style = "border: 2px solid #e3e3e3; border-radius: 8px; padding: 15px; margin: 10px 0; cursor: pointer; transition: all 0.3s ease;",

    div(
      style = "display: flex; justify-content: space-between; align-items: flex-start;",

      # Left content
      div(
        style = "flex: 1;",
        tags$b(
          dataset_row$name,
          style = "font-size: 16px; margin: 0 0 8px 0; color: #2c3e50; display: block;"
        ),
        p(
          dataset_row$description,
          style = "margin: 0 0 10px 0; color: #5a6c7d; font-size: 14px; line-height: 1.4;"
        ),

        # Metadata row
        div(
          style = "display: flex; gap: 20px; flex-wrap: wrap;",
          span(
            icon("database"),
            strong("Size: "),
            dataset_row$size,
            style = "color: #7f8c8d; font-size: 12px;"
          ),
          span(
            icon("calendar"),
            strong("Updated: "),
            dataset_row$last_updated,
            style = "color: #7f8c8d; font-size: 12px;"
          ),
          span(
            icon("table"),
            strong("Tables: "),
            dataset_row$tables,
            style = "color: #7f8c8d; font-size: 11px;"
          )
        )
      ),

      # Selection checkbox
      div(
        style = "margin-left: 15px;",
        checkboxInput(
          inputId = paste0("select_", dataset_row$id),
          label = NULL,
          value = FALSE,
          width = "20px"
        )
      )
    )
  )
}

# Update selected datasets based on checkboxes
observe({
  selected <- character(0)
  for (i in 1:nrow(datasets_info)) {
    dataset_id <- datasets_info[i, "id"]
    if (isTruthy(input[[paste0("select_", dataset_id)]])) {
      selected <- c(selected, dataset_id)
    }
  }
  values$selected_datasets <- selected
})

# Add JavaScript for card click interaction
tags$script(HTML(
  "
  $(document).on('click', '.dataset-card', function() {
    var checkbox = $(this).find('input[type=\"checkbox\"]');
    checkbox.prop('checked', !checkbox.prop('checked')).trigger('change');
    
    if(checkbox.prop('checked')) {
      $(this).addClass('selected');
    } else {
      $(this).removeClass('selected');
    }
  });
"
))

# Instructions
div(
  style = "margin-bottom: 20px; padding: 15px; background-color: #f0f8ff; border-radius: 0; border-left: 4px solid #3498db;",
  p(
    strong("Instructions:"),
    "Select datasets from the cards below by clicking on them. Your selected datasets will appear in the export panel on the right.",
    style = "margin: 0; color: #2c3e50;"
  )
)

# Render dataset cards
output$dataset_cards <- renderUI({
  cards <- lapply(1:nrow(datasets_info), function(i) {
    create_dataset_card(datasets_info[i, ])
  })
  do.call(tagList, cards)
})

uiOutput("dataset_cards")
```

Column {data-width=400}
-------------------------------------

### Data Export {data-height=600}

```{r}
# Export - Download

div(
  class = "export-box",

  tags$b(
    "Export Selected Data",
    style = "font-size: 18px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 15px;"
  ),

  # Selected datasets display
  tags$b(
    "Selected Datasets:",
    style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"
  ),
  div(
    id = "selected-datasets-display",
    style = "min-height: 60px; margin-bottom: 20px; padding: 10px; background-color: white; border-radius: 4px; border: 1px solid #ddd;",
    uiOutput("selected_datasets_display")
  ),

  # Format selection
  tags$b(
    "Export Format:",
    style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"
  ),
  radioButtons(
    "export_format",
    label = NULL,
    choices = list(
      "CSV (Comma Separated)" = "csv",
      "JSON" = "json"
    ),
    selected = "csv",
    inline = FALSE
  ),

  # Export options
  checkboxInput(
    "include_documentation",
    "Include documentation",
    value = TRUE
  ),

  # Export button
  br(),
  downloadButton(
    "download_data",
    "Export Selected Data",
    class = "btn-primary",
    style = ""
  )
)

# Display selected datasets
output$selected_datasets_display <- renderUI({
  if (length(values$selected_datasets) == 0) {
    p(
      "No datasets selected",
      style = "color: #95a5a6; font-style: italic; margin: 20px 0;"
    )
  } else {
    selected_names <- datasets_info$name[
      datasets_info$id %in% values$selected_datasets
    ]
    lapply(selected_names, function(name) {
      span(
        class = "selected-item",
        icon("check-circle"),
        " ",
        name
      )
    })
  }
})
```

### Contact {data-height=400}

```{r}
# Export - Contact

div(
  class = "info-box",
  tags$b(
    "Need More Data?",
    style = "font-size: 16px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 10px;"
  ),
  p(
    "Additional datasets, custom queries, and research collaborations are available through our team.",
    style = "margin-bottom: 15px; color: #5a6c7d; font-size: 14px;"
  ),

  p(
    icon("envelope"),
    strong(" Email:"),
    " [CONTACT US EMAIL]",
    style = "margin: 5px 0; color: #34495e; font-size: 14px;"
  )
)
```

Tracked Storms {data-navmenu="All Storms"}
===

Column {data-width=650}
---

### {}
```{r}
# Tracking - Storms Table

#DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline?
output$normalized_storms_full_table <- renderDT({
  datatable(
    latest_normalized_losses,
    rownames = F,
    colnames = c("HURDAT Code", "Storm", "Year", "MMH24", "MMP24"),
    selection = "none",
    options = list(
      pageLength = 20,
      order = list(0, 'asc'),
      server = T
    )
  ) %>%
    formatCurrency(c("mmh", "mmp"), "$", digits = 0)
})

DTOutput("normalized_storms_full_table")
```

Column {data-width=350}
---

### {.no-padding}
```{r}
# Tracking - Storms Map

output$all_storms_map <- renderLeaflet({
  leaflet() %>%
    addProviderTiles("Stadia.AlidadeSmooth") %>%
    addCircleMarkers(
      data = all_conus_landfalls,
      lng = ~lon,
      lat = ~lat,
      radius = 2,
      popup = ~ paste0(storm_name, " ", storm_year),
      weight = 0,
      color = "blue",
      fillColor = "blue",
      fillOpacity = 0.5
    ) %>%
    addCircles(
      data = all_conus_landfalls,
      lng = ~lon,
      lat = ~lat,
      radius = ~rmw_meters,
      popup = ~ paste0(storm_name, " ", storm_year),
      weight = 1,
      color = "blue",
      fillColor = "blue",
      fillOpacity = 0.05
    )
})

leafletOutput("all_storms_map", height = "100%")
```

About 
===