modify file structure

app/queries.R

@@ -0,0 +1,475 @@
+# DB queries for shiny app
+
+library(tidyverse)
+library(dplyr)
+library(DBI)
+library(xts)
+
+config <- config::get(file = "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
+)
+
+# DB TABLES
+
+econ.normalized_landfalls <- tbl(con, I("econ.all_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"))
+
+# DB VIEWS
+view.all_normalized_losses <- tbl(con, "all_normalized_losses")
+view.hurdat_track <- tbl(con, "hurdat_track")
+view.all_loss_storms <- tbl(con, "all_loss_storms")
+view.all_loss_landfalls <- tbl(con, "all_loss_landfalls")
+view.yearly_normalized_losses <- tbl(con, "all_yearly_normalized_losses")
+view.simplified_county_geom <- tbl(con, "simplified_county_geom")
+view.all_loss_storms_tracks <- tbl(con, "all_loss_storms_tracks")
+view.all_conus_landfalls <- tbl(con, "all_conus_landfalls")
+view.hurdat_ids <- tbl(con, "hurdat_ids")
+view.all_lf_type_landfalls <- tbl(con, "all_lf_type_landfalls")
+view.lf_id_location <- tbl(con, "lf_id_location")
+view.lf_landfall_gis <- tbl(con, "lf_landfall_gis")
+#qry <- econ.storm_base_loss %>%
+#  left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name"))
+
+#show_query(qry)
+
+# test storm
+#katrina <- list(
+#  storm_basin = "AL",
+#  storm_year = 2005,
+#  storm_name = "KATRINA",
+#  lf_type = "LF",
+#  lf_id = 1
+#)
+
+#galveston <- list(
+#  storm_basin = "AL",
+#  storm_year = 1900,
+#  storm_name = "GALVESTON",
+#  lf_type = "LF",
+#  lf_id = 1
+#)
+
+agnes <- list(
+  storm_basin = "AL",
+  storm_year = 1972,
+  storm_name = "AGNES"
+)
+
+# helper functions
+
+# disconnect db connection
+disconnect_db <- function() {
+  dbDisconnect(con)
+}
+
+# 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 <- view.all_loss_storms
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns a list of all stored hurdat ids
+get_all_hurdat_ids <- function() {
+  query <- view.hurdat_ids
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns a list of latest normalized losses
+get_latest_aggregate_losses <- function() {
+  query <- view.all_normalized_losses
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns unique lf ids for a storm
+get_unique_lf_ids <- function(storm) {
+  query <- view.all_loss_landfalls %>%
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name
+    ) %>%
+    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 <- view.yearly_normalized_losses %>%
+    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(
+      normalization_year,
+      mmh,
+      mmp
+    )
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+test_query <- function() {
+  result <- dbGetQuery(
+    con,
+    "WITH yearly_totals AS (
+    SELECT 
+        year,
+        SUM(population) as total_population,
+        SUM(housing_units) as total_housing_units
+    FROM metrics.pop_and_housing
+    WHERE state_fips = '12'
+    AND county_fips IN ('011', '021', '086', '087')
+    AND year BETWEEN 1926 AND 2024
+    GROUP BY year
+),
+base_year AS (
+    SELECT 
+        total_population as base_population,
+        total_housing_units as base_housing
+    FROM yearly_totals
+    WHERE year = (SELECT MIN(year) FROM yearly_totals)  -- Uses first year in dataset as base
+)
+SELECT 
+    year,
+    total_population,
+    total_housing_units,
+    ROUND(total_population / base_population, 4) as population_index,
+    ROUND(total_housing_units / base_housing, 4) as housing_index
+FROM yearly_totals
+CROSS JOIN base_year
+ORDER BY year;"
+  )
+
+  result <- result %>%
+    mutate(
+      year = as.Date(paste0(year, "-01-01"))
+    ) %>%
+    select(
+      year,
+      population_index,
+      housing_index
+    )
+
+  result_ts <- result %>%
+    select(-year) %>%
+    xts(order.by = result$year)
+
+  return(result_ts)
+}
+
+# returns normalized mmh/mmp indexes and costs over time by storm
+get_all_normalized_cost_index <- function(storm) {
+  query <- view.yearly_normalized_losses %>%
+    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)
+    ) %>%
+    select(
+      normalization_year,
+      mmh_index,
+      mmp_index,
+      mmh_loss = mmh,
+      mmp_loss = mmp,
+      full_lf_id
+    )
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns landfalls and data at landfall from HURDAT
+get_hurdat_landfalls <- function(storm) {
+  query <- view.hurdat_track %>%
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name,
+      record_identifier == "L"
+    ) %>%
+    select(
+      datetime,
+      lon,
+      lat,
+      rmw,
+      pressure,
+      windspeed
+    )
+
+  result <- query %>% collect()
+
+  #return(
+  #  list(
+  #    data = result,
+  #    storm_info = storm,
+  #    row_count = nrow(result),
+  #    timestamp = Sys.time()
+  #  )
+  #)
+
+  return(result)
+}
+
+# returns all tracked storm conus landfalls
+get_all_conus_landfalls <- function() {
+  query <- view.all_conus_landfalls
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns all storm tracks from HURDAT
+get_all_hurdat_tracks <- function() {
+  query <- view.all_loss_storms_tracks
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns storm track from HURDAT
+get_hurdat_track <- function(storm) {
+  query <- view.hurdat_track %>%
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name
+    ) %>%
+    select(
+      datetime,
+      storm_status,
+      lon,
+      lat,
+      rmw,
+      pressure,
+      windspeed,
+      record_identifier,
+      rmw_meters
+    )
+
+  result <- query %>%
+    collect() %>%
+    mutate(
+      formatted_datetime = paste0(
+        format(datetime, "%m/%d/%Y"),
+        " ",
+        format(datetime, "%H"),
+        "Z"
+      )
+    ) %>%
+    select(
+      formatted_datetime,
+      datetime,
+      storm_status,
+      lon,
+      lat,
+      rmw,
+      pressure,
+      windspeed,
+      record_identifier,
+      rmw_meters
+    )
+
+  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_SimplifyPreserveTopology(ST_Transform(geom, 4326), .001))"
+      )
+    ) %>%
+    select(
+      state_fips,
+      county_fips,
+      year,
+      population,
+      housing_units,
+      normalized_population,
+      normalized_housing,
+      geom_wkt
+    ) %>%
+    arrange(state_fips, county_fips, year)
+
+  #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)
+}
+
+# returns all lf type landfalls
+get_all_lf_type_landfalls <- function() {
+  query <- view.lf_id_location
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns all storms and factors needed to normalize a lf type landfall
+get_all_lf_type_factors <- function() {
+  query <- view.lf_landfall_gis
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns one storm and factors needed to normalize a lf type landfall
+get_lf_type_factors <- function(storm) {
+  query <- view.lf_landfall_gis %>%
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name,
+      full_lf_id == storm$full_lf_id
+    )
+
+  result <- query %>% collect()
+
+  return(result)
+}