From 5fdbfd7323a425b3adfeb1771ee2d25924ce92a3 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sat, 20 Dec 2025 21:17:56 -0500 Subject: [PATCH] add better map rendering --- app/storm_report.qmd | 116 +++++++++++++++++++++++++++++++------------ 1 file changed, 83 insertions(+), 33 deletions(-) diff --git a/app/storm_report.qmd b/app/storm_report.qmd index e234451..142daa3 100644 --- a/app/storm_report.qmd +++ b/app/storm_report.qmd @@ -31,6 +31,8 @@ library(knitr) library(kableExtra) library(patchwork) library(lubridate) +library(ggrepel) +library(ggtext) source(file = "queries.R") @@ -294,7 +296,7 @@ storm_track %>% ) %>% kable_styling( #latex_options = c("striped"), - font_size = 9, + font_size = 11, position = "center" ) %>% column_spec( @@ -372,7 +374,7 @@ for(lf in unique_lf_ids) { ) mmh_plot <- ggplot(filtered_costs, aes(x = normalization_year, y = mmh_loss)) + - geom_area(fill = "blue", alpha = 0.7) + + geom_line(color = "blue") + scale_y_continuous(labels = scales::label_dollar(scale_cut = cut_short_scale())) + labs( title = paste(lf, "MMH Loss"), @@ -383,7 +385,7 @@ for(lf in unique_lf_ids) { plot_theme mmp_plot <- ggplot(filtered_costs, aes(x = normalization_year, y = mmp_loss)) + - geom_area(fill = "red", alpha = 0.7) + + geom_line(color = "red") + scale_y_continuous(labels = scales::label_dollar(scale_cut = cut_short_scale())) + labs( title = paste(lf, "MMP Loss"), @@ -402,6 +404,7 @@ for(lf in unique_lf_ids) { ```{r growth, echo=FALSE} #| out-width: "100%" +#| fig-align: "left" for(lf in unique_lf_ids) { growth <- get_normalized_metric_growth(storm, lf) %>% @@ -431,15 +434,32 @@ for(lf in unique_lf_ids) { lon_range <- c(bbox["xmin"], bbox["xmax"]) lat_range <- c(bbox["ymin"], bbox["ymax"]) + lon_width <- diff(lon_range) + lat_height <- diff(lat_range) + + target_ratio <- 16/9 + current_ratio <- lon_width / lat_height + + if (current_ratio < target_ratio) { + needed_width <- lat_height * target_ratio + extra_width <- (needed_width - lon_width) / 2 + lon_range <- c(lon_range[1] - extra_width, lon_range[2] + extra_width) + } + + if (current_ratio > target_ratio) { + needed_height <- lon_width / target_ratio + extra_height <- (needed_height - lat_height) / 2 + lat_range <- c(lat_range[1] - extra_height, lat_range[2] + extra_height) + } + 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) + + base_growth_map <- 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_label(data = growth_sf, aes(label = growth_sf$name)) + coord_sf( xlim = c(lon_range[1] - lon_padding, lon_range[2] + lon_padding), @@ -449,17 +469,22 @@ for(lf in unique_lf_ids) { 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) ) + + theme_minimal() + plot_theme + h_growth_map <- base_growth_map + + geom_sf(data = growth_sf, fill = "blue", color = "#e5e5e5", size = 0.5, alpha = growth_sf$housing_opacity) + + geom_sf_label(data = growth_sf, aes(label = growth_sf$name)) + + labs( + title = paste(lf, "Housing Growth Map By County"), + ) + + 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 + ) + latest_opacity <- growth %>% filter(year == max(year)) %>% select(county_fips, name, housing_opacity, population_opacity) @@ -480,28 +505,47 @@ for(lf in unique_lf_ids) { growth_colored <- growth_colored %>% mutate(name = factor(name, levels = housing_colors$name)) - mmh_plot <- ggplot(growth_colored, aes(x = year, y = normalized_housing, + h_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))) + + geom_text( + data = growth_colored %>% filter(year == max(year)), + aes(label = name, x = year + 1), + hjust = 0, + size = 3 + ) + + coord_cartesian(clip = "off") + + guides(color = "none") + labs( title = paste(lf, "Housing Growth"), x = "Year", - y = "Normalized Growth", - color = "County" + y = "Normalized Growth" ) + theme_minimal() + - plot_theme + plot_theme + + theme(plot.margin = margin(5.5, 40, 5.5, 5.5)) - print(h_growth) - print(mmh_plot) + print(h_growth_map) + print(h_plot) + + p_growth_map <- base_growth_map + + geom_sf(data = growth_sf, fill = "red", color = "#e5e5e5", size = 0.5, alpha = growth_sf$population_opacity) + + geom_sf_label(data = growth_sf, aes(label = growth_sf$name)) + + labs( + title = paste(lf, "Population Growth Map By County"), + ) + + 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 + ) 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(data = growth_sf, fill = "red", color = "#E5E5E5", size = 0.5, 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), @@ -509,6 +553,7 @@ for(lf in unique_lf_ids) { expand = FALSE ) + labs( + title = paste(lf, "Housing Growth Map By County"), x = "", y = "" ) @@ -516,9 +561,6 @@ for(lf in unique_lf_ids) { 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 @@ -535,22 +577,30 @@ for(lf in unique_lf_ids) { growth_colored <- growth_colored %>% mutate(name = factor(name, levels = population_colors$name)) - mmp_plot <- ggplot(growth_colored, aes(x = year, y = normalized_population, + p_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))) + + geom_text( + data = growth_colored %>% filter(year == max(year)), + aes(label = name, x = year + 1), + hjust = 0, + size = 3 + ) + + coord_cartesian(clip = "off") + + guides(color = "none") + labs( title = paste(lf, "Population Growth"), x = "Year", - y = "Normalized Growth", - color = "County" + y = "Normalized Growth" ) + theme_minimal() + - plot_theme + plot_theme + + theme(plot.margin = margin(5.5, 40, 5.5, 5.5)) - print(p_growth) - print(mmp_plot) + + print(p_growth_map) + print(p_plot) } ``` \ No newline at end of file