diff --git a/dashboard.Rmd b/dashboard.Rmd index f2fd48d..21926f9 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -10,7 +10,7 @@ output: bootswatch: litera --- -```{r setup, include=FALSE} +```{r global, include=FALSE} # TODO: # - update normalization to new 2024 data # - @@ -68,79 +68,21 @@ config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/con 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) - # }) - #} + disconnect_db() }) ``` @@ -152,6 +94,8 @@ Col {data-width=500} ### {} ```{r} +# Home - Intro + HTML( '

Welcome to the Hurricane Cost Normalization Web App!

@@ -195,8 +139,7 @@ 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") +# Home - Storm Selector fluidRow( column(6, @@ -216,8 +159,6 @@ fluidRow( ) ) - - observeEvent(input$stormYear, { stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ] @@ -237,12 +178,12 @@ observeEvent(input$selectStorm, { 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), @@ -271,20 +212,7 @@ 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 -) +# Storm Overview - Setup observe({ req(storm_selection$is_selected) @@ -312,6 +240,8 @@ Col {data-width=500 .tabset} ### Track Map {.no-padding} ```{r} +# Overview - Track Map + storm_track <- reactive({ req(storm_selection$is_selected) @@ -323,7 +253,6 @@ storm_track <- reactive({ output$track_map <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) - # %>% setView(lng = -89.8, lat = 29.6, zoom = 8) }) observe({ @@ -368,6 +297,8 @@ leafletOutput("track_map", height = "100%") ### Track Data {.no-padding} ```{r} +# Overview - Track Data + output$track_data <- renderDT({ datatable( storm_track() %>% select(datetime, lon, lat, rmw, pressure, windspeed, record_identifier), @@ -394,6 +325,8 @@ Col {data-width=500} ### Normalization Cost Index {data-height=500} ```{r} +# Overview - Normalization Chart +# TODO: chart controls and filter output$cost_index_chart <- renderDygraph({ req(storm_selection$is_selected, input$storm_overview_cost_index_lf) @@ -411,10 +344,6 @@ output$cost_index_chart <- renderDygraph({ dyRangeSelector(height = 30) }) -#observeEvent(input$storm_overview_select_base, { - # TODO: add button to select normalized costs -#}) - fillCol( flex = c(.2, .8), fluidRow( @@ -422,11 +351,10 @@ fillCol( selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL) ), column(4, - # TODO: add button to select normalized costs - #checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F) + ), column(4, - #checkboxInput("mmpSelect", "Display MMP", value = T) + ) ), dygraphOutput("cost_index_chart") @@ -435,6 +363,8 @@ fillCol( ### Landfalls {data-height=500 .no-padding} ```{r} +# Overview - Landfalls Table + output$landfalls_table <- renderDT({ req(storm_selection$is_selected) @@ -469,6 +399,9 @@ Column {data-width=550 .tabset} ### Growth Map {.no-padding} ```{r} +# Growth - Growth Map +# TODO: implement data loading + observe({ req(storm_selection$is_selected) @@ -478,44 +411,6 @@ observe({ 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, @@ -592,15 +487,17 @@ fillCol( ### Growth Data {.no-padding} ```{r} - - +# Growth - Growth Data ``` Column {data-width=450} ---------------------------------- -### Landfall Selection {data-height=550} +### Landfall Growth {data-height=550} ```{r} +# Growth - Trend Chart +# TODO: add chart and chart controls + fillCol( flex = c(.2, .8), fluidRow( @@ -608,33 +505,25 @@ fillCol( 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} - +# Growth - County Table ``` Storm Fatalities {data-navmenu="Storm Details"} === - - +### {} +```{r} +# TODO: add storm specific fatalities +``` Normalization Calculator {data-navmenu="Compute"} === @@ -644,6 +533,8 @@ Column {data-width=700 .tabset} ### Impact Map {.no-padding} ```{r} +# Calculator - Impact Map + output$impact_analysis_map <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) @@ -655,7 +546,7 @@ leafletOutput("impact_analysis_map", height = "100%") ### Impact Data {.no-padding} ```{r} - +# Calculator - Impact Data ``` Column {data-width=300} @@ -663,6 +554,9 @@ Column {data-width=300} ### {} ```{r} +# Calculator - Input +# TODO: add data population and compute + fillCol( flex = c(.5, .5), div( @@ -703,18 +597,6 @@ fillCol( ) ), - #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( @@ -733,12 +615,12 @@ fillCol( ) ``` - Data Export {data-navmenu="Compute"} === ```{r} -# Dataset information +# 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", @@ -771,7 +653,7 @@ Column {data-width=600} ### Available Datasets ```{r} -# Function to create dataset cards +# Export - Datasets create_dataset_card <- function(dataset_row) { card_id <- paste0("card_", dataset_row$id) @@ -812,40 +694,6 @@ create_dataset_card <- function(dataset_row) { ) } -# Add CSS for card interactions -#tags$head(tags$style(HTML(" -# .dataset-card:hover { -# border-color: #3498db !important; -# box-shadow: 0 4px 8px rgba(52, 152, 219, 0.3) !important; -# } -# .dataset-card.selected { -# border-color: #27ae60 !important; -# background-color: #f8fff9 !important; -# box-shadow: 0 4px 8px rgba(39, 174, 96, 0.3) !important; -# } -# .export-box { -# border: 2px solid #34495e; -# border-radius: 8px; -# padding: 20px; -# background-color: #f8f9fa; -# margin-bottom: 20px; -# } -# .selected-item { -# background-color: #e8f5e8; -# border: 1px solid #27ae60; -# border-radius: 4px; -# padding: 8px 12px; -# margin: 4px; -# display: inline-block; -# } -# .info-box { -# border: 2px solid #95a5a6; -# border-radius: 8px; -# padding: 20px; -# background-color: #ecf0f1; -# } -#"))) - # Update selected datasets based on checkboxes observe({ selected <- character(0) @@ -896,6 +744,8 @@ Column {data-width=400} ### Data Export {data-height=600} ```{r} +# Export - Download + div( class = "export-box", @@ -958,6 +808,8 @@ output$selected_datasets_display <- renderUI({ ### 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;"), @@ -976,9 +828,9 @@ 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, @@ -988,10 +840,6 @@ output$normalized_storms_full_table <- renderDT({ options = list( pageLength = 20, order = list(0, 'asc'), - #searching = F, - #paging = F, - #info = F, - #lengthChange = F, server = T ) ) %>% @@ -999,8 +847,6 @@ output$normalized_storms_full_table <- renderDT({ }) DTOutput("normalized_storms_full_table") - - ``` Column {data-width=350} @@ -1008,39 +854,33 @@ Column {data-width=350} ### {.no-padding} ```{r} +# Tracking - Storms Map + 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 - ) + addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% + 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%") @@ -1049,6 +889,11 @@ leafletOutput("all_storms_map", height = "100%") Fatalities {data-navmenu="All Storms"} === +### {} +```{r} +# TODO: add all storms fatality data and charting +``` + Column {data-width=500} --- diff --git a/queries.R b/queries.R index c48e043..909fc6f 100644 --- a/queries.R +++ b/queries.R @@ -77,6 +77,11 @@ view.all_conus_landfalls <- tbl(con, "all_conus_landfalls") # helper functions +# disconnect db connection +disconnect_db <- function() { + dbDisconnect(con) +} + # splits full_lf_id into lf_type and lf_id split_full_lf_id <- function(full_lf_id) { lf_type = gsub('[0-9]+', '', full_lf_id)