Merge branch 'dev_local' into dev

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"}
 ===
 

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") %>%
+    query <- get_tbl("pop_housing_normalized_growth", "metrics") %>%
-      filter(
+      filter(base_year == storm$storm_year) %>%
-        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,
+        base_year_population,
-        normalized_housing,
+        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(

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(
@@ -481,8 +483,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))
@@ -520,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),
@@ -533,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) %>%
@@ -567,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") +
@@ -591,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 %>%
@@ -618,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") +