add queries.R to move query functions to separate file

dashboard.Rmd

@@ -45,6 +45,8 @@ baseDir <- linuxdir
 
 config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml"))
 
+source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R"))
+
 # SUPABASE CON
 con <- dbConnect(
   RPostgres::Postgres(),
@@ -191,21 +193,23 @@ public.counties <- tbl(con, I("public.counties"))
 
 ### COMMONLY USED DATA
 
-loss_storms <- econ.storm_base_loss %>% 
+#loss_storms <- econ.storm_base_loss %>% 
-  select(
+#  select(
-    storm_basin, storm_year, storm_name
+#    storm_basin, storm_year, storm_name
-  ) %>% 
+#  ) %>% 
-  distinct(
+#  distinct(
-    storm_basin, storm_year, storm_name
+#    storm_basin, storm_year, storm_name
-  ) %>% 
+#  ) %>% 
-  left_join(
+#  left_join(
-    hurdat.hurdat_storms %>%
+#    hurdat.hurdat_storms %>%
-    mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)), 
+#    mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)), 
-    by = c("storm_basin", "storm_year", "storm_name")) %>% 
+#    by = c("storm_basin", "storm_year", "storm_name")) %>% 
-  select(
+#  select(
-    hurdatId, storm_basin, storm_name, storm_year
+#    hurdatId, storm_basin, storm_name, storm_year
-  ) %>% 
+#  ) %>% 
-  collect()
+#  collect()
+
+loss_storms <- get_all_loss_storms()
 
 base_losses_by_lf <- econ.storm_base_loss %>% 
   filter(!is.na(base_loss)) %>% 
@@ -776,13 +780,163 @@ Column {data-width=550}
 
 ### Map Year {data-height=100}
 ```{r}
-sliderInput("growth_trend_map_year", label = NULL, min = 2005, max = 2024, step = 1, animate = T, value = 2005, sep = "", width = "100%", ticks = F)
+sliderInput("growth_trend_map_slider", label = NULL, min = 1900, max = 2024, step = 1, animate = T, value = 2005, sep = "", width = "100%", ticks = F)
 
 ```
 
 ### {data-height=900 .no-padding}
 
 ```{r}
+growth_metrics_lf_fips <- reactive({
+  req(growth_trends$full_lf_id)
+  
+  result <- gis.affected_area_landfalls %>% 
+    filter(
+      storm_basin == storm_selection$storm_basin,
+      storm_year == storm_selection$storm_year,
+      storm_name == storm_selection$storm_name,
+      lf_type == growth_trends$lf_type,
+      lf_id == growth_trends$lf_id
+    ) %>% 
+    mutate(
+      fips = paste0(state_fips, county_fips)
+    ) %>% 
+    select(
+      fips
+    ) %>% 
+    collect()
+  
+  return(result)
+})
+
+normalized_growth_metrics_lf <- reactive({
+  req(growth_metrics_lf_fips())
+  
+  affected_fips <- growth_metrics_lf_fips()$fips
+  
+  affected_counties <- metrics.pop_and_housing %>% 
+    mutate(
+      fips = paste0(state_fips, county_fips)
+    ) %>% 
+    filter(
+      fips %in% affected_fips,
+      year >= storm_selection$storm_year
+    ) %>% 
+    group_by(
+      fips
+    ) %>% 
+    arrange(
+      year
+    ) %>% 
+    mutate(
+      base_population = first(population),
+      base_housing_units = first(housing_units),
+    ) %>% 
+    ungroup() %>%  
+    collect()
+
+  affected_counties_geom <- public.counties %>% 
+    mutate(
+      fips = paste0(statefp, countyfp),
+      geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))")
+    ) %>% 
+    filter(
+      fips %in% affected_fips,
+    ) %>% 
+    collect()
+  
+  result <- affected_counties %>% 
+    left_join(
+      affected_counties_geom, 
+      by = "fips"
+    ) %>% 
+    st_as_sf(wkt = "geom_wkt")
+  
+  return(result)
+})
+
+growth_trend_map_year <- reactive({
+  req(input$growth_trend_map_slider)
+  
+  result <- normalized_growth_metrics_lf() %>% 
+    filter(
+      year == input$growth_trend_map_slider
+    )
+  
+  return(result)
+})
+
+aggregate_growth_metrics_lf <- reactive({
+  req(growth_metrics_lf_fips())
+  
+  result <- metrics.pop_and_housing %>% 
+    mutate(
+      fips = paste0(state_fips, county_fips)
+    ) %>% 
+    filter(
+      fips %in% growth_metrics_lf_fips()$fips,
+      year >= storm_selection$storm_year
+    ) %>% 
+    group_by(
+      year
+    ) %>% 
+    summarize(
+      aggregate_population = sum(population, na.rm = T),
+      aggregate_housing_units = sum(housing_units, na.rm = T),
+      .groups = "drop"
+    ) %>% 
+    collect()
+  
+  return(result)
+})
+
+aggregate_normalized_growth_metrics_lf <- reactive ({
+  req(aggregate_growth_metrics_lf())
+
+  result <- aggregate_growth_metrics_lf() %>% 
+    arrange(
+      year
+    ) %>% 
+    mutate(
+      base_population = first(aggregate_population),
+      base_housing_units = first(aggregate_housing_units),
+      normalized_population = (aggregate_population / base_population),
+      normalized_housing_units = (aggregate_housing_units / base_housing_units),
+      year = as.Date(paste0(year, "-01-01"))
+    ) %>% 
+    select(
+      year, normalized_population, normalized_housing_units
+    )
+  
+  return(result)
+})
+
+aggregate_normalized_growth_metrics_lf_ts <- reactive({
+  req(aggregate_normalized_growth_metrics_lf())
+  
+  result <- aggregate_normalized_growth_metrics_lf() %>% 
+    select(-year) %>% 
+    xts(order.by = aggregate_normalized_growth_metrics_lf()$year)
+  
+  return(result)
+})
+
+normalized_growth_metrics_lf_ts <- reactive({
+  req(normalized_growth_metrics_lf())
+  
+  result <- normalized_growth_metrics_lf() %>% 
+    select(-year) %>% 
+    xts(order.by = normalized_growth_metrics_lf()$year)
+  
+  return(result)
+})
+
+normalized_counties_sf <- reactive({
+  req(storm_selection$is_selected)
+  
+  affected_counties <- gis.affected_area_landfalls
+})
+
 dbStormCounties <- reactive({
   req(storm_selection$is_selected)
   
@@ -821,13 +975,14 @@ dbStormCounties <- reactive({
 output$popMapPoly <- renderLeaflet({
   leaflet() %>% 
     addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% 
-    setView(lng = -89.8, lat = 29.6, zoom = 8) #%>% 
+    setView(lng = -89.8, lat = 29.6, zoom = 8) %>% 
-    #addPolygons(
+    addPolygons(
-    #  fillColor = "red",
+      data = growth_trend_map_year(),
-    #  fillOpacity = 0.3,
+      fillColor = "red",
-    #  color = "black", 
+      fillOpacity = 0.3,
-    #  weight = 2
+      color = "black", 
-    #)
+      weight = 2
+    )
 })
 
 output$housingMapPoly <- renderLeaflet({
@@ -856,61 +1011,7 @@ Column {data-width=450}
 
 ### Landfall Selection {data-height=550}
 ```{r}
-normalized_growth_metrics_lf_ts <- reactive ({
-  req(growth_trends$full_lf_id)
 
-  growth_metrics_lf_fips <- gis.affected_area_landfalls %>% 
-    filter(
-      storm_basin == storm_selection$storm_basin,
-      storm_year == storm_selection$storm_year,
-      storm_name == storm_selection$storm_name,
-      lf_type == growth_trends$lf_type,
-      lf_id == growth_trends$lf_id
-    ) %>% 
-    mutate(
-      full_lf_id = paste0(state_fips, county_fips)
-    ) %>% 
-    collect()
-
-  growth_metrics_lf <- metrics.pop_and_housing %>% 
-    mutate(
-      full_lf_id = paste0(state_fips, county_fips)
-    ) %>% 
-    filter(
-      full_lf_id %in% growth_metrics_lf_fips$full_lf_id,
-      year >= storm_selection$storm_year
-    ) %>% 
-    group_by(
-      year
-    ) %>% 
-    summarize(
-      aggregate_population = sum(population, na.rm = T),
-      aggregate_housing_units = sum(housing_units, na.rm = T),
-      .groups = "drop"
-    ) %>% 
-    collect()
-
-  normalized_growth_metrics_lf <- growth_metrics_lf %>% 
-    arrange(
-      year
-    ) %>% 
-    mutate(
-      base_population = first(aggregate_population),
-      base_housing_units = first(aggregate_housing_units),
-      normalized_population = (aggregate_population / base_population),
-      normalized_housing_units = (aggregate_housing_units / base_housing_units),
-      year = as.Date(paste0(year, "-01-01"))
-    ) %>% 
-    select(
-      year, normalized_population, normalized_housing_units
-    )
-
-  result <- normalized_growth_metrics_lf %>% 
-    select(-year) %>% 
-    xts(order.by = normalized_growth_metrics_lf$year)
-  
-  return(result)
-})
 
 observe({
   req(growth_trends$full_lf_id)
@@ -942,7 +1043,7 @@ fillCol(
 )
 
 output$popHu <- renderDygraph({
-  dygraph(normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>% 
+  dygraph(aggregate_normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>% 
     dySeries("normalized_population", label = "Population") %>% 
     dySeries("normalized_housing_units", label = "Housing Units") %>% 
     dyRangeSelector()

queries.R

@@ -0,0 +1,81 @@
+# DB queries for shiny app
+
+library(tidyverse)
+library(dplyr)
+library(DBI)
+
+linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
+macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
+#baseDir <- macdir
+baseDir <- linuxdir
+
+config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml"))
+
+# SUPABASE CON
+con <- dbConnect(
+  RPostgres::Postgres(),
+  host = config$db_host,
+  port = config$db_port,
+  dbname = config$db_dbname,
+  user = config$db_user,
+  password = config$db_password
+)
+
+# lazy load DB tables
+
+econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls"))
+econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss"))
+econ.usa_yearly <- tbl(con, I("econ.usa_yearly"))
+
+fatal.storm_fatalities_type <- tbl(con, I("fatal.storm_fatalities_type"))
+fatal.storm_total_fatalities <- tbl(con, I("fatal.storm_total_fatalities"))
+
+fips.counties <- tbl(con, I("fips.counties"))
+fips.states <- tbl(con, I("fips.states"))
+
+gis.affected_area_landfalls <- tbl(con, I("gis.affected_area_landfalls"))
+
+hurdat.best_track <- tbl(con, I("hurdat.best_track"))
+hurdat.hurdat_storms <- tbl(con, I("hurdat.hurdat_storms"))
+
+metrics.geo_attributes <- tbl(con, I("metrics.geo_attributes"))
+metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing"))
+
+public.counties <- tbl(con, I("public.counties"))
+
+# returns a list of loss storms we have data on
+get_all_loss_storms <- function() {
+  query <- econ.storm_base_loss %>% 
+    select(
+      storm_basin, storm_year, storm_name
+    ) %>% 
+    distinct(
+      storm_basin, storm_year, storm_name
+    ) %>% 
+    left_join(
+      hurdat.hurdat_storms %>%
+        mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)), 
+      by = c("storm_basin", "storm_year", "storm_name")) %>% 
+    select(
+      hurdatId, storm_basin, storm_name, storm_year
+    ) 
+  
+  result <- query %>% collect()
+  
+  return(result)
+}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+