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 setup, include=FALSE}
# TODO:
# - update normalization to new 2024 data
# - 

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)

# local testing env setup
os <- Sys.info()["sysname"]

linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
widir <- "E/..."

if(!is.null(os)) {
  if(grepl("darwin", os, ignore.case = T)) {
    cat("OS: Mac")
    baseDir <- macdir
  } else if(grepl("linux", os, ignore.case = T)) {
    cat("OS: Linux")
    baseDir <- linuxdir
  } else if(grepl("windows", os, ignore.case = T)) {
    cat("OS: Win")
    baseDir <- windir 
  } else {
    cat("Cannot identify OS")
  }
}

config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml"))

source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R"))

# SUPABASE CON
#con <- dbConnect(
#  RPostgres::Postgres(),
#  host = config$db_host,
#  port = config$db_port,
#  dbname = config$db_dbname,
#  user = config$db_user,
#  password = config$db_password
#)
#
## lazy load DB tables
#econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls"))
#econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss"))
#econ.usa_yearly <- tbl(con, I("econ.usa_yearly"))
#
#fatal.storm_fatalities_type <- tbl(con, I("fatal.storm_fatalities_type"))
#fatal.storm_total_fatalities <- tbl(con, I("fatal.storm_total_fatalities"))
#
#fips.counties <- tbl(con, I("fips.counties"))
#fips.states <- tbl(con, I("fips.states"))
#
#gis.affected_area_landfalls <- tbl(con, I("gis.affected_area_landfalls"))
#
#hurdat.best_track <- tbl(con, I("hurdat.best_track"))
#hurdat.hurdat_storms <- tbl(con, I("hurdat.hurdat_storms"))
#
#metrics.geo_attributes <- tbl(con, I("metrics.geo_attributes"))
#metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing"))
#
#public.counties <- tbl(con, I("public.counties"))

# pull static data
loss_storms <- get_all_loss_storms()

latest_normalized_losses <- get_latest_aggregate_losses()

all_storm_tracks <- get_all_hurdat_tracks()

all_conus_landfalls <- get_all_conus_landfalls()

all_storm_landfalls <- all_storm_tracks %>% 
  filter(record_identifier == "L")

storm_selection <- reactiveValues(
  storm_year = NULL,
  storm_name = NULL,
  storm_basin = NULL,
  lf_id = NULL,
  is_selected = FALSE,
  is_table_selection = FALSE,
)

async_reqs <- reactiveValues(
  hurdat_track = NULL,
)

loading_states <- reactiveValues(
  hurdat_track = FALSE,
  track_error = NULL,
)

onStop(function() {
  #dbDisconnect(con)
  
  #daemons(0)
  
  #if(!is.null(async_reqs$hurdat_track)) {
  #  tryCatch({
  #    async_reqs$hurdat_track <- NULL
  #  }, error = function(e) {
  #    cat(e)
  #  })
  #}
})
```

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

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

### {}
```{r}
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 professional, 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>PL22:</b> The Pielke-Landsea (2022) normalization that adjusts for inflation, wealth per capita, and population changes. This data has been updated to 2022.</li>
    
    <li><b>CL22:</b> The Collins-Lowe (2022) normalization that adjusts for inflation, wealth per housing unit, and housing unit changes. This data has been updated to 2022.</li>
    
    <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 incoroprates 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> Inlcuding 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}
#h5("Select a storm: ")
#h6("Use either the select inputs or the data table below")

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 $3.6T in losses spanning from 1900 to 2024
    ')
  )
)



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}
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}
### REACTIVE VALUES FOR STORM OVERVIEW

storm_overview_reactive <- reactiveValues(
  lf_type = NULL,
  lf_id = NULL,
  full_lf_id = NULL,
  use_normalized_costs = FALSE
)

growth_trends <- reactiveValues(
  lf_type = NULL,
  lf_id = NULL,
  full_lf_id = NULL
)

observe({
  req(storm_selection$is_selected)
  
  unique_lfs <- get_unique_lf_ids(storm_selection)
  
  #updateSelectInput(
  #  session,
  #  "storm_overview_cost_index_lf", 
  #  choices = unique_lfs$full_lf_id,
  #  selected = unique_lfs$full_lf_id[1]
  #)
  
  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 .tabset}
------------------------------------

### Track Map {.no-padding}
```{r}
storm_track <- reactive({
  req(storm_selection$is_selected)

  result <- get_hurdat_track(storm_selection)
  
  return(result)
})

output$track_map <- renderLeaflet({
  leaflet() %>% 
    addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) 
    # %>% setView(lng = -89.8, lat = 29.6, zoom = 8)
})

observe({
  req(storm_selection$is_selected)
  
  storm_track <- storm_track()
    
  leafletProxy("track_map", data = storm_track) %>% 
  clearShapes() %>% 
  clearMarkers() %>%
  addPolylines(
    data = storm_track,
    lng = ~lon,
    lat = ~lat,
    weight = 4,
    color = "blue"
  ) %>% 
  addCircleMarkers(
    data = storm_track %>% filter(record_identifier == "L"),
    lng = ~lon,
    lat = ~lat,
    radius = 5,
    weight = 0,
    color = "red",
    fillColor = "red",
    fillOpacity = 0.8
  ) %>% 
  addCircles(
    data = storm_track %>% filter(record_identifier == "L"),
    lng = ~lon,
    lat = ~lat,
    radius = ~rmw_meters,
    weight = 2,
    color = "red",
    fillColor = "red",
    fillOpacity = 0.3
  ) 
})

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

### Track Data {.no-padding}
```{r}
output$track_data <- renderDT({
  datatable(
    storm_track() %>% select(datetime, lon, lat, rmw, pressure, windspeed, record_identifier),
    rownames = F,
    colnames = c("Date", "Longitude", "Latitude", "RMW (NM)", "Pressure (mb)", "Windpseed (KT)", "Identifier"),
    selection = "none",
    options = list(
      pageLength = 1000,
      order = list(0, 'desc'),
      searching = F,
      paging = F,
      info = F,
      lengthChange = F,
      server = T
    )
  )
})

DTOutput("track_data")
```

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

### Normalization Cost Index {data-height=700}
```{r}
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)
  
  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")
  } else if (selected_scale == "Loss") {
    value_columns <- paste0(selected_methods, " 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) %>%
    dyOptions(
      colors = paletteer_d("ggthemes::Classic_Purple_Gray_12", ncol(normalization_index - 1)),
      fillGraph = T,
      fillAlpha = .2,
      
    ) %>% 
    dyAxis("x", drawGrid = F) %>% 
    dyRangeSelector()
})

fluidRow(
    style = "height: 100%",
    column(3,
           virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls", 
                              #choices = list(
                              #  "LF" = c("LF1", "LF2", "LF3"),
                              #  "DIL" = c("DIL1", "DIL2", "DIL3", "DIL4"),
                              #  "ID" = c("ID1", "ID2", "ID3", "ID4")
                              #),
                              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)
    ),
    column(9,
           dygraphOutput("cost_index_chart")
    )
)
```

### Landfalls {data-height=300 .no-padding}
```{r}
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")
})

DTOutput("landfalls_table")
```


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

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

### Growth Map {.no-padding}

```{r}
observe({
  req(storm_selection$is_selected)
  
  updateSliderInput(session,
                    "growth_trend_map_slider",
                    min = storm_selection$storm_year,
                    value = storm_selection$storm_year)
})



#storm_metrics_growth_geom <- reactive({
#  req(storm_selection$is_selected)
#  
#  counties <- get_normalized_metric_growth(storm_selection, input$growth_trend_lf_select) 
#  
#  result <- counties %>% 
#    st_as_sf(wkt = "geom_wkt")
#  #%>% 
#  #  mutate(
#  #    clamped_population = rescale(normalized_population, to = c(0.1, 0.9), from = range(normalized_population, na.rm = T)),
#  #    clamped_housing = rescale(normalized_housing, to = c(0.1, 0.9), from = range(normalized_housing, na.rm = T))
#  #  ) %>% 
#    
#  
#  cat(str(result))
#  
#  return(result)
#})

#observe({
#  req(storm_selection$is_selected, input$growth_trend_map_slider)
#  
#  county_data <- storm_metrics_growth_geom() %>% 
#    filter(year == input$growth_trend_map_slider)
#
#  cat(str(county_data))
#
#  leafletProxy("pop_growth_map", session) %>% 
#    clearShapes() %>% 
#    addPolygons(
#      data = county_data,
#      fillColor = "red",
#      fillOpacity = 1
#    )
#})

test_storm <- reactiveValues(
  storm_basin = "AL",
  storm_year = 2005,
  storm_name = "KATRINA",
)

katrina_counties <- reactive({
  req(storm_selection$is_selected)
  
  counties <- get_normalized_metric_growth(test_storm, "LF2")
  
  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$pop_growth_map <- renderLeaflet({
  leaflet() %>% 
    addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) 
    # %>% setView(lng = -89.8, lat = 29.6, zoom = 8)
})

output$housing_growth_map <- renderLeaflet({
  leaflet() %>% 
    addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) 
    # %>% setView(lng = -89.8, lat = 29.6, zoom = 8)
})

observe({
  req(katrina_counties)
  
  leafletProxy("pop_growth_map", data = katrina_counties()) %>% 
    clearShapes() %>% 
    addPolygons(
      fillColor = "red",
      color = "red",
      fillOpacity = ~population_opacity,
      weight = 2
    )
  
  leafletProxy("housing_growth_map", data = katrina_counties()) %>% 
    clearShapes() %>% 
    addPolygons(
      fillColor = "blue",
      color = "blue",
      fillOpacity = ~housing_opacity,
      weight = 2
    )
})

fillCol(
  flex = c(.1, .45, .45),
  div(
    style = "
      padding-left: 15px;
      padding-right: 15px;
      padding-top: 15px;
      display: flex;
      justify-content: center;
      align-itmes: center;
    ",
    sliderInput("growth_trend_map_slider", label = NULL, min = 1900, max = 2024, step = 1, animate = T, value = 1700, sep = "", width = "100%", ticks = F)
  ),
  leafletOutput("pop_growth_map"),
  leafletOutput("housing_growth_map")
)
```

### Growth Data {.no-padding}
```{r}


```

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

### Landfall Selection {data-height=550}
```{r}
fillCol(
  flex = c(.2, .8),
  fluidRow(
    column(6,
           selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL)
    ),
    column(6,
           # TODO: add button to select normalized costs
           #checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F)
    )
  ),
  #dygraphOutput("popHu")
)

#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}


```

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




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

Column {data-width=700 .tabset}
---

### Impact Map {.no-padding}
```{r}
output$impact_analysis_map <- renderLeaflet({
  leaflet() %>% 
    addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) 
    # %>% setView(lng = -89.8, lat = 29.6, zoom = 8)
})

leafletOutput("impact_analysis_map")
```

### Impact Data {.no-padding}
```{r}

```

Column {data-width=300}
---

### {}
```{r}
fillCol(
  flex = c(.5, .5),
  div(
    p("Storm Selector"),
    selectInput("impact_storm_basin", label = NULL, choices = "AL", width = "100%"),
    selectInput("impact_storm_year", label = NULL, choices = 2005, width = "100%"),
    selectInput("impact_storm_name", label = NULL, choices = "KATRINA", width = "100%"),
    
    fluidRow(
      column(6, 
        selectInput("impact_storm_lf_type", label = NULL, choices = "LF", width = "100%") 
      ),
      column(6,
        selectInput("impact_storm_lf_id", label = NULL, choices = "1", width = "100%") 
      )
    ),
    
    actionButton("impact_populate_storm", label = "Populate", width = "100%", class = "btn-primary rounded")
  ),
  div(
    p("Impact Area"),
    
    fluidRow(
      column(6,
        textInput("impact_lat", placeholder = "Lat", label = NULL, width = "100%")   
      ),
      column(6,
        textInput("impact_lon", placeholder = "Lon", label = NULL, width = "100%")             
      )
    ),
    
    fluidRow(
      column(4,
        textInput("impact_rmw", placeholder = "RMW", label = NULL, width = "100%")  
      ),
      column(8,
        sliderInput("impact_rmw_slider", label = NULL, min = 1, max = 20, value = 5, ticks = F, width = "100%")
      )
    ),
    
    #fluidRow(
    #  column(3,
    #    actionButton("impact_rmw_one", label = "1x", width = "100%", class = "btn-primary")
    #  ),
    #  column(3,
    #    actionButton("impact_rmw_two", label = "2x", width = "100%", class = "btn-outline-primary btn-#block")
    #  ),
    #  column(3,
    #    actionButton("impact_rmw_three", label = "3x", width = "100%", class = "btn-outline-primary btn-#block")
    #  )
    #),
    
    radioGroupButtons("impact_rmw_multiplier", label = NULL, choices = c("1x", "2x", "3x"), status = "outline-primary rounded-0", justified = T),
    
    fluidRow(
      column(6,
        textInput("impact_base_year", placeholder = "Impact Year", label = NULL, width = "100%")   
      ),
      column(6,
        textInput("impact_ref_year", placeholder = "Reference Year", label = NULL, width = "100%")             
      )
    ),
    
    textInput("impact_base_damage", placeholder = "Storm Base Damage", label = NULL, width = "100%"),
    
    actionButton("impact_calculate", label = "Calculate", width = "100%", class = "btn-primary rounded")
  )
)
```







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

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

Column {data-width=650}
---

### {}
```{r}

#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'),
      #searching = F,
      #paging = F,
      #info = F,
      #lengthChange = F,
      server = T
    )
  ) %>% 
    formatCurrency(c("mmh", "mmp"), "$", digits = 0)
})

DTOutput("normalized_storms_full_table")


```

Column {data-width=350}
---

### {.no-padding}
```{r}
output$all_storms_map <- renderLeaflet({
  leaflet() %>% 
    addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% 
    # %>% setView(lng = -89.8, lat = 29.6, zoom = 8)
    #addPolylines(
    #data = all_storm_tracks,
    #lng = ~lon,
    #lat = ~lat,
    #weight = .5,
    #color = "blue"
  #) %>% 
  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")
```

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

Column {data-width=500}
---

### {data-height=500}
```{r}
fatality_years <- seq(1900, 2010, by = 10)
direct_deaths <- c(6000, 275, 0, 408, 26, 654, 466, 213, 104, 228, 1136, 321)
indirect_deaths <- c(0, 0, 0, 0, 0, 1, 8, 15, 40, 54, 1171, 368)

yearly_fatalities <- data.frame(fatality_years, direct_deaths, indirect_deaths) %>% 
  mutate(
    fatality_years = as.Date(paste0(fatality_years, "-01-01"))
  )

yearly_fatalities_ts <- yearly_fatalities %>% 
  select(-fatality_years) %>% 
  xts(order.by = yearly_fatalities$fatality_years)

output$decade_fatalities <- renderDygraph(
  dygraph(yearly_fatalities_ts, main = "Fatalities By Decade") %>% 
    dySeries("direct_deaths", label = "Direct Deaths") %>% 
    dySeries("indirect_deaths", label = "Indirect Deaths") %>% 
    dyRangeSelector()
)

dygraphOutput("decade_fatalities")
```

### {data-height=500}
```{r}
surge_yearly <- c(0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 410, 107)
surf_yearly <- c(0, 0, 0, 0, 0, 0, 0, 14, 2, 12, 12, 17)
rough_seas_yearly <- c(0, 0, 0, 0, 16, 0, 2, 0, 24, 17, 0, 14)
rip_current_yearly <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 14, 3)
freshwater_floods_yearly <- c(0, 0, 0, 0, 0, 200, 12, 151, 0, 117, 50, 284)
wind_yearly <- c(0, 0, 0, 0, 0, 0, 0, 8, 14, 23, 11, 82)
tree_fall_yearly <- c(0, 0, 0, 0, 1, 0, 0, 1, 0, 9, 24, 56)
tornado_yearly <- c(0, 0, 0, 0, 1, 12, 43, 7, 0, 7, 11, 7)
traffic_yearly <- c(0, 0, 0, 0, 0, 0, 0, 4, 0, 3, 2, 1)
traffic_accident_yearly <- c(0, 0, 0, 0, 0, 0, 5, 0, 0, 8, 26, 11)
electrocution_yearly <- c(0, 0, 0, 0, 0, 0, 2, 0, 0, 5, 2, 7)
other_yearly <- c(0, 0, 0, 0, 5, 0, 5, 11, 15, 13, 37, 7)

yearly_fatalities_type <- data.frame(fatality_years, surge_yearly, surf_yearly, rough_seas_yearly, rip_current_yearly, freshwater_floods_yearly, wind_yearly, tree_fall_yearly, tornado_yearly, traffic_yearly, traffic_accident_yearly, electrocution_yearly, other_yearly) %>% 
  mutate(
    fatality_years = as.Date(paste0(fatality_years, "-01-01"))
  )

yearly_fatalities_type_ts <- yearly_fatalities_type %>% 
  select(-fatality_years) %>% 
  xts(order.by = yearly_fatalities_type$fatality_years)

output$decade_fatalities_type <- renderDygraph(
  dygraph(yearly_fatalities_type_ts, main = "Fatality Types By Decade") %>% 
    dySeries("surge_yearly", label = "Surge") %>% 
    dySeries("surf_yearly", label = "Surf") %>% 
    dySeries("rough_seas_yearly", label = "Rough Seas") %>% 
    dySeries("rip_current_yearly", label = "Rip Current") %>% 
    dySeries("freshwater_floods_yearly", label = "Freshwater Floods") %>% 
    dySeries("wind_yearly", label = "Wind") %>% 
    dySeries("tree_fall_yearly", label = "Tree Fall") %>% 
    dySeries("tornado_yearly", label = "Tornado") %>% 
    dySeries("traffic_yearly", label = "Traffic") %>% 
    dySeries("traffic_accident_yearly", label = "Traffic Accident") %>% 
    dySeries("electrocution_yearly", label = "Electrocution") %>% 
    dySeries("other_yearly", label = "Other") %>% 
    dyRangeSelector()
)

dygraphOutput("decade_fatalities_type")
```

Column {data-width=500}
---

### {data-height=500}
```{r}
fatality_type <- c("Surge", "Surf", "Rough Seas", "Rip Current", "Floods", "Wind", "Tree Fall", "Tornado", "Traffic", "Traffic Accident", "Electrocution", "Other")
fatality_totals <- c(520, 56, 77, 23, 826, 131, 91, 88, 10, 45, 16, 56)

aggregate_fatality_types <- data.frame(fatality_type, fatality_totals)

output$aggregate_fatalities <- renderBillboarder(
  billboarder() %>% 
    bb_piechart(aggregate_fatality_types) 
    #%>% bb_legend(position = "right")
)

billboarderOutput("aggregate_fatalities")
```

### {data-height=500}
```{r}
```

About 
===