mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
add pop and housing growth
This commit is contained in:
@@ -23,12 +23,14 @@ params:
|
|||||||
```{r setup, echo=FALSE}
|
```{r setup, echo=FALSE}
|
||||||
library(ggplot2)
|
library(ggplot2)
|
||||||
library(sf)
|
library(sf)
|
||||||
|
sf_use_s2(FALSE)
|
||||||
library(rnaturalearth)
|
library(rnaturalearth)
|
||||||
library(dplyr)
|
library(dplyr)
|
||||||
library(scales)
|
library(scales)
|
||||||
library(knitr)
|
library(knitr)
|
||||||
library(kableExtra)
|
library(kableExtra)
|
||||||
library(patchwork)
|
library(patchwork)
|
||||||
|
library(lubridate)
|
||||||
|
|
||||||
source(file = "queries.R")
|
source(file = "queries.R")
|
||||||
|
|
||||||
@@ -38,6 +40,8 @@ storm <- list(
|
|||||||
storm_name = params$storm_name
|
storm_name = params$storm_name
|
||||||
)
|
)
|
||||||
|
|
||||||
|
latest_normalization_year <- get_latest_normalization_year()
|
||||||
|
|
||||||
unique_lfs <- get_unique_lf_ids(storm)
|
unique_lfs <- get_unique_lf_ids(storm)
|
||||||
hurdat_id <- get_hurdat_id(storm)
|
hurdat_id <- get_hurdat_id(storm)
|
||||||
|
|
||||||
@@ -330,6 +334,31 @@ storm_track %>%
|
|||||||
```{r normalization, echo=FALSE}
|
```{r normalization, echo=FALSE}
|
||||||
#| out-width: "100%"
|
#| 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)
|
costs <- get_all_normalized_cost_index(storm)
|
||||||
|
|
||||||
# for each lf, create charts of mmh/mmp
|
# for each lf, create charts of mmh/mmp
|
||||||
@@ -367,4 +396,161 @@ for(lf in unique_lf_ids) {
|
|||||||
print(mmh_plot)
|
print(mmh_plot)
|
||||||
print(mmp_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)
|
||||||
|
}
|
||||||
```
|
```
|
||||||
Reference in New Issue
Block a user