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)
setwd("/home/dylan/Personal/Projects/Hurricane Normalization/R/dataScripts/restructured/app")
setwd(
"/home/dylan/Personal/Projects/Hurricane Normalization/R/dataScripts/restructured/app"
)
profvis({
rmarkdown::render("dashboard.Rmd")
dashboard.Rmd
+463 -119
View File
@@ -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"))
@@ -141,16 +143,29 @@ Col {data-width=500}
# Home - Storm Selector
fluidRow(
column(6,
column(
6,
div(
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%"),
actionButton("selectStorm", "Submit", class = "btn-primary rounded", width = "100%")
actionButton(
"selectStorm",
"Submit",
class = "btn-primary rounded",
width = "100%"
)
)
),
column(6,
HTML('
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
@@ -158,7 +173,8 @@ fluidRow(
<hr>
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)
updateSelectInput(session, "stormName",
updateSelectInput(
session,
"stormName",
choices = stormsByYear$storm_name,
selected = NULL
)
@@ -285,7 +303,6 @@ storm_track <- reactive({
result <- result %>%
mutate(
hurricane_category = case_when(
# Hurricane Cat 1
storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1,
@@ -302,7 +319,6 @@ storm_track <- reactive({
storm_status == "HU" & windspeed >= 137 ~ 5,
),
line_color = case_when(
# Tropical Depression - Green
storm_status == "TD" ~ "#2AFF00",
@@ -414,7 +430,6 @@ output$track_map <- renderLeaflet({
title = "Track Legend"
)
if (nrow(track_data) >= 2) {
for (i in 1:(nrow(track_data) - 1)) {
segment_data <- track_data[i:(i + 1), ]
@@ -439,14 +454,25 @@ output$track_map <- renderLeaflet({
radius = 2,
color = ~line_color,
fillOpacity = 1,
popup = ~paste0("<b>DATE</b>", "<br>",
datetime, "<br>",
"<b>CATEGORY</b>", "<br>",
popup_category, "<br>",
"<b>WINDSPEED</b>", "<br>",
windspeed, "kt", "<br>",
"<b>PRESSURE</b>", "<br>",
pressure, "mb")
popup = ~ paste0(
"<b>DATE</b>",
"<br>",
datetime,
"<br>",
"<b>CATEGORY</b>",
"<br>",
popup_category,
"<br>",
"<b>WINDSPEED</b>",
"<br>",
windspeed,
"kt",
"<br>",
"<b>PRESSURE</b>",
"<br>",
pressure,
"mb"
)
)
landfall_data <- track_data %>%
@@ -463,17 +489,31 @@ output$track_map <- renderLeaflet({
color = ~line_color,
fillColor = ~line_color,
fillOpacity = 1,
popup = ~paste0("<b>LANDFALL</b>", "<br>",
"<b>DATE</b>", "<br>",
datetime, "<br>",
"<b>CATEGORY</b>", "<br>",
popup_category, "<br>",
"<b>WINDSPEED</b>", "<br>",
windspeed, "kt", "<br>",
"<b>PRESSURE</b>", "<br>",
pressure, "mb", "<br>",
"<b>RMW</b>", "<br>",
rmw, "nm"
popup = ~ paste0(
"<b>LANDFALL</b>",
"<br>",
"<b>DATE</b>",
"<br>",
datetime,
"<br>",
"<b>CATEGORY</b>",
"<br>",
popup_category,
"<br>",
"<b>WINDSPEED</b>",
"<br>",
windspeed,
"kt",
"<br>",
"<b>PRESSURE</b>",
"<br>",
pressure,
"mb",
"<br>",
"<b>RMW</b>",
"<br>",
rmw,
"nm"
)
) %>%
addCircles(
@@ -485,17 +525,31 @@ output$track_map <- renderLeaflet({
color = ~line_color,
fillColor = ~line_color,
fillOpacity = 0.3,
popup = ~paste0("<b>LANDFALL</b>", "<br>",
"<b>DATE</b>", "<br>",
datetime, "<br>",
"<b>CATEGORY</b>", "<br>",
popup_category, "<br>",
"<b>WINDSPEED</b>", "<br>",
windspeed, "kt", "<br>",
"<b>PRESSURE</b>", "<br>",
pressure, "mb", "<br>",
"<b>RMW</b>", "<br>",
rmw, "nm"
popup = ~ paste0(
"<b>LANDFALL</b>",
"<br>",
"<b>DATE</b>",
"<br>",
datetime,
"<br>",
"<b>CATEGORY</b>",
"<br>",
popup_category,
"<br>",
"<b>WINDSPEED</b>",
"<br>",
windspeed,
"kt",
"<br>",
"<b>PRESSURE</b>",
"<br>",
pressure,
"mb",
"<br>",
"<b>RMW</b>",
"<br>",
rmw,
"nm"
)
)
}
@@ -522,11 +576,13 @@ storm_yearly_normalization <- reactive({
})
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_mmh_mmp,
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") {
is_y_log <- T
@@ -583,7 +639,10 @@ output$cost_index_chart <- renderDygraph({
dygraph(normalization_index_ts, ylab = y_label) %>%
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,
fillAlpha = .2,
labelsKMB = T,
@@ -601,7 +660,14 @@ output$landfalls_table <- renderDT({
datatable(
hurdat_landfalls,
rownames = F,
colnames = c("Date", "Longitude", "Latitude", "RMW", "Pressure", "Windspeed"),
colnames = c(
"Date",
"Longitude",
"Latitude",
"RMW",
"Pressure",
"Windspeed"
),
options = list(
order = list(0, 'asc'),
paging = F,
@@ -619,19 +685,40 @@ fillCol(
div(
fluidRow(
style = "height: 100%",
column(3,
virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls",
column(
3,
virtualSelectInput(
"storm_overview_cost_index_lf_select",
"Landfalls",
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),
radioGroupButtons("storm_overview_cost_index_y_scale", label = "Y-Axis Scale", choices = c("Linear", "Log"), status = "outline-primary rounded-0", justified = T)
autoSelectFirstOption = T
),
column(9,
dygraphOutput("cost_index_chart")
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, dygraphOutput("cost_index_chart"))
)
),
div(
@@ -647,9 +734,26 @@ fillCol(
output$track_data <- renderDT({
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,
colnames = c("Date", "Status", "Lon", "Lat", "RMW", "Pressure", "Windspeed"),
colnames = c(
"Date",
"Status",
"Lon",
"Lat",
"RMW",
"Pressure",
"Windspeed"
),
selection = "none",
options = list(
pageLength = 1000,
@@ -682,10 +786,12 @@ Column {data-width=550 .tabset}
observe({
req(storm_selection$is_selected)
updateSliderInput(session,
updateSliderInput(
session,
"growth_trend_map_slider",
min = storm_selection$storm_year,
value = storm_selection$storm_year)
value = storm_selection$storm_year
)
})
test_storm <- reactiveValues(
@@ -702,8 +808,16 @@ test_counties <- reactive({
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))
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")
@@ -755,7 +869,18 @@ fillCol(
justify-content: 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("housing_growth_map", height = "100%")
@@ -778,12 +903,11 @@ Column {data-width=450}
fillCol(
flex = c(.2, .8),
fluidRow(
column(6,
column(
6,
selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL)
),
column(6,
)
column(6, )
),
dygraphOutput("test_dy")
)
@@ -809,7 +933,12 @@ output$test_dy <- renderDygraph({
```{r}
# Growth - County Table
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_2024 = c(869, 250, 1100, 55),
population_1926 = c(14, 0, 103, 16),
@@ -829,7 +958,11 @@ output$great_miami_dt <- renderDT({
server = T
),
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
@@ -843,7 +976,12 @@ output$great_miami_dt <- renderDT({
backgroundColor = "rgba(255, 0, 0, 0.2)"
) %>%
formatCurrency(
columns = c("housing_1926", "housing_2024", "population_1926", "population_2024"),
columns = c(
"housing_1926",
"housing_2024",
"population_1926",
"population_2024"
),
currency = "k",
digits = 0,
before = F
@@ -912,57 +1050,150 @@ Column {data-width=300}
div(
h6("Storm Selector"),
selectInput("impact_storm_basin", 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%"),
selectInput(
"impact_storm_basin",
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(
column(6,
selectInput("impact_storm_lf_type", label = NULL, choices = "LF", width = "100%")
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%")
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")
actionButton(
"impact_populate_storm",
label = "Populate",
width = "100%",
class = "btn-primary rounded"
)
)
hr()
div(
fluidRow(
column(6,
textInput("impact_lat", placeholder = "Lat", value = "25.6", label = "Latitude", width = "100%")
column(
6,
textInput(
"impact_lat",
placeholder = "Lat",
value = "25.6",
label = "Latitude",
width = "100%"
)
),
column(6,
textInput("impact_lon", placeholder = "Lon", value = "-80.3", label = "Longitude", width = "100%")
column(
6,
textInput(
"impact_lon",
placeholder = "Lon",
value = "-80.3",
label = "Longitude",
width = "100%"
)
)
),
fluidRow(
column(4,
textInput("impact_rmw", placeholder = "RMW", value = "20", label = "RMW (NM)", width = "100%")
column(
4,
textInput(
"impact_rmw",
placeholder = "RMW",
value = "20",
label = "RMW (NM)",
width = "100%"
)
),
column(8,
sliderInput("impact_rmw_slider", label = NULL, min = 1, max = 150, value = 20, ticks = F, width = "100%")
column(
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(
column(6,
textInput("impact_base_year", placeholder = "Impact Year", value = "1926", label = "Base Year", width = "100%")
column(
6,
textInput(
"impact_base_year",
placeholder = "Impact Year",
value = "1926",
label = "Base Year",
width = "100%"
)
),
column(6,
textInput("impact_ref_year", placeholder = "Reference Year", value = "2024", label = "Ref Year", width = "100%")
column(
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
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",
"Hurricane Best Track", "Affected Areas", "Yearly Economics"),
id = c(
"hurricane_costs",
"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(
"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",
@@ -984,13 +1228,30 @@ datasets_info <- data.frame(
"Geographic areas impacted by hurricane landfalls with RMW coverage percentages",
"Yearly economic data used in normalization calculations"
),
size = c("~200 storms", "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",
size = c(
"~200 storms",
"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",
"fatal.storm_total_fatalities, fatal.storm_fatalities_type",
"hurdat.best_track, hurdat.hurdat_storms",
"gis.affected_area_landfalls", "econ.usa_yearly"),
"gis.affected_area_landfalls",
"econ.usa_yearly"
),
stringsAsFactors = FALSE
)
@@ -1019,15 +1280,36 @@ create_dataset_card <- function(dataset_row) {
# Left content
div(
style = "flex: 1;",
tags$b(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;"),
tags$b(
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
div(
style = "display: flex; gap: 20px; flex-wrap: wrap;",
span(icon("database"), 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;")
span(
icon("database"),
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;"
)
)
),
@@ -1058,7 +1340,8 @@ observe({
})
# Add JavaScript for card click interaction
tags$script(HTML("
tags$script(HTML(
"
$(document).on('click', '.dataset-card', function() {
var checkbox = $(this).find('input[type=\"checkbox\"]');
checkbox.prop('checked', !checkbox.prop('checked')).trigger('change');
@@ -1069,13 +1352,17 @@ tags$script(HTML("
$(this).removeClass('selected');
}
});
"))
"
))
# Instructions
div(
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.",
style = "margin: 0; color: #2c3e50;")
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.",
style = "margin: 0; color: #2c3e50;"
)
)
# Render dataset cards
@@ -1100,10 +1387,16 @@ Column {data-width=400}
div(
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
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(
id = "selected-datasets-display",
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
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(
"export_format",
label = NULL,
@@ -1143,13 +1439,20 @@ div(
# Display selected datasets
output$selected_datasets_display <- renderUI({
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 {
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) {
span(
class = "selected-item",
icon("check-circle"), " ", name
icon("check-circle"),
" ",
name
)
})
}
@@ -1163,11 +1466,21 @@ output$selected_datasets_display <- renderUI({
div(
class = "info-box",
tags$b("Need More Data?", 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;"),
tags$b(
"Need More Data?",
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;"
)
)
```
@@ -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)
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(
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)
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(
fatality_years = as.Date(paste0(fatality_years, "-01-01"))
)
@@ -1311,7 +1642,20 @@ dygraphOutput("decade_fatalities_type")
### {data-height=500}
```{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)
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 <- 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
con <- dbConnect(
@@ -132,7 +134,12 @@ get_unique_lf_ids <- function(storm) {
full_lf_id
) %>%
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()
@@ -153,7 +160,9 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
lf_id == lf_id_parts$lf_id
) %>%
select(
normalization_year, mmh, mmp
normalization_year,
mmh,
mmp
)
result <- query %>% collect()
@@ -162,7 +171,9 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
}
test_query <- function() {
result <- dbGetQuery(con, "WITH yearly_totals AS (
result <- dbGetQuery(
con,
"WITH yearly_totals AS (
SELECT
year,
SUM(population) as total_population,
@@ -188,14 +199,17 @@ SELECT
ROUND(total_housing_units / base_housing, 4) as housing_index
FROM yearly_totals
CROSS JOIN base_year
ORDER BY year;")
ORDER BY year;"
)
result <- result %>%
mutate(
year = as.Date(paste0(year, "-01-01"))
) %>%
select(
year, population_index, housing_index
year,
population_index,
housing_index
)
result_ts <- result %>%
@@ -217,7 +231,12 @@ get_all_normalized_cost_index <- function(storm) {
full_lf_id = paste0(lf_type, lf_id)
) %>%
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()
@@ -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(baseline_metrics, by = c("state_fips", "county_fips")) %>%
mutate(
normalized_population = as.numeric(population) / as.numeric(baseline_population),
normalized_housing = as.numeric(housing_units) / as.numeric(baseline_housing)
normalized_population = as.numeric(population) /
as.numeric(baseline_population),
normalized_housing = as.numeric(housing_units) /
as.numeric(baseline_housing)
) %>%
select(
state_fips,
@@ -368,9 +389,14 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
)
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(
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(
state_fips,