mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-29 21:01:27 +00:00
update misc code formatting
This commit is contained in:
+76
-231
@@ -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(
|
||||
'
|
||||
<h4>Welcome to the Hurricane Cost Normalization Web App!</h4>
|
||||
@@ -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}
|
||||
---
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user