mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
modify all R code with air and quarto formatting
This commit is contained in:
+3
-1
@@ -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")
|
||||
|
||||
+476
-132
@@ -51,14 +51,14 @@ linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
|
||||
macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
|
||||
widir <- "E/..."
|
||||
|
||||
if(!is.null(os)) {
|
||||
if(grepl("darwin", os, ignore.case = T)) {
|
||||
if (!is.null(os)) {
|
||||
if (grepl("darwin", os, ignore.case = T)) {
|
||||
cat("OS: Mac")
|
||||
baseDir <- macdir
|
||||
} else if(grepl("linux", os, ignore.case = T)) {
|
||||
} else if (grepl("linux", os, ignore.case = T)) {
|
||||
cat("OS: Linux")
|
||||
baseDir <- linuxdir
|
||||
} else if(grepl("windows", os, ignore.case = T)) {
|
||||
} else if (grepl("windows", os, ignore.case = T)) {
|
||||
cat("OS: Win")
|
||||
baseDir <- windir
|
||||
} 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"))
|
||||
|
||||
@@ -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,10 +430,9 @@ 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), ]
|
||||
segment_data <- track_data[i:(i + 1), ]
|
||||
|
||||
map <- map %>%
|
||||
addPolylines(
|
||||
@@ -439,20 +454,31 @@ 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 %>%
|
||||
filter(record_identifier == "L")
|
||||
|
||||
if(nrow(landfall_data) > 0) {
|
||||
if (nrow(landfall_data) > 0) {
|
||||
map <- map %>%
|
||||
addCircleMarkers(
|
||||
data = landfall_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,15 +576,17 @@ 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") {
|
||||
if (input$storm_overview_cost_index_y_scale == "Log") {
|
||||
is_y_log <- T
|
||||
}else{
|
||||
} else {
|
||||
is_y_log <- F
|
||||
}
|
||||
|
||||
@@ -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;"
|
||||
)
|
||||
)
|
||||
),
|
||||
|
||||
@@ -1048,9 +1330,9 @@ create_dataset_card <- function(dataset_row) {
|
||||
# Update selected datasets based on checkboxes
|
||||
observe({
|
||||
selected <- character(0)
|
||||
for(i in 1:nrow(datasets_info)) {
|
||||
for (i in 1:nrow(datasets_info)) {
|
||||
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)
|
||||
}
|
||||
}
|
||||
@@ -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,
|
||||
@@ -1142,14 +1438,21 @@ 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;")
|
||||
if (length(values$selected_datasets) == 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;"
|
||||
)
|
||||
)
|
||||
```
|
||||
|
||||
@@ -1215,7 +1528,7 @@ output$all_storms_map <- renderLeaflet({
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = 2,
|
||||
popup = ~paste0(storm_name, " ", storm_year),
|
||||
popup = ~ paste0(storm_name, " ", storm_year),
|
||||
weight = 0,
|
||||
color = "blue",
|
||||
fillColor = "blue",
|
||||
@@ -1226,7 +1539,7 @@ output$all_storms_map <- renderLeaflet({
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = ~rmw_meters,
|
||||
popup = ~paste0(storm_name, " ", storm_year),
|
||||
popup = ~ paste0(storm_name, " ", storm_year),
|
||||
weight = 1,
|
||||
color = "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)
|
||||
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)
|
||||
|
||||
@@ -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,
|
||||
|
||||
Reference in New Issue
Block a user