update db calls

queries.R

@@ -3,6 +3,7 @@
 library(tidyverse)
 library(dplyr)
 library(DBI)
+#library(sf)
 
 linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
 macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
@@ -43,6 +44,18 @@ metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing"))
 
 public.counties <- tbl(con, I("public.counties"))
 
+# helper functions
+
+# splits full_lf_id into lf_type and lf_id 
+split_full_lf_id <- function(full_lf_id) {
+  lf_type = gsub('[0-9]+', '', full_lf_id)
+  lf_id = gsub('[^0-9]', '', full_lf_id)
+  
+  return(list(lf_type = lf_type, lf_id = lf_id))
+}
+
+# DB getters
+
 # returns a list of loss storms we have data on
 get_all_loss_storms <- function() {
   query <- econ.storm_base_loss %>% 
@@ -65,14 +78,265 @@ get_all_loss_storms <- function() {
   return(result)
 }
 
+# returns a list of latest normalized losses
+get_latest_aggregate_losses <- function() {
+  latest_loss_year <- econ.normalized_landfalls %>% 
+    select(normalization_year) %>% 
+    arrange(desc(normalization_year)) %>% 
+    head(1) %>% 
+    collect() %>% 
+    pull(normalization_year)
+  
+  query <- econ.normalized_landfalls %>% 
+    filter(normalization_year == latest_loss_year) %>% 
+    left_join(econ.storm_base_loss %>% 
+                filter(!is.na(base_loss)) %>% 
+                mutate(
+                  ncei_priority = case_when(
+                    str_like(base_loss_source, "%ncei%") ~ 1,
+                    str_like(base_loss_source, "%ncei%") ~ 2,
+                    TRUE ~ 3
+                  )
+                ) %>% 
+                group_by(storm_basin, storm_year, storm_name, lf_type, lf_id) %>% 
+                slice_min(ncei_priority, n = 1, with_ties = F) %>% 
+                ungroup(),
+              by = c("storm_basin", "storm_year", "storm_name", "lf_type", "lf_id")) %>% 
+    mutate(
+      mmh_lf = (base_loss * gdp_deflator * rwhu * affected_housing),
+      mmp_lf = (base_loss * gdp_deflator * rwpc * affected_population)
+    ) %>% 
+    group_by(storm_basin, storm_year, storm_name) %>% 
+    summarize(
+      mmh = sum(mmh_lf, na.rm = T),
+      mmp = sum(mmp_lf, na.rm = T),
+      .groups = "drop"
+    ) %>% 
+    filter(!is.na(mmh) & !is.na(mmp)) %>% 
+    select(
+      storm_name,
+      storm_year,
+      mmh,
+      mmp
+    )
+  
+  result <- query %>% collect()
+  
+  return(result)
+}
 
+# returns unique lf ids for a storm
+get_unique_lf_ids <- function(storm) {
+  query <- econ.storm_base_loss %>% 
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name
+    ) %>% 
+    mutate(
+      full_lf_id = paste0(lf_type, lf_id)
+    ) %>% 
+    distinct(
+      full_lf_id, 
+      .keep_all = T
+    ) %>% 
+    arrange(
+      full_lf_id
+    ) %>% 
+    select(
+      storm_basin, storm_year, storm_name, lf_type, lf_id, full_lf_id
+    )
+  
+  result <- query %>% collect()
+  
+  return(result)
+}
 
+# returns normalized mmh/mmp indexes and costs over time by landfall
+get_normalized_cost_index <- function(storm, full_lf_id) {
+  lf_id_parts <- split_full_lf_id(full_lf_id)
+  
+  query <- econ.normalized_landfalls %>% 
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name,
+      lf_type == lf_id_parts$lf_type,
+      lf_id == lf_id_parts$lf_id
+    ) %>% 
+    left_join(econ.storm_base_loss %>% 
+                filter(!is.na(base_loss)) %>% 
+                mutate(
+                  ncei_priority = case_when(
+                    str_like(base_loss_source, "%ncei%") ~ 1,
+                    str_like(base_loss_source, "%mwr%") ~ 2,
+                    TRUE ~ 3
+                  )
+                ) %>% 
+                group_by(storm_basin, storm_year, storm_name, lf_type, lf_id) %>% 
+                slice_min(ncei_priority, n = 1, with_ties = F) %>% 
+                ungroup(),
+              by = c("storm_basin", "storm_year", "storm_name", "lf_type", "lf_id")) %>% 
+      mutate(
+        mmh_index = (gdp_deflator * rwhu * affected_housing),
+        mmp_index = (gdp_deflator * rwpc * affected_population),
+        mmh = (base_loss * mmh_index),
+        mmp = (base_loss * mmp_index)
+      ) %>% 
+      select(
+        normalization_year, mmh, mmp
+      )
+  
+  result <- query %>% collect()
+  
+  return(result)
+}
 
+# returns landfalls and data at landfall from HURDAT
+get_hurdat_landfalls <- function(storm) {
+  query <- hurdat.best_track %>% 
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name,
+      record_identifier == "L"
+    ) %>% 
+    mutate(
+      lon = sql("ST_X(ST_Transform(location::geometry, 4326))"),
+      lat = sql("ST_Y(ST_Transform(location::geometry, 4326))")
+    ) %>% 
+    select(
+      datetime,
+      lon,
+      lat,
+      rmw,
+      pressure,
+      windspeed
+    )
+  
+  result <- query %>% collect()
+  
+  return(result)
+}
 
+# returns storm track from HURDAT
+get_hurdat_track <- function(storm) {
+  query <- hurdat.best_track %>% 
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name
+    ) %>% 
+    mutate(
+      lon = sql("ST_X(ST_Transform(location::geometry, 4326))"),
+      lat = sql("ST_Y(ST_Transform(location::geometry, 4326))"),
+      rmw_meters = (rmw * 1852) # convert nautical miles to meters
+    ) %>% 
+    select(
+      datetime,
+      lon,
+      lat,
+      rmw,
+      record_identifier,
+      rmw_meters
+    )
+  
+  result <- query %>% collect()
+  
+  return(result)
+}
 
+# returns normalized population and housing growth by county with geometry
+#get_normalized_metric_growth <- function(storm, full_lf_id) {
+#  lf_id_parts <- split_full_lf_id(full_lf_id)
+#  
+#  affected_counties <- gis.affected_area_landfalls %>% 
+#    filter(
+#      storm_basin == storm$storm_basin,
+#      storm_year == storm$storm_year,
+#      storm_name == storm$storm_name,
+#      lf_type == lf_id_parts$lf_type,
+#      lf_id == lf_id_parts$lf_id
+#    ) %>% 
+#    select(state_fips, county_fips)
+#  
+#  baseline_metrics <- metrics.pop_and_housing %>% 
+#    filter(
+#      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 <- metrics.pop_and_housing %>% 
+#    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(
+#      public.counties,
+#      by = c("state_fips" = "statefp", "county_fips" = "countyfp") 
+#    ) %>% 
+#    mutate(
+#      geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))")
+#    ) %>% 
+#    select(
+#      state_fips,
+#      county_fips,
+#      year,
+#      population,
+#      housing_units,
+#      normalized_population,
+#      normalized_housing,
+#      geom_wkt
+#    ) %>% 
+#    arrange(state_fips, county_fips, year)
+#  
+#  result <- query %>% collect()
+#  
+#  return(result)
+#}
 
+# test functions
 
+#storm <- list(storm_basin = "AL", storm_name = "KATRINA", storm_year = 2005)
+#full_lf_id <- "LF1"
 
+#a <- get_all_loss_storms()
+
+#b <- get_latest_aggregate_losses()
+
+#c <- get_unique_lf_ids(storm)
+
+#d <- get_normalized_cost_index(storm, full_lf_id)
+
+#e <- get_hurdat_landfalls(storm)
+
+#f <- get_hurdat_track(storm)
+
+#g <- get_normalized_metric_growth(storm, full_lf_id)
+#g_2 <- g %>% 
+#  st_as_sf(wkt = "geom_wkt")