From b0606764812a835982a49148c2494cacbde74e0c Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Thu, 1 Jan 2026 17:35:20 -0500 Subject: [PATCH 1/4] update county names --- app/storm_report.qmd | 2 -- 1 file changed, 2 deletions(-) diff --git a/app/storm_report.qmd b/app/storm_report.qmd index 24a9c55..59da3c2 100644 --- a/app/storm_report.qmd +++ b/app/storm_report.qmd @@ -481,8 +481,6 @@ for(lf in unique_lf_ids) { ) ) - growth <- get_county_and_state(growth) - growth_sf <- growth %>% st_as_sf(wkt = "geom_wkt", crs = 4326) %>% filter(year == max(year)) From 8a0b00dce5b49ab2fa362bcbd29abb0f25576044 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Fri, 2 Jan 2026 16:39:07 -0500 Subject: [PATCH 2/4] add storm report downloading --- app/dashboard.Rmd | 68 ++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 65 insertions(+), 3 deletions(-) diff --git a/app/dashboard.Rmd b/app/dashboard.Rmd index eceaffd..9fa1f0b 100644 --- a/app/dashboard.Rmd +++ b/app/dashboard.Rmd @@ -1,11 +1,12 @@ --- title: "Hurricane Normalization App" runtime: shiny -output: +output: flexdashboard::flex_dashboard: orientation: columns vertical_layout: fill - theme: + resize_reload: false + theme: version: 4 bootswatch: litera --- @@ -40,6 +41,7 @@ library(billboarder) library(shinyWidgets) library(paletteer) library(shinyjs) +library(quarto) APP_DIR <- getwd() @@ -71,6 +73,7 @@ storm_selection <- reactiveValues( storm_year = NULL, storm_name = NULL, storm_basin = NULL, + hurdatid = NULL ) ``` @@ -177,7 +180,9 @@ observeEvent(input$selectStorm, { storm_selection$storm_basin <- "AL" storm_selection$storm_year <- input$stormYear storm_selection$storm_name <- input$stormName - #storm_selection$is_selected <- TRUE + + hurdatid <- get_hurdat_id(storm_selection) + storm_selection$hurdatid = hurdatid$hurdatid showNotification("Storm selection updated!", type = "message") }) @@ -1443,6 +1448,63 @@ div( ) ``` +Download Report {data-navmenu="Compute"} +=== + +Column {data-width=400} +--- + +### Report Options {} +```{r} +downloadButton("report", "Generate Report") + +output$report <- downloadHandler( + filename = function() { + paste0( + storm_selection$hurdatid, + "_", + storm_selection$storm_name, + "_", + storm_selection$storm_year, + ".pdf" + ) + }, + content = function(file) { + params <- list( + storm_basin = storm_selection$storm_basin, + storm_year = storm_selection$storm_year, + storm_name = storm_selection$storm_name, + hurdat_id = storm_selection$hurdatid + ) + + id <- showNotification( + "Rendering report...", + duration = NULL, + closeButton = FALSE + ) + + on.exit(removeNotification(id), add = TRUE) + + temp_pdf <- file.path(APP_DIR, "storm_report.pdf") + + quarto::quarto_render( + input = file.path(APP_DIR, "storm_report.qmd"), + execute_params = params, + output_format = "pdf" + ) + + file.copy(temp_pdf, file) + } +) +``` + +Column {data-width=600} +--- + +### {.no-padding} +```{r} +``` + Data Export {data-navmenu="Compute"} === From 14ab17902139582a7d42837b3b6758c1232f32ce Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Fri, 2 Jan 2026 18:49:41 -0500 Subject: [PATCH 3/4] update ggrepel labels --- app/storm_report.qmd | 59 +++++++++++++++++++++++++++++++++----------- 1 file changed, 45 insertions(+), 14 deletions(-) diff --git a/app/storm_report.qmd b/app/storm_report.qmd index 59da3c2..9751794 100644 --- a/app/storm_report.qmd +++ b/app/storm_report.qmd @@ -467,6 +467,8 @@ for(lf in unique_lf_ids) { #| fig-align: "left" for(lf in unique_lf_ids) { + lf_split <- split_full_lf_id(lf) + growth <- get_normalized_metric_growth(storm, lf) %>% mutate( population_opacity = rescale( @@ -518,7 +520,6 @@ for(lf in unique_lf_ids) { 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), ylim = c(lat_range[1] - lat_padding, lat_range[2] + lat_padding), @@ -531,24 +532,29 @@ for(lf in unique_lf_ids) { theme_minimal() + plot_theme + set.seed(2004) 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)) + + ggrepel::geom_label_repel( + data = growth_sf, + aes(label = name, geometry = geom_wkt), + stat = "sf_coordinates" + ) + 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 + expand = FALSE ) latest_opacity <- growth %>% filter(year == max(year)) %>% - select(county_fips, name, housing_opacity, population_opacity) + select(name, housing_opacity, population_opacity) growth_colored <- growth %>% - left_join(latest_opacity, by = c("county_fips", "name"), suffix = c("", "_latest")) + left_join(latest_opacity, by = "name", suffix = c("", "_latest")) housing_colors <- latest_opacity %>% distinct(name, housing_opacity) %>% @@ -565,15 +571,25 @@ for(lf in unique_lf_ids) { h_plot <- ggplot(growth_colored, aes(x = year, y = normalized_housing, color = name, - group = county_fips)) + + group = name)) + geom_line() + scale_color_manual(values = housing_color_values) + geom_text_repel( data = growth_colored %>% filter(year == max(year)), - aes(label = name, x = year + 1), + aes(label = name), direction = "y", hjust = 0, - size = 3 + size = 3, + color = "black", + segment.size = .5, + segment.alpha = .5, + segment.linetype = "dotted", + box.padding = .4, + segment.curvature = -0.1, + segment.ncp = 3, + segment.angle = 20, + min.segment.length = 0, + xlim = c(max(growth_colored$year), NA) ) + coord_cartesian(clip = "off") + guides(color = "none") + @@ -589,16 +605,21 @@ for(lf in unique_lf_ids) { print(h_growth_map) print(h_plot) + set.seed(2004) 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)) + + ggrepel::geom_label_repel( + data = growth_sf, + aes(label = name, geometry = geom_wkt), + stat = "sf_coordinates" + ) + 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 + expand = FALSE ) population_colors <- latest_opacity %>% @@ -616,15 +637,25 @@ for(lf in unique_lf_ids) { p_plot <- ggplot(growth_colored, aes(x = year, y = normalized_population, color = name, - group = county_fips)) + + group = name)) + geom_line() + scale_color_manual(values = population_color_values) + geom_text_repel( data = growth_colored %>% filter(year == max(year)), - aes(label = name, x = year + 1), + aes(label = name), direction = "y", hjust = 0, - size = 3 + size = 3, + color = "black", + segment.size = .5, + segment.alpha = .5, + segment.linetype = "dotted", + box.padding = .4, + segment.curvature = -0.1, + segment.ncp = 3, + segment.angle = 20, + min.segment.length = 0, + xlim = c(max(growth_colored$year), NA) ) + coord_cartesian(clip = "off") + guides(color = "none") + From a46e07b5145051576d516bd95a3ee5b7c626dce3 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sat, 28 Mar 2026 16:00:15 -0400 Subject: [PATCH 4/4] update growth map to use materialized county view --- app/queries.R | 60 +++++++++++++++++++++------------------------------ 1 file changed, 24 insertions(+), 36 deletions(-) diff --git a/app/queries.R b/app/queries.R index 0c7bb8a..e42bca0 100644 --- a/app/queries.R +++ b/app/queries.R @@ -418,41 +418,9 @@ get_normalized_metric_growth <- function(storm, full_lf_id) { ) %>% select(state_fips, county_fips) - baseline_metrics <- get_tbl("pop_and_housing", "metrics") %>% - filter( - year == storm$storm_year - ) %>% + query <- get_tbl("pop_housing_normalized_growth", "metrics") %>% + filter(base_year == storm$storm_year) %>% inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% - select( - state_fips, - county_fips, - baseline_population = population, - baseline_housing = housing_units - ) - - normalized_metrics <- get_tbl("pop_and_housing", "metrics") %>% - filter( - year >= storm$storm_year - ) %>% - inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% - inner_join(baseline_metrics, by = c("state_fips", "county_fips")) %>% - mutate( - normalized_population = as.numeric(population) / - as.numeric(baseline_population), - normalized_housing = as.numeric(housing_units) / - as.numeric(baseline_housing) - ) %>% - select( - state_fips, - county_fips, - year, - population, - housing_units, - normalized_population, - normalized_housing - ) - - query <- normalized_metrics %>% inner_join( get_tbl("counties", "public"), by = c("state_fips" = "statefp", "county_fips" = "countyfp") @@ -469,11 +437,31 @@ get_normalized_metric_growth <- function(storm, full_lf_id) { name, population, housing_units, - normalized_population, - normalized_housing, + base_year_population, + base_year_housing, + normalized_population = population_normalized, + normalized_housing = housing_units_normalized, geom_wkt ) %>% arrange(state_fips, county_fips, year) + + result <- query %>% + collect() %>% + mutate( + normalized_population = if_else( + is.na(base_year_population) | is.na(base_year_housing), + NA_real_, + normalized_population / 100 + ), + normalized_housing = if_else( + is.na(base_year_population) | is.na(base_year_housing), + NA_real_, + normalized_housing / 100 + ) + ) %>% + select(-base_year_population, -base_year_housing) + + return(result) } else { affected_state <- get_tbl("indirect_landfalls", "gis") %>% filter(