dylan/hurricane_normalization_app
1
0
Fork 0
mirror of https://github.com/dylanbenzi/hurricane_normalization_app.git synced 2026-07-30 05:08:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

modify all R code with air and quarto formatting

Browse Source
This commit is contained in:
dylan
2025-07-21 16:56:03 -04:00
parent f5dd9e88d2
commit c5a0b2e373
3 changed files with 778 additions and 406 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app-profile.R
+3 -1
View File
@@ -1,6 +1,8 @@
library(profvis) library(profvis)
setwd("/home/dylan/Personal/Projects/Hurricane Normalization/R/dataScripts/restructured/app") setwd(
"/home/dylan/Personal/Projects/Hurricane Normalization/R/dataScripts/restructured/app"
)
profvis({ profvis({
rmarkdown::render("dashboard.Rmd") rmarkdown::render("dashboard.Rmd")
dashboard.Rmd
+476 -132
View File
@@ -51,14 +51,14 @@ linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
widir <- "E/..." widir <- "E/..."
if(!is.null(os)) { if (!is.null(os)) {
if(grepl("darwin", os, ignore.case = T)) { if (grepl("darwin", os, ignore.case = T)) {
cat("OS: Mac") cat("OS: Mac")
baseDir <- macdir baseDir <- macdir
} else if(grepl("linux", os, ignore.case = T)) { } else if (grepl("linux", os, ignore.case = T)) {
cat("OS: Linux") cat("OS: Linux")
baseDir <- linuxdir baseDir <- linuxdir
} else if(grepl("windows", os, ignore.case = T)) { } else if (grepl("windows", os, ignore.case = T)) {
cat("OS: Win") cat("OS: Win")
baseDir <- windir baseDir <- windir
} else { } else {
@@ -66,7 +66,9 @@ if(!is.null(os)) {
} }
} }
config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")) config <- config::get(
file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")
)
source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R")) source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R"))
@@ -141,16 +143,29 @@ Col {data-width=500}
# Home - Storm Selector # Home - Storm Selector
fluidRow( fluidRow(
column(6, column(
6,
div( div(
selectInput("stormBasin", "Basin", choices = "AL", width = "100%"), selectInput("stormBasin", "Basin", choices = "AL", width = "100%"),
selectInput("stormYear", "Year", choices = loss_storms$storm_year, width = "100%"), selectInput(
"stormYear",
"Year",
choices = loss_storms$storm_year,
width = "100%"
),
selectInput("stormName", "Name", choices = NULL, width = "100%"), selectInput("stormName", "Name", choices = NULL, width = "100%"),
actionButton("selectStorm", "Submit", class = "btn-primary rounded", width = "100%") actionButton(
"selectStorm",
"Submit",
class = "btn-primary rounded",
width = "100%"
)
) )
), ),
column(6, column(
HTML(' 6,
HTML(
'
<h5>Select a Storm</h5> <h5>Select a Storm</h5>
We are currently tracking 201 CONUS storms with over $3.6T in losses spanning from 1900 to 2024 We are currently tracking 201 CONUS storms with over $3.6T in losses spanning from 1900 to 2024
@@ -158,7 +173,8 @@ fluidRow(
<hr> <hr>
Use the storm selector to the left or the table below to select a storm to analyze Use the storm selector to the left or the table below to select a storm to analyze
') '
)
) )
) )
@@ -167,7 +183,9 @@ observeEvent(input$stormYear, {
stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear) stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear)
updateSelectInput(session, "stormName", updateSelectInput(
session,
"stormName",
choices = stormsByYear$storm_name, choices = stormsByYear$storm_name,
selected = NULL selected = NULL
) )
@@ -285,7 +303,6 @@ storm_track <- reactive({
result <- result %>% result <- result %>%
mutate( mutate(
hurricane_category = case_when( hurricane_category = case_when(
# Hurricane Cat 1 # Hurricane Cat 1
storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1, storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1,
@@ -302,7 +319,6 @@ storm_track <- reactive({
storm_status == "HU" & windspeed >= 137 ~ 5, storm_status == "HU" & windspeed >= 137 ~ 5,
), ),
line_color = case_when( line_color = case_when(
# Tropical Depression - Green # Tropical Depression - Green
storm_status == "TD" ~ "#2AFF00", storm_status == "TD" ~ "#2AFF00",
@@ -414,10 +430,9 @@ output$track_map <- renderLeaflet({
title = "Track Legend" title = "Track Legend"
) )
if (nrow(track_data) >= 2) { if (nrow(track_data) >= 2) {
for (i in 1:(nrow(track_data) - 1)) { for (i in 1:(nrow(track_data) - 1)) {
segment_data <- track_data[i:(i+1), ] segment_data <- track_data[i:(i + 1), ]
map <- map %>% map <- map %>%
addPolylines( addPolylines(
@@ -439,20 +454,31 @@ output$track_map <- renderLeaflet({
radius = 2, radius = 2,
color = ~line_color, color = ~line_color,
fillOpacity = 1, fillOpacity = 1,
popup = ~paste0("<b>DATE</b>", "<br>", popup = ~ paste0(
datetime, "<br>", "<b>DATE</b>",
"<b>CATEGORY</b>", "<br>", "<br>",
popup_category, "<br>", datetime,
"<b>WINDSPEED</b>", "<br>", "<br>",
windspeed, "kt", "<br>", "<b>CATEGORY</b>",
"<b>PRESSURE</b>", "<br>", "<br>",
pressure, "mb") popup_category,
"<br>",
"<b>WINDSPEED</b>",
"<br>",
windspeed,
"kt",
"<br>",
"<b>PRESSURE</b>",
"<br>",
pressure,
"mb"
)
) )
landfall_data <- track_data %>% landfall_data <- track_data %>%
filter(record_identifier == "L") filter(record_identifier == "L")
if(nrow(landfall_data) > 0) { if (nrow(landfall_data) > 0) {
map <- map %>% map <- map %>%
addCircleMarkers( addCircleMarkers(
data = landfall_data, data = landfall_data,
@@ -463,17 +489,31 @@ output$track_map <- renderLeaflet({
color = ~line_color, color = ~line_color,
fillColor = ~line_color, fillColor = ~line_color,
fillOpacity = 1, fillOpacity = 1,
popup = ~paste0("<b>LANDFALL</b>", "<br>", popup = ~ paste0(
"<b>DATE</b>", "<br>", "<b>LANDFALL</b>",
datetime, "<br>", "<br>",
"<b>CATEGORY</b>", "<br>", "<b>DATE</b>",
popup_category, "<br>", "<br>",
"<b>WINDSPEED</b>", "<br>", datetime,
windspeed, "kt", "<br>", "<br>",
"<b>PRESSURE</b>", "<br>", "<b>CATEGORY</b>",
pressure, "mb", "<br>", "<br>",
"<b>RMW</b>", "<br>", popup_category,
rmw, "nm" "<br>",
"<b>WINDSPEED</b>",
"<br>",
windspeed,
"kt",
"<br>",
"<b>PRESSURE</b>",
"<br>",
pressure,
"mb",
"<br>",
"<b>RMW</b>",
"<br>",
rmw,
"nm"
) )
) %>% ) %>%
addCircles( addCircles(
@@ -485,17 +525,31 @@ output$track_map <- renderLeaflet({
color = ~line_color, color = ~line_color,
fillColor = ~line_color, fillColor = ~line_color,
fillOpacity = 0.3, fillOpacity = 0.3,
popup = ~paste0("<b>LANDFALL</b>", "<br>", popup = ~ paste0(
"<b>DATE</b>", "<br>", "<b>LANDFALL</b>",
datetime, "<br>", "<br>",
"<b>CATEGORY</b>", "<br>", "<b>DATE</b>",
popup_category, "<br>", "<br>",
"<b>WINDSPEED</b>", "<br>", datetime,
windspeed, "kt", "<br>", "<br>",
"<b>PRESSURE</b>", "<br>", "<b>CATEGORY</b>",
pressure, "mb", "<br>", "<br>",
"<b>RMW</b>", "<br>", popup_category,
rmw, "nm" "<br>",
"<b>WINDSPEED</b>",
"<br>",
windspeed,
"kt",
"<br>",
"<b>PRESSURE</b>",
"<br>",
pressure,
"mb",
"<br>",
"<b>RMW</b>",
"<br>",
rmw,
"nm"
) )
) )
} }
@@ -522,15 +576,17 @@ storm_yearly_normalization <- reactive({
}) })
output$cost_index_chart <- renderDygraph({ output$cost_index_chart <- renderDygraph({
req(storm_yearly_normalization, req(
storm_yearly_normalization,
input$storm_overview_cost_index_lf_select, input$storm_overview_cost_index_lf_select,
input$storm_overview_cost_index_mmh_mmp, input$storm_overview_cost_index_mmh_mmp,
input$storm_overview_cost_index_scale, input$storm_overview_cost_index_scale,
input$storm_overview_cost_index_y_scale) input$storm_overview_cost_index_y_scale
)
if(input$storm_overview_cost_index_y_scale == "Log") { if (input$storm_overview_cost_index_y_scale == "Log") {
is_y_log <- T is_y_log <- T
}else{ } else {
is_y_log <- F is_y_log <- F
} }
@@ -583,7 +639,10 @@ output$cost_index_chart <- renderDygraph({
dygraph(normalization_index_ts, ylab = y_label) %>% dygraph(normalization_index_ts, ylab = y_label) %>%
dyOptions( dyOptions(
colors = paletteer_d("ggthemes::Classic_Purple_Gray_12", ncol(normalization_index - 1)), colors = paletteer_d(
"ggthemes::Classic_Purple_Gray_12",
ncol(normalization_index - 1)
),
fillGraph = T, fillGraph = T,
fillAlpha = .2, fillAlpha = .2,
labelsKMB = T, labelsKMB = T,
@@ -601,7 +660,14 @@ output$landfalls_table <- renderDT({
datatable( datatable(
hurdat_landfalls, hurdat_landfalls,
rownames = F, rownames = F,
colnames = c("Date", "Longitude", "Latitude", "RMW", "Pressure", "Windspeed"), colnames = c(
"Date",
"Longitude",
"Latitude",
"RMW",
"Pressure",
"Windspeed"
),
options = list( options = list(
order = list(0, 'asc'), order = list(0, 'asc'),
paging = F, paging = F,
@@ -619,19 +685,40 @@ fillCol(
div( div(
fluidRow( fluidRow(
style = "height: 100%", style = "height: 100%",
column(3, column(
virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls", 3,
virtualSelectInput(
"storm_overview_cost_index_lf_select",
"Landfalls",
choices = NULL, choices = NULL,
showValueAsTags = T, showValueAsTags = T,
multiple = T, multiple = T,
autoSelectFirstOption = 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, radioGroupButtons(
dygraphOutput("cost_index_chart") "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( div(
@@ -647,9 +734,26 @@ fillCol(
output$track_data <- renderDT({ output$track_data <- renderDT({
datatable( datatable(
storm_track() %>% select(formatted_datetime, storm_status, lon, lat, rmw, pressure, windspeed), storm_track() %>%
select(
formatted_datetime,
storm_status,
lon,
lat,
rmw,
pressure,
windspeed
),
rownames = F, rownames = F,
colnames = c("Date", "Status", "Lon", "Lat", "RMW", "Pressure", "Windspeed"), colnames = c(
"Date",
"Status",
"Lon",
"Lat",
"RMW",
"Pressure",
"Windspeed"
),
selection = "none", selection = "none",
options = list( options = list(
pageLength = 1000, pageLength = 1000,
@@ -682,10 +786,12 @@ Column {data-width=550 .tabset}
observe({ observe({
req(storm_selection$is_selected) req(storm_selection$is_selected)
updateSliderInput(session, updateSliderInput(
session,
"growth_trend_map_slider", "growth_trend_map_slider",
min = storm_selection$storm_year, min = storm_selection$storm_year,
value = storm_selection$storm_year) value = storm_selection$storm_year
)
}) })
test_storm <- reactiveValues( test_storm <- reactiveValues(
@@ -702,8 +808,16 @@ test_counties <- reactive({
result <- counties %>% result <- counties %>%
filter(year == 2024) %>% filter(year == 2024) %>%
mutate( mutate(
population_opacity = rescale(normalized_population, to = c(0.2, 0.8), from = range(normalized_population, na.rm = T)), population_opacity = rescale(
housing_opacity = rescale(normalized_housing, to = c(0.2, 0.8), from = range(normalized_housing, na.rm = T)) 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") st_as_sf(wkt = "geom_wkt")
@@ -755,7 +869,18 @@ fillCol(
justify-content: center; justify-content: center;
align-itmes: center; align-itmes: center;
", ",
sliderInput("growth_trend_map_slider", label = NULL, min = 1926, max = 2024, step = 1, animate = T, value = 1926, sep = "", width = "100%", ticks = F) sliderInput(
"growth_trend_map_slider",
label = NULL,
min = 1926,
max = 2024,
step = 1,
animate = T,
value = 1926,
sep = "",
width = "100%",
ticks = F
)
), ),
leafletOutput("pop_growth_map", height = "100%"), leafletOutput("pop_growth_map", height = "100%"),
leafletOutput("housing_growth_map", height = "100%") leafletOutput("housing_growth_map", height = "100%")
@@ -778,12 +903,11 @@ Column {data-width=450}
fillCol( fillCol(
flex = c(.2, .8), flex = c(.2, .8),
fluidRow( fluidRow(
column(6, column(
6,
selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL) selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL)
), ),
column(6, column(6, )
)
), ),
dygraphOutput("test_dy") dygraphOutput("test_dy")
) )
@@ -809,7 +933,12 @@ output$test_dy <- renderDygraph({
```{r} ```{r}
# Growth - County Table # Growth - County Table
great_miami_data <- data.frame( great_miami_data <- data.frame(
county_name = c("Broward County", "Collier County", "Miami-Dade County", "Monroe County"), county_name = c(
"Broward County",
"Collier County",
"Miami-Dade County",
"Monroe County"
),
housing_1926 = c(3.7, 0, 25, 3.5), housing_1926 = c(3.7, 0, 25, 3.5),
housing_2024 = c(869, 250, 1100, 55), housing_2024 = c(869, 250, 1100, 55),
population_1926 = c(14, 0, 103, 16), population_1926 = c(14, 0, 103, 16),
@@ -829,7 +958,11 @@ output$great_miami_dt <- renderDT({
server = T server = T
), ),
colnames = c( colnames = c(
"County", "1926 HU", "2024 HU", "1926 POP", "2024 POP" "County",
"1926 HU",
"2024 HU",
"1926 POP",
"2024 POP"
), ),
) %>% ) %>%
# Format housing columns with blue background # Format housing columns with blue background
@@ -843,7 +976,12 @@ output$great_miami_dt <- renderDT({
backgroundColor = "rgba(255, 0, 0, 0.2)" backgroundColor = "rgba(255, 0, 0, 0.2)"
) %>% ) %>%
formatCurrency( formatCurrency(
columns = c("housing_1926", "housing_2024", "population_1926", "population_2024"), columns = c(
"housing_1926",
"housing_2024",
"population_1926",
"population_2024"
),
currency = "k", currency = "k",
digits = 0, digits = 0,
before = F before = F
@@ -912,57 +1050,150 @@ Column {data-width=300}
div( div(
h6("Storm Selector"), h6("Storm Selector"),
selectInput("impact_storm_basin", label = NULL, choices = "AL", width = "100%"), selectInput(
selectInput("impact_storm_year", label = NULL, choices = 1926, width = "100%"), "impact_storm_basin",
selectInput("impact_storm_name", label = NULL, choices = "GREAT MIAMI", width = "100%"), label = NULL,
choices = "AL",
width = "100%"
),
selectInput(
"impact_storm_year",
label = NULL,
choices = 1926,
width = "100%"
),
selectInput(
"impact_storm_name",
label = NULL,
choices = "GREAT MIAMI",
width = "100%"
),
fluidRow( fluidRow(
column(6, column(
selectInput("impact_storm_lf_type", label = NULL, choices = "LF", width = "100%") 6,
selectInput(
"impact_storm_lf_type",
label = NULL,
choices = "LF",
width = "100%"
)
), ),
column(6, column(
selectInput("impact_storm_lf_id", label = NULL, choices = "1", width = "100%") 6,
selectInput(
"impact_storm_lf_id",
label = NULL,
choices = "1",
width = "100%"
)
) )
), ),
actionButton("impact_populate_storm", label = "Populate", width = "100%", class = "btn-primary rounded") actionButton(
"impact_populate_storm",
label = "Populate",
width = "100%",
class = "btn-primary rounded"
)
) )
hr() hr()
div( div(
fluidRow( fluidRow(
column(6, column(
textInput("impact_lat", placeholder = "Lat", value = "25.6", label = "Latitude", width = "100%") 6,
textInput(
"impact_lat",
placeholder = "Lat",
value = "25.6",
label = "Latitude",
width = "100%"
)
), ),
column(6, column(
textInput("impact_lon", placeholder = "Lon", value = "-80.3", label = "Longitude", width = "100%") 6,
textInput(
"impact_lon",
placeholder = "Lon",
value = "-80.3",
label = "Longitude",
width = "100%"
)
) )
), ),
fluidRow( fluidRow(
column(4, column(
textInput("impact_rmw", placeholder = "RMW", value = "20", label = "RMW (NM)", width = "100%") 4,
textInput(
"impact_rmw",
placeholder = "RMW",
value = "20",
label = "RMW (NM)",
width = "100%"
)
), ),
column(8, column(
sliderInput("impact_rmw_slider", label = NULL, min = 1, max = 150, value = 20, ticks = F, width = "100%") 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"), status = "outline-primary rounded-0", justified = T), radioGroupButtons(
"impact_rmw_multiplier",
label = "RMW Multiplier",
choices = c("1x", "2x", "3x"),
status = "outline-primary rounded-0",
justified = T
),
fluidRow( fluidRow(
column(6, column(
textInput("impact_base_year", placeholder = "Impact Year", value = "1926", label = "Base Year", width = "100%") 6,
textInput(
"impact_base_year",
placeholder = "Impact Year",
value = "1926",
label = "Base Year",
width = "100%"
)
), ),
column(6, column(
textInput("impact_ref_year", placeholder = "Reference Year", value = "2024", label = "Ref Year", width = "100%") 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%"), 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") actionButton(
"impact_calculate",
label = "Calculate",
width = "100%",
class = "btn-primary rounded"
)
) )
``` ```
@@ -973,9 +1204,22 @@ Data Export {data-navmenu="Compute"}
# Export - Mock Data # 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(
name = c("Hurricane Cost Normalization", "Population & Housing", "Storm Fatalities", "hurricane_costs",
"Hurricane Best Track", "Affected Areas", "Yearly Economics"), "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( description = c(
"Normalized economic damage estimates for US landfalling hurricanes 1900-2023 using updated RMW methodology", "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", "County-level population and housing unit data used for normalization calculations",
@@ -984,13 +1228,30 @@ datasets_info <- data.frame(
"Geographic areas impacted by hurricane landfalls with RMW coverage percentages", "Geographic areas impacted by hurricane landfalls with RMW coverage percentages",
"Yearly economic data used in normalization calculations" "Yearly economic data used in normalization calculations"
), ),
size = c("~200 storms", "3,000+ counties", "150+ storms", "2,000+ storms", "5,000+ records", "100+ years"), size = c(
last_updated = c("2024-12-01", "2024-11-15", "2024-10-30", "2024-12-15", "2024-11-30", "2025-01-01"), "~200 storms",
tables = c("econ.normalized_landfalls, econ.storm_base_loss", "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", "metrics.pop_and_housing",
"fatal.storm_total_fatalities, fatal.storm_fatalities_type", "fatal.storm_total_fatalities, fatal.storm_fatalities_type",
"hurdat.best_track, hurdat.hurdat_storms", "hurdat.best_track, hurdat.hurdat_storms",
"gis.affected_area_landfalls", "econ.usa_yearly"), "gis.affected_area_landfalls",
"econ.usa_yearly"
),
stringsAsFactors = FALSE stringsAsFactors = FALSE
) )
@@ -1019,15 +1280,36 @@ create_dataset_card <- function(dataset_row) {
# Left content # Left content
div( div(
style = "flex: 1;", style = "flex: 1;",
tags$b(dataset_row$name, style = "font-size: 16px; margin: 0 0 8px 0; color: #2c3e50; display: block;"), tags$b(
p(dataset_row$description, style = "margin: 0 0 10px 0; color: #5a6c7d; font-size: 14px; line-height: 1.4;"), 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 # Metadata row
div( div(
style = "display: flex; gap: 20px; flex-wrap: wrap;", style = "display: flex; gap: 20px; flex-wrap: wrap;",
span(icon("database"), strong("Size: "), dataset_row$size, style = "color: #7f8c8d; font-size: 12px;"), span(
span(icon("calendar"), strong("Updated: "), dataset_row$last_updated, style = "color: #7f8c8d; font-size: 12px;"), icon("database"),
span(icon("table"), strong("Tables: "), dataset_row$tables, style = "color: #7f8c8d; font-size: 11px;") 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;"
)
) )
), ),
@@ -1048,9 +1330,9 @@ create_dataset_card <- function(dataset_row) {
# Update selected datasets based on checkboxes # Update selected datasets based on checkboxes
observe({ observe({
selected <- character(0) selected <- character(0)
for(i in 1:nrow(datasets_info)) { for (i in 1:nrow(datasets_info)) {
dataset_id <- datasets_info[i, "id"] dataset_id <- datasets_info[i, "id"]
if(isTruthy(input[[paste0("select_", dataset_id)]])) { if (isTruthy(input[[paste0("select_", dataset_id)]])) {
selected <- c(selected, dataset_id) selected <- c(selected, dataset_id)
} }
} }
@@ -1058,7 +1340,8 @@ observe({
}) })
# Add JavaScript for card click interaction # Add JavaScript for card click interaction
tags$script(HTML(" tags$script(HTML(
"
$(document).on('click', '.dataset-card', function() { $(document).on('click', '.dataset-card', function() {
var checkbox = $(this).find('input[type=\"checkbox\"]'); var checkbox = $(this).find('input[type=\"checkbox\"]');
checkbox.prop('checked', !checkbox.prop('checked')).trigger('change'); checkbox.prop('checked', !checkbox.prop('checked')).trigger('change');
@@ -1069,13 +1352,17 @@ tags$script(HTML("
$(this).removeClass('selected'); $(this).removeClass('selected');
} }
}); });
")) "
))
# Instructions # Instructions
div( div(
style = "margin-bottom: 20px; padding: 15px; background-color: #f0f8ff; border-radius: 0; border-left: 4px solid #3498db;", 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.", p(
style = "margin: 0; color: #2c3e50;") 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 # Render dataset cards
@@ -1100,10 +1387,16 @@ Column {data-width=400}
div( div(
class = "export-box", class = "export-box",
tags$b("Export Selected Data", style = "font-size: 18px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 15px;"), tags$b(
"Export Selected Data",
style = "font-size: 18px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 15px;"
),
# Selected datasets display # Selected datasets display
tags$b("Selected Datasets:", style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"), tags$b(
"Selected Datasets:",
style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"
),
div( div(
id = "selected-datasets-display", id = "selected-datasets-display",
style = "min-height: 60px; margin-bottom: 20px; padding: 10px; background-color: white; border-radius: 4px; border: 1px solid #ddd;", style = "min-height: 60px; margin-bottom: 20px; padding: 10px; background-color: white; border-radius: 4px; border: 1px solid #ddd;",
@@ -1111,7 +1404,10 @@ div(
), ),
# Format selection # Format selection
tags$b("Export Format:", style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"), tags$b(
"Export Format:",
style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"
),
radioButtons( radioButtons(
"export_format", "export_format",
label = NULL, label = NULL,
@@ -1142,14 +1438,21 @@ div(
# Display selected datasets # Display selected datasets
output$selected_datasets_display <- renderUI({ output$selected_datasets_display <- renderUI({
if(length(values$selected_datasets) == 0) { if (length(values$selected_datasets) == 0) {
p("No datasets selected", style = "color: #95a5a6; font-style: italic; margin: 20px 0;") p(
"No datasets selected",
style = "color: #95a5a6; font-style: italic; margin: 20px 0;"
)
} else { } else {
selected_names <- datasets_info$name[datasets_info$id %in% values$selected_datasets] selected_names <- datasets_info$name[
datasets_info$id %in% values$selected_datasets
]
lapply(selected_names, function(name) { lapply(selected_names, function(name) {
span( span(
class = "selected-item", class = "selected-item",
icon("check-circle"), " ", name icon("check-circle"),
" ",
name
) )
}) })
} }
@@ -1163,11 +1466,21 @@ output$selected_datasets_display <- renderUI({
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(
p("Additional datasets, custom queries, and research collaborations are available through our team.", "Need More Data?",
style = "margin-bottom: 15px; color: #5a6c7d; font-size: 14px;"), 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;") p(
icon("envelope"),
strong(" Email:"),
" [CONTACT US EMAIL]",
style = "margin: 5px 0; color: #34495e; font-size: 14px;"
)
) )
``` ```
@@ -1215,7 +1528,7 @@ output$all_storms_map <- renderLeaflet({
lng = ~lon, lng = ~lon,
lat = ~lat, lat = ~lat,
radius = 2, radius = 2,
popup = ~paste0(storm_name, " ", storm_year), popup = ~ paste0(storm_name, " ", storm_year),
weight = 0, weight = 0,
color = "blue", color = "blue",
fillColor = "blue", fillColor = "blue",
@@ -1226,7 +1539,7 @@ output$all_storms_map <- renderLeaflet({
lng = ~lon, lng = ~lon,
lat = ~lat, lat = ~lat,
radius = ~rmw_meters, radius = ~rmw_meters,
popup = ~paste0(storm_name, " ", storm_year), popup = ~ paste0(storm_name, " ", storm_year),
weight = 1, weight = 1,
color = "blue", color = "blue",
fillColor = "blue", fillColor = "blue",
@@ -1246,7 +1559,11 @@ fatality_years <- seq(1900, 2010, by = 10)
direct_deaths <- c(6000, 275, 0, 408, 26, 654, 466, 213, 104, 228, 1136, 321) 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) 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) %>% yearly_fatalities <- data.frame(
fatality_years,
direct_deaths,
indirect_deaths
) %>%
mutate( mutate(
fatality_years = as.Date(paste0(fatality_years, "-01-01")) fatality_years = as.Date(paste0(fatality_years, "-01-01"))
) )
@@ -1280,7 +1597,21 @@ 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) 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) 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) %>% 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( mutate(
fatality_years = as.Date(paste0(fatality_years, "-01-01")) fatality_years = as.Date(paste0(fatality_years, "-01-01"))
) )
@@ -1311,7 +1642,20 @@ dygraphOutput("decade_fatalities_type")
### {data-height=500} ### {data-height=500}
```{r eval=FALSE, include=FALSE} ```{r eval=FALSE, include=FALSE}
fatality_type <- c("Surge", "Surf", "Rough Seas", "Rip Current", "Floods", "Wind", "Tree Fall", "Tornado", "Traffic", "Traffic Accident", "Electrocution", "Other") 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) fatality_totals <- c(520, 56, 77, 23, 826, 131, 91, 88, 10, 45, 16, 56)
aggregate_fatality_types <- data.frame(fatality_type, fatality_totals) aggregate_fatality_types <- data.frame(fatality_type, fatality_totals)
queries.R
+37 -11
View File
@@ -9,7 +9,9 @@ macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
#baseDir <- macdir #baseDir <- macdir
baseDir <- linuxdir baseDir <- linuxdir
config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")) config <- config::get(
file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")
)
# SUPABASE CON # SUPABASE CON
con <- dbConnect( con <- dbConnect(
@@ -132,7 +134,12 @@ get_unique_lf_ids <- function(storm) {
full_lf_id full_lf_id
) %>% ) %>%
select( select(
storm_basin, storm_year, storm_name, lf_type, lf_id, full_lf_id storm_basin,
storm_year,
storm_name,
lf_type,
lf_id,
full_lf_id
) )
result <- query %>% collect() result <- query %>% collect()
@@ -153,7 +160,9 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
lf_id == lf_id_parts$lf_id lf_id == lf_id_parts$lf_id
) %>% ) %>%
select( select(
normalization_year, mmh, mmp normalization_year,
mmh,
mmp
) )
result <- query %>% collect() result <- query %>% collect()
@@ -162,7 +171,9 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
} }
test_query <- function() { test_query <- function() {
result <- dbGetQuery(con, "WITH yearly_totals AS ( result <- dbGetQuery(
con,
"WITH yearly_totals AS (
SELECT SELECT
year, year,
SUM(population) as total_population, SUM(population) as total_population,
@@ -188,14 +199,17 @@ SELECT
ROUND(total_housing_units / base_housing, 4) as housing_index ROUND(total_housing_units / base_housing, 4) as housing_index
FROM yearly_totals FROM yearly_totals
CROSS JOIN base_year CROSS JOIN base_year
ORDER BY year;") ORDER BY year;"
)
result <- result %>% result <- result %>%
mutate( mutate(
year = as.Date(paste0(year, "-01-01")) year = as.Date(paste0(year, "-01-01"))
) %>% ) %>%
select( select(
year, population_index, housing_index year,
population_index,
housing_index
) )
result_ts <- result %>% result_ts <- result %>%
@@ -217,7 +231,12 @@ get_all_normalized_cost_index <- function(storm) {
full_lf_id = paste0(lf_type, lf_id) full_lf_id = paste0(lf_type, lf_id)
) %>% ) %>%
select( select(
normalization_year, mmh_index, mmp_index, mmh_loss = mmh, mmp_loss = mmp, full_lf_id normalization_year,
mmh_index,
mmp_index,
mmh_loss = mmh,
mmp_loss = mmp,
full_lf_id
) )
result <- query %>% collect() result <- query %>% collect()
@@ -354,8 +373,10 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% inner_join(affected_counties, by = c("state_fips", "county_fips")) %>%
inner_join(baseline_metrics, by = c("state_fips", "county_fips")) %>% inner_join(baseline_metrics, by = c("state_fips", "county_fips")) %>%
mutate( mutate(
normalized_population = as.numeric(population) / as.numeric(baseline_population), normalized_population = as.numeric(population) /
normalized_housing = as.numeric(housing_units) / as.numeric(baseline_housing) as.numeric(baseline_population),
normalized_housing = as.numeric(housing_units) /
as.numeric(baseline_housing)
) %>% ) %>%
select( select(
state_fips, state_fips,
@@ -368,9 +389,14 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
) )
query <- normalized_metrics %>% query <- normalized_metrics %>%
inner_join(public.counties, by = c("state_fips" = "statefp", "county_fips" = "countyfp")) %>% inner_join(
public.counties,
by = c("state_fips" = "statefp", "county_fips" = "countyfp")
) %>%
mutate( mutate(
geom_wkt = sql("ST_AsText(ST_SimplifyPreserveTopology(ST_Transform(geom, 4326), .001))") geom_wkt = sql(
"ST_AsText(ST_SimplifyPreserveTopology(ST_Transform(geom, 4326), .001))"
)
) %>% ) %>%
select( select(
state_fips, state_fips,