diff --git a/app/storm_report.qmd b/app/storm_report.qmd index f453f35..e234451 100644 --- a/app/storm_report.qmd +++ b/app/storm_report.qmd @@ -23,12 +23,14 @@ params: ```{r setup, echo=FALSE} library(ggplot2) library(sf) +sf_use_s2(FALSE) library(rnaturalearth) library(dplyr) library(scales) library(knitr) library(kableExtra) library(patchwork) +library(lubridate) source(file = "queries.R") @@ -38,6 +40,8 @@ storm <- list( storm_name = params$storm_name ) +latest_normalization_year <- get_latest_normalization_year() + unique_lfs <- get_unique_lf_ids(storm) hurdat_id <- get_hurdat_id(storm) @@ -330,6 +334,31 @@ storm_track %>% ```{r normalization, echo=FALSE} #| out-width: "100%" +base_yearly_econ <- get_yearly_economics(storm$storm_year) +base_yearly_usa <- get_yearly_usa_pop_hu(storm$storm_year) + +base_yearly_metrics <- base_yearly_usa %>% + left_join(base_yearly_econ, by = "year") %>% + select(-aggregate_storm_loss) + +ref_yearly_econ <- get_yearly_economics(latest_normalization_year) +ref_yearly_usa <- get_yearly_usa_pop_hu(latest_normalization_year) + +ref_yearly_metrics <- ref_yearly_usa %>% + left_join(ref_yearly_econ, by = "year") %>% + select(-aggregate_storm_loss) + +# year, ccn, gdp, ag loss +# base... +# ref... + +# table cols metric, base year, ref year, ratio +# ccn +# gdp +# us pop +# us hous +# rwpc/hu + costs <- get_all_normalized_cost_index(storm) # for each lf, create charts of mmh/mmp @@ -367,4 +396,161 @@ for(lf in unique_lf_ids) { print(mmh_plot) print(mmp_plot) } +``` + +## Population and Housing Growth + +```{r growth, echo=FALSE} +#| out-width: "100%" + +for(lf in unique_lf_ids) { + growth <- get_normalized_metric_growth(storm, lf) %>% + 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) + ) + ) + + growth <- get_county_and_state(growth) + + growth_sf <- growth %>% + st_as_sf(wkt = "geom_wkt", crs = 4326) %>% + filter(year == max(year)) + + combined_geom <- st_union(growth_sf) + + bbox <- st_bbox(combined_geom) + + lon_range <- c(bbox["xmin"], bbox["xmax"]) + lat_range <- c(bbox["ymin"], bbox["ymax"]) + + padding_percent <- 0.1 + + lon_padding <- diff(lon_range) * padding_percent + lat_padding <- diff(lat_range) * padding_percent + + h_growth <- ggplot() + + geom_sf(data = world, fill = "#E5E5E5", color = "#999999", size = 0.3) + + geom_sf(data = states, fill = NA, color = "#CCCCCC", size = 0.2) + + geom_sf(data = growth_sf, fill = "blue", color = "blue", alpha = growth_sf$housing_opacity) + + geom_sf_label(data = growth_sf, aes(label = growth_sf$name)) + + coord_sf( + xlim = c(lon_range[1] - lon_padding, lon_range[2] + lon_padding), + ylim = c(lat_range[1] - lat_padding, lat_range[2] + lat_padding), + expand = FALSE + ) + + labs( + x = "", + y = "" + ) + theme_minimal() + + theme( + panel.background = element_rect(fill = "#D4E6F1"), + panel.grid.major = element_line(color = "#BBBBBB", size = 0.2), + legend.position = "right", + legend.key.size = unit(0.4, "cm"), + legend.text = element_text(size = 8) + ) + + plot_theme + + latest_opacity <- growth %>% + filter(year == max(year)) %>% + select(county_fips, name, housing_opacity, population_opacity) + + growth_colored <- growth %>% + left_join(latest_opacity, by = c("county_fips", "name"), suffix = c("", "_latest")) + + housing_colors <- latest_opacity %>% + distinct(name, housing_opacity) %>% + arrange(desc(housing_opacity)) %>% + mutate( + alpha_hex = sprintf("%02X", round(housing_opacity * 255)), + color_with_alpha = paste0("#0000FF", alpha_hex) + ) + + housing_color_values <- setNames(housing_colors$color_with_alpha, housing_colors$name) + + growth_colored <- growth_colored %>% + mutate(name = factor(name, levels = housing_colors$name)) + + mmh_plot <- ggplot(growth_colored, aes(x = year, y = normalized_housing, + color = name, + group = county_fips)) + + geom_line() + + scale_color_manual(values = housing_color_values) + + guides(color = guide_legend(override.aes = list(linewidth = 3))) + + labs( + title = paste(lf, "Housing Growth"), + x = "Year", + y = "Normalized Growth", + color = "County" + ) + + theme_minimal() + + plot_theme + + print(h_growth) + print(mmh_plot) + + p_growth <- ggplot() + + geom_sf(data = world, fill = "#E5E5E5", color = "#999999", size = 0.3) + + geom_sf(data = states, fill = NA, color = "#CCCCCC", size = 0.2) + + geom_sf(data = growth_sf, fill = "red", color = "red", alpha = growth_sf$population_opacity) + + geom_sf_label(data = growth_sf, aes(label = growth_sf$name)) + + coord_sf( + xlim = c(lon_range[1] - lon_padding, lon_range[2] + lon_padding), + ylim = c(lat_range[1] - lat_padding, lat_range[2] + lat_padding), + expand = FALSE + ) + + labs( + x = "", + y = "" + ) + theme_minimal() + + theme( + panel.background = element_rect(fill = "#D4E6F1"), + panel.grid.major = element_line(color = "#BBBBBB", size = 0.2), + legend.position = "right", + legend.key.size = unit(0.4, "cm"), + legend.text = element_text(size = 8) + ) + + plot_theme + + population_colors <- latest_opacity %>% + distinct(name, population_opacity) %>% + arrange(desc(population_opacity)) %>% + mutate( + alpha_hex = sprintf("%02X", round(population_opacity * 255)), + color_with_alpha = paste0("#FF0000", alpha_hex) + ) + + population_color_values <- setNames(population_colors$color_with_alpha, population_colors$name) + + growth_colored <- growth_colored %>% + mutate(name = factor(name, levels = population_colors$name)) + + mmp_plot <- ggplot(growth_colored, aes(x = year, y = normalized_population, + color = name, + group = county_fips)) + + geom_line() + + scale_color_manual(values = population_color_values) + + guides(color = guide_legend(override.aes = list(linewidth = 3))) + + labs( + title = paste(lf, "Population Growth"), + x = "Year", + y = "Normalized Growth", + color = "County" + ) + + theme_minimal() + + plot_theme + + print(p_growth) + print(mmp_plot) +} ``` \ No newline at end of file