update misc code formatting

This commit is contained in:
2025-07-16 22:19:19 -04:00
parent 3efbf9abf3
commit bbc1751e02
2 changed files with 81 additions and 231 deletions
+53 -208
View File
@@ -10,7 +10,7 @@ output:
bootswatch: litera bootswatch: litera
--- ---
```{r setup, include=FALSE} ```{r global, include=FALSE}
# TODO: # TODO:
# - update normalization to new 2024 data # - 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")) 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 # pull static data
loss_storms <- get_all_loss_storms() loss_storms <- get_all_loss_storms()
latest_normalized_losses <- get_latest_aggregate_losses() latest_normalized_losses <- get_latest_aggregate_losses()
all_storm_tracks <- get_all_hurdat_tracks()
all_conus_landfalls <- get_all_conus_landfalls() all_conus_landfalls <- get_all_conus_landfalls()
all_storm_landfalls <- all_storm_tracks %>%
filter(record_identifier == "L")
storm_selection <- reactiveValues( storm_selection <- reactiveValues(
storm_year = NULL, storm_year = NULL,
storm_name = NULL, storm_name = NULL,
storm_basin = 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() { onStop(function() {
#dbDisconnect(con) disconnect_db()
#daemons(0)
#if(!is.null(async_reqs$hurdat_track)) {
# tryCatch({
# async_reqs$hurdat_track <- NULL
# }, error = function(e) {
# cat(e)
# })
#}
}) })
``` ```
@@ -152,6 +94,8 @@ Col {data-width=500}
### {} ### {}
```{r} ```{r}
# Home - Intro
HTML( HTML(
' '
<h4>Welcome to the Hurricane Cost Normalization Web App!</h4> <h4>Welcome to the Hurricane Cost Normalization Web App!</h4>
@@ -195,8 +139,7 @@ Col {data-width=500}
### Storm Selector {data-height=500} ### Storm Selector {data-height=500}
```{r} ```{r}
#h5("Select a storm: ") # Home - Storm Selector
#h6("Use either the select inputs or the data table below")
fluidRow( fluidRow(
column(6, column(6,
@@ -216,8 +159,6 @@ fluidRow(
) )
) )
observeEvent(input$stormYear, { observeEvent(input$stormYear, {
stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ] stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ]
@@ -237,12 +178,12 @@ observeEvent(input$selectStorm, {
showNotification("Storm selection updated!", type = "message") showNotification("Storm selection updated!", type = "message")
}) })
``` ```
### All Storms {data-height=500 .no-padding} ### All Storms {data-height=500 .no-padding}
```{r} ```{r}
# Home - Storm Table
output$normalized_storms_table <- renderDT({ output$normalized_storms_table <- renderDT({
datatable( datatable(
latest_normalized_losses %>% select(-hurdatId), latest_normalized_losses %>% select(-hurdatId),
@@ -271,20 +212,7 @@ Storm Overview {data-navmenu="Storm Details"}
==================================== ====================================
```{r} ```{r}
### REACTIVE VALUES FOR STORM OVERVIEW # Storm Overview - Setup
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({ observe({
req(storm_selection$is_selected) req(storm_selection$is_selected)
@@ -312,6 +240,8 @@ Col {data-width=500 .tabset}
### Track Map {.no-padding} ### Track Map {.no-padding}
```{r} ```{r}
# Overview - Track Map
storm_track <- reactive({ storm_track <- reactive({
req(storm_selection$is_selected) req(storm_selection$is_selected)
@@ -323,7 +253,6 @@ storm_track <- reactive({
output$track_map <- renderLeaflet({ output$track_map <- renderLeaflet({
leaflet() %>% leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18))
# %>% setView(lng = -89.8, lat = 29.6, zoom = 8)
}) })
observe({ observe({
@@ -368,6 +297,8 @@ leafletOutput("track_map", height = "100%")
### Track Data {.no-padding} ### Track Data {.no-padding}
```{r} ```{r}
# Overview - Track Data
output$track_data <- renderDT({ output$track_data <- renderDT({
datatable( datatable(
storm_track() %>% select(datetime, lon, lat, rmw, pressure, windspeed, record_identifier), 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} ### Normalization Cost Index {data-height=500}
```{r} ```{r}
# Overview - Normalization Chart
# TODO: chart controls and filter
output$cost_index_chart <- renderDygraph({ output$cost_index_chart <- renderDygraph({
req(storm_selection$is_selected, input$storm_overview_cost_index_lf) req(storm_selection$is_selected, input$storm_overview_cost_index_lf)
@@ -411,10 +344,6 @@ output$cost_index_chart <- renderDygraph({
dyRangeSelector(height = 30) dyRangeSelector(height = 30)
}) })
#observeEvent(input$storm_overview_select_base, {
# TODO: add button to select normalized costs
#})
fillCol( fillCol(
flex = c(.2, .8), flex = c(.2, .8),
fluidRow( fluidRow(
@@ -422,11 +351,10 @@ fillCol(
selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL) selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL)
), ),
column(4, column(4,
# TODO: add button to select normalized costs
#checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F)
), ),
column(4, column(4,
#checkboxInput("mmpSelect", "Display MMP", value = T)
) )
), ),
dygraphOutput("cost_index_chart") dygraphOutput("cost_index_chart")
@@ -435,6 +363,8 @@ fillCol(
### Landfalls {data-height=500 .no-padding} ### Landfalls {data-height=500 .no-padding}
```{r} ```{r}
# Overview - Landfalls Table
output$landfalls_table <- renderDT({ output$landfalls_table <- renderDT({
req(storm_selection$is_selected) req(storm_selection$is_selected)
@@ -469,6 +399,9 @@ Column {data-width=550 .tabset}
### Growth Map {.no-padding} ### Growth Map {.no-padding}
```{r} ```{r}
# Growth - Growth Map
# TODO: implement data loading
observe({ observe({
req(storm_selection$is_selected) req(storm_selection$is_selected)
@@ -478,44 +411,6 @@ observe({
value = 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( test_storm <- reactiveValues(
storm_basin = "AL", storm_basin = "AL",
storm_year = 2005, storm_year = 2005,
@@ -592,15 +487,17 @@ fillCol(
### Growth Data {.no-padding} ### Growth Data {.no-padding}
```{r} ```{r}
# Growth - Growth Data
``` ```
Column {data-width=450} Column {data-width=450}
---------------------------------- ----------------------------------
### Landfall Selection {data-height=550} ### Landfall Growth {data-height=550}
```{r} ```{r}
# Growth - Trend Chart
# TODO: add chart and chart controls
fillCol( fillCol(
flex = c(.2, .8), flex = c(.2, .8),
fluidRow( fluidRow(
@@ -608,33 +505,25 @@ fillCol(
selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL) selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL)
), ),
column(6, 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} ### County Data {data-height=450 .no-padding}
```{r} ```{r}
# Growth - County Table
``` ```
Storm Fatalities {data-navmenu="Storm Details"} Storm Fatalities {data-navmenu="Storm Details"}
=== ===
### {}
```{r}
# TODO: add storm specific fatalities
```
Normalization Calculator {data-navmenu="Compute"} Normalization Calculator {data-navmenu="Compute"}
=== ===
@@ -644,6 +533,8 @@ Column {data-width=700 .tabset}
### Impact Map {.no-padding} ### Impact Map {.no-padding}
```{r} ```{r}
# Calculator - Impact Map
output$impact_analysis_map <- renderLeaflet({ output$impact_analysis_map <- renderLeaflet({
leaflet() %>% leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18))
@@ -655,7 +546,7 @@ leafletOutput("impact_analysis_map", height = "100%")
### Impact Data {.no-padding} ### Impact Data {.no-padding}
```{r} ```{r}
# Calculator - Impact Data
``` ```
Column {data-width=300} Column {data-width=300}
@@ -663,6 +554,9 @@ Column {data-width=300}
### {} ### {}
```{r} ```{r}
# Calculator - Input
# TODO: add data population and compute
fillCol( fillCol(
flex = c(.5, .5), flex = c(.5, .5),
div( 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), radioGroupButtons("impact_rmw_multiplier", label = NULL, choices = c("1x", "2x", "3x"), status = "outline-primary rounded-0", justified = T),
fluidRow( fluidRow(
@@ -733,12 +615,12 @@ fillCol(
) )
``` ```
Data Export {data-navmenu="Compute"} Data Export {data-navmenu="Compute"}
=== ===
```{r} ```{r}
# Dataset information # Export - Mock Data
datasets_info <- data.frame( datasets_info <- data.frame(
id = c("hurricane_costs", "population_housing", "fatalities", "storm_tracks", "affected_areas", "economic_data"), id = c("hurricane_costs", "population_housing", "fatalities", "storm_tracks", "affected_areas", "economic_data"),
name = c("Hurricane Cost Normalization", "Population & Housing", "Storm Fatalities", name = c("Hurricane Cost Normalization", "Population & Housing", "Storm Fatalities",
@@ -771,7 +653,7 @@ Column {data-width=600}
### Available Datasets ### Available Datasets
```{r} ```{r}
# Function to create dataset cards # Export - Datasets
create_dataset_card <- function(dataset_row) { create_dataset_card <- function(dataset_row) {
card_id <- paste0("card_", dataset_row$id) 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 # Update selected datasets based on checkboxes
observe({ observe({
selected <- character(0) selected <- character(0)
@@ -896,6 +744,8 @@ Column {data-width=400}
### Data Export {data-height=600} ### Data Export {data-height=600}
```{r} ```{r}
# Export - Download
div( div(
class = "export-box", class = "export-box",
@@ -958,6 +808,8 @@ output$selected_datasets_display <- renderUI({
### Contact {data-height=400} ### Contact {data-height=400}
```{r} ```{r}
# Export - Contact
div( div(
class = "info-box", class = "info-box",
tags$b("Need More Data?", style = "font-size: 16px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 10px;"), 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} ```{r}
# Tracking - Storms Table
#DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline? #DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline?
output$normalized_storms_full_table <- renderDT({ output$normalized_storms_full_table <- renderDT({
datatable( datatable(
latest_normalized_losses, latest_normalized_losses,
@@ -988,10 +840,6 @@ output$normalized_storms_full_table <- renderDT({
options = list( options = list(
pageLength = 20, pageLength = 20,
order = list(0, 'asc'), order = list(0, 'asc'),
#searching = F,
#paging = F,
#info = F,
#lengthChange = F,
server = T server = T
) )
) %>% ) %>%
@@ -999,8 +847,6 @@ output$normalized_storms_full_table <- renderDT({
}) })
DTOutput("normalized_storms_full_table") DTOutput("normalized_storms_full_table")
``` ```
Column {data-width=350} Column {data-width=350}
@@ -1008,17 +854,11 @@ Column {data-width=350}
### {.no-padding} ### {.no-padding}
```{r} ```{r}
# Tracking - Storms Map
output$all_storms_map <- renderLeaflet({ output$all_storms_map <- renderLeaflet({
leaflet() %>% leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% 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( addCircleMarkers(
data = all_conus_landfalls, data = all_conus_landfalls,
lng = ~lon, lng = ~lon,
@@ -1049,6 +889,11 @@ leafletOutput("all_storms_map", height = "100%")
Fatalities {data-navmenu="All Storms"} Fatalities {data-navmenu="All Storms"}
=== ===
### {}
```{r}
# TODO: add all storms fatality data and charting
```
Column {data-width=500} Column {data-width=500}
--- ---
+5
View File
@@ -77,6 +77,11 @@ view.all_conus_landfalls <- tbl(con, "all_conus_landfalls")
# helper functions # helper functions
# disconnect db connection
disconnect_db <- function() {
dbDisconnect(con)
}
# splits full_lf_id into lf_type and lf_id # splits full_lf_id into lf_type and lf_id
split_full_lf_id <- function(full_lf_id) { split_full_lf_id <- function(full_lf_id) {
lf_type = gsub('[0-9]+', '', full_lf_id) lf_type = gsub('[0-9]+', '', full_lf_id)