mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
add better map rendering
This commit is contained in:
+83
-33
@@ -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)
|
||||
}
|
||||
```
|
||||
Reference in New Issue
Block a user