mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
add table coloring and cost charts
This commit is contained in:
+171
-11
@@ -1,9 +1,15 @@
|
||||
---
|
||||
title: "`r params$storm_name` `r params$storm_year` STORM REPORT"
|
||||
title: "`r params$hurdat_id` `r params$storm_name` `r params$storm_year` STORM REPORT"
|
||||
subtitle: "Generated on: `r Sys.Date()`"
|
||||
format:
|
||||
pdf:
|
||||
theme: cosmo
|
||||
geometry:
|
||||
- top=0.75in
|
||||
- bottom=0.75in
|
||||
- left=0.75in
|
||||
- right=0.75in
|
||||
- footskip=0.3in
|
||||
execute:
|
||||
warning: false
|
||||
message: false
|
||||
@@ -11,15 +17,18 @@ params:
|
||||
storm_basin: AL
|
||||
storm_year: 1900
|
||||
storm_name: GALVESTON
|
||||
hurdat_id: AL011900
|
||||
---
|
||||
|
||||
```{r setup}
|
||||
#| echo: false
|
||||
|
||||
```{r setup, echo=FALSE}
|
||||
library(ggplot2)
|
||||
library(sf)
|
||||
library(rnaturalearth)
|
||||
library(dplyr)
|
||||
library(scales)
|
||||
library(knitr)
|
||||
library(kableExtra)
|
||||
library(patchwork)
|
||||
|
||||
source(file = "queries.R")
|
||||
|
||||
@@ -30,16 +39,56 @@ storm <- list(
|
||||
)
|
||||
|
||||
unique_lfs <- get_unique_lf_ids(storm)
|
||||
hurdat_id <- get_hurdat_id(storm)
|
||||
|
||||
storm_track <- get_hurdat_track(storm)
|
||||
plot_theme <- theme(
|
||||
plot.title = element_text(hjust = 0.5, size = 10),
|
||||
axis.title = element_text(size = 10),
|
||||
axis.text = element_text(size = 8),
|
||||
legend.title = element_text(face = "bold"),
|
||||
legend.text = element_text(face = "bold")
|
||||
)
|
||||
```
|
||||
|
||||
```{r track_map}
|
||||
#| echo: false
|
||||
```{r storm_overview, echo=FALSE}
|
||||
# storm stats
|
||||
# mmh, mmp, landfalls, hurdat summary (max cat, min press, max wind, hurricane points, total points)
|
||||
# fatality data?
|
||||
|
||||
hurdat_summary <- get_best_track_summary(storm)
|
||||
|
||||
losses <- get_latest_aggregate_loss(storm)
|
||||
|
||||
storm_track <- get_hurdat_track(storm)
|
||||
|
||||
```
|
||||
|
||||
# Storm Overview
|
||||
|
||||
- **HURDAT2 ID** `r hurdat_id$hurdatid`
|
||||
- **HURDAT2 Revision Date** `r hurdat_id$hurdat_rev`
|
||||
|
||||
## Normalized Cost
|
||||
|
||||
- **MMH24** `r dollar(losses$mmh)`
|
||||
- **MMP24** `r dollar(losses$mmp)`
|
||||
|
||||
## HURDAT2 Summary
|
||||
|
||||
- **Date Range** `r min(storm_track$formatted_datetime)` to `r max(storm_track$formatted_datetime)`
|
||||
- **Total Observations** `r hurdat_summary$total_observations`
|
||||
- **Hurricane Observations** `r hurdat_summary$hurricane_observations`
|
||||
- **Landfall Observations** `r hurdat_summary$hurdat_landfalls`
|
||||
- **Maximum Saffir-Simpson Category** `r hurdat_summary$max_category`
|
||||
- **Minimum Pressure** `r hurdat_summary$min_pressure` mb
|
||||
- **Maximum Windspeed** `r hurdat_summary$max_windspeed` kts
|
||||
|
||||
## Storm Track
|
||||
|
||||
```{r track_map, echo=FALSE}
|
||||
#| fig-width: 10
|
||||
#| fig-height: 8
|
||||
|
||||
# Add color and category classification
|
||||
#| out-width: "100%"
|
||||
storm_track <- storm_track %>%
|
||||
mutate(
|
||||
hurricane_category = case_when(
|
||||
@@ -80,7 +129,6 @@ storm_track <- get_hurdat_track(storm)
|
||||
) %>%
|
||||
arrange(datetime)
|
||||
|
||||
# Create ordered factor for legend
|
||||
storm_track$status_label <- factor(
|
||||
storm_track$status_label,
|
||||
levels = c(
|
||||
@@ -130,7 +178,8 @@ storm_track <- get_hurdat_track(storm)
|
||||
legend.position = "right",
|
||||
legend.key.size = unit(0.4, "cm"),
|
||||
legend.text = element_text(size = 8)
|
||||
)
|
||||
) +
|
||||
plot_theme
|
||||
|
||||
if (nrow(storm_track) >= 2) {
|
||||
for (i in 1:(nrow(storm_track) - 1)) {
|
||||
@@ -207,4 +256,115 @@ storm_track <- get_hurdat_track(storm)
|
||||
)
|
||||
|
||||
print(p)
|
||||
```
|
||||
|
||||
## Track Observations
|
||||
|
||||
```{r track_table, echo=FALSE}
|
||||
landfall_rows <- which(storm_track$record_identifier == "L")
|
||||
|
||||
storm_track %>%
|
||||
select(
|
||||
formatted_datetime,
|
||||
storm_status,
|
||||
record_identifier,
|
||||
lon,
|
||||
lat,
|
||||
rmw,
|
||||
pressure,
|
||||
windspeed
|
||||
) %>%
|
||||
kable(
|
||||
col.names = c(
|
||||
"Date",
|
||||
"Status",
|
||||
"Record ID",
|
||||
"Lon",
|
||||
"Lat",
|
||||
"RMW",
|
||||
"Pressure",
|
||||
"Windspeed"
|
||||
),
|
||||
align = c("l", "c", "c", "r", "r", "r", "r", "r"),
|
||||
booktabs = TRUE
|
||||
) %>%
|
||||
kable_styling(
|
||||
#latex_options = c("striped"),
|
||||
font_size = 9,
|
||||
position = "center"
|
||||
) %>%
|
||||
column_spec(
|
||||
2,
|
||||
color = "white",
|
||||
background = paste0(storm_track$line_color, "A0"),
|
||||
bold = T
|
||||
) %>%
|
||||
row_spec(
|
||||
landfall_rows,
|
||||
color = "white",
|
||||
background = paste0(storm_track$line_color[landfall_rows], "A0")
|
||||
) %>%
|
||||
column_spec(
|
||||
6,
|
||||
color = "white",
|
||||
background = spec_color(storm_track$rmw, end = 0.7),
|
||||
bold = T
|
||||
) %>%
|
||||
column_spec(
|
||||
7,
|
||||
color = "white",
|
||||
background = spec_color(storm_track$pressure, end = 0.7),
|
||||
bold = T
|
||||
) %>%
|
||||
column_spec(
|
||||
8,
|
||||
color = "white",
|
||||
background = spec_color(storm_track$windspeed, end = 0.7),
|
||||
bold = T
|
||||
)
|
||||
|
||||
```
|
||||
|
||||
## Cost Normalization
|
||||
|
||||
```{r normalization, echo=FALSE}
|
||||
#| out-width: "100%"
|
||||
|
||||
costs <- get_all_normalized_cost_index(storm)
|
||||
|
||||
# for each lf, create charts of mmh/mmp
|
||||
|
||||
unique_lf_ids <- unique_lfs$full_lf_id
|
||||
|
||||
for(lf in unique_lf_ids) {
|
||||
filtered_costs <- costs %>%
|
||||
filter(
|
||||
full_lf_id == lf
|
||||
)
|
||||
|
||||
mmh_plot <- ggplot(filtered_costs, aes(x = normalization_year, y = mmh_loss)) +
|
||||
geom_area(fill = "blue", alpha = 0.7) +
|
||||
scale_y_continuous(labels = scales::label_dollar(scale_cut = cut_short_scale())) +
|
||||
labs(
|
||||
title = paste(lf, "MMH Loss"),
|
||||
x = "Year",
|
||||
y = "Aggregate Loss (USD)"
|
||||
) +
|
||||
theme_minimal() +
|
||||
plot_theme
|
||||
|
||||
mmp_plot <- ggplot(filtered_costs, aes(x = normalization_year, y = mmp_loss)) +
|
||||
geom_area(fill = "red", alpha = 0.7) +
|
||||
scale_y_continuous(labels = scales::label_dollar(scale_cut = cut_short_scale())) +
|
||||
labs(
|
||||
title = paste(lf, "MMP Loss"),
|
||||
x = "Year",
|
||||
y = "Aggregate Loss (USD)"
|
||||
) +
|
||||
theme_minimal() +
|
||||
plot_theme
|
||||
|
||||
print(mmh_plot)
|
||||
print(mmp_plot)
|
||||
}
|
||||
```
|
||||
Reference in New Issue
Block a user