update entire app to begin using bslib instead of flexdashboard

app/queries.R

@@ -4,11 +4,7 @@ library(tidyverse)
 library(dplyr)
 library(DBI)
 library(xts)
-library(memoise)
-library(cachem)
-library(digest)
 
-APP_DIR <- getwd()
 
 config <- config::get(file = "config.yml")
 
@@ -22,21 +18,7 @@ con <- dbConnect(
   password = config$db_password
 )
 
-.tbl_cache <- new.env(parent = emptyenv())
 
-get_tbl <- function(name, schema = NULL) {
-  key <- if (is.null(schema)) name else paste0(schema, ".", name)
-
-  if (!exists(key, .tbl_cache)) {
-    if (is.null(schema)) {
-      .tbl_cache[[key]] <- tbl(con, name)
-    } else {
-      .tbl_cache[[key]] <- tbl(con, I(paste0(schema, ".", name)))
-    }
-  }
-
-  .tbl_cache[[key]]
-}
 #qry <- econ.storm_base_loss %>%
 #  left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name"))
 
@@ -83,7 +65,7 @@ split_full_lf_id <- function(full_lf_id) {
 # DB getters
 
 get_yearly_economics <- function(yr) {
-  query <- get_tbl("usa_yearly", "econ") %>%
+  query <- tbl(con, I("econ.usa_yearly")) %>%
     filter(year == yr)
 
   result <- query %>% collect()
@@ -92,7 +74,7 @@ get_yearly_economics <- function(yr) {
 }
 
 get_latest_normalization_year <- function() {
-  query <- get_tbl("all_yearly_normalized_losses") %>%
+  query <- tbl(con, "all_yearly_normalized_losses") %>%
     summarize(latest_year = max(normalization_year))
 
   result <- query %>% collect()
@@ -101,7 +83,7 @@ get_latest_normalization_year <- function() {
 }
 
 get_storm_data_coverage <- function() {
-  query <- get_tbl("storm_data_coverage")
+  query <- tbl(con, "storm_data_coverage")
 
   result <- query %>% collect()
 
@@ -109,7 +91,7 @@ get_storm_data_coverage <- function() {
 }
 
 get_yearly_usa_pop_hu <- function(yr) {
-  query <- get_tbl("usa_pop_hu", "metrics") %>%
+  query <- tbl(con, I("metrics.usa_pop_hu")) %>%
     filter(year == yr)
 
   result <- query %>% collect()
@@ -118,7 +100,7 @@ get_yearly_usa_pop_hu <- function(yr) {
 }
 
 get_best_track_summary <- function(storm) {
-  query <- get_tbl("best_track_summary") %>%
+  query <- tbl(con, "best_track_summary") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -131,7 +113,7 @@ get_best_track_summary <- function(storm) {
 }
 
 get_hurdat_id <- function(storm) {
-  query <- get_tbl("hurdat_ids") %>%
+  query <- tbl(con, "hurdat_ids") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -145,7 +127,7 @@ get_hurdat_id <- function(storm) {
 
 # returns a list of loss storms we have data on
 get_all_loss_storms <- function() {
-  query <- get_tbl("all_loss_storms")
+  query <- tbl(con, "all_loss_storms")
 
   result <- query %>% collect()
 
@@ -154,7 +136,7 @@ get_all_loss_storms <- function() {
 
 # returns a list of all stored hurdat ids
 get_all_hurdat_ids <- function() {
-  query <- get_tbl("hurdat_ids")
+  query <- tbl(con, "hurdat_ids")
 
   result <- query %>% collect()
 
@@ -163,7 +145,7 @@ get_all_hurdat_ids <- function() {
 
 # returns a list of latest normalized losses
 get_latest_aggregate_losses <- function() {
-  query <- get_tbl("all_normalized_losses")
+  query <- tbl(con, "all_normalized_losses")
 
   result <- query %>% collect()
 
@@ -171,7 +153,7 @@ get_latest_aggregate_losses <- function() {
 }
 
 get_latest_aggregate_loss <- function(storm) {
-  query <- get_tbl("all_normalized_losses") %>%
+  query <- tbl(con, "all_normalized_losses") %>%
     filter(
       storm_year == storm$storm_year,
       storm_name == storm$storm_name
@@ -184,7 +166,7 @@ get_latest_aggregate_loss <- function(storm) {
 
 # returns unique lf ids for a storm
 get_unique_lf_ids <- function(storm) {
-  query <- get_tbl("all_loss_landfalls") %>%
+  query <- tbl(con, "all_loss_landfalls") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -215,7 +197,7 @@ get_unique_lf_ids <- function(storm) {
 get_normalized_cost_index <- function(storm, full_lf_id) {
   lf_id_parts <- split_full_lf_id(full_lf_id)
 
-  query <- get_tbl("all_yearly_normalized_losses") %>%
+  query <- tbl(con, "all_yearly_normalized_losses") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -234,58 +216,9 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
   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 <- get_tbl("all_yearly_normalized_losses") %>%
+  query <- tbl(con, "all_yearly_normalized_losses") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -310,7 +243,7 @@ get_all_normalized_cost_index <- function(storm) {
 
 # returns landfalls and data at landfall from HURDAT
 get_hurdat_landfalls <- function(storm) {
-  query <- get_tbl("hurdat_track") %>%
+  query <- tbl(con, "hurdat_track") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -342,7 +275,7 @@ get_hurdat_landfalls <- function(storm) {
 
 # returns all tracked storm conus landfalls
 get_all_conus_landfalls <- function() {
-  query <- get_tbl("all_conus_landfalls") %>%
+  query <- tbl(con, "all_conus_landfalls") %>%
     select(
       storm_year,
       storm_name,
@@ -358,7 +291,7 @@ get_all_conus_landfalls <- function() {
 
 # returns all storm tracks from HURDAT
 get_all_hurdat_tracks <- function() {
-  query <- get_tbl("all_loss_storms_tracks")
+  query <- tbl(con, "all_loss_storms_tracks")
 
   result <- query %>% collect()
 
@@ -367,7 +300,7 @@ get_all_hurdat_tracks <- function() {
 
 # returns storm track from HURDAT
 get_hurdat_track <- function(storm) {
-  query <- get_tbl("hurdat_track") %>%
+  query <- tbl(con, "hurdat_track") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -416,7 +349,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
   lf_id_parts <- split_full_lf_id(full_lf_id)
 
   if (lf_id_parts$lf_type == 'LF') {
-    affected_counties <- get_tbl("affected_area_landfalls", "gis") %>%
+    affected_counties <- tbl(con, I("gis.affected_area_landfalls")) %>%
       filter(
         storm_basin == storm$storm_basin,
         storm_year == storm$storm_year,
@@ -426,11 +359,11 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
       ) %>%
       select(state_fips, county_fips)
 
-    query <- get_tbl("pop_housing_normalized_growth", "metrics") %>%
-      filter(base_year == storm$storm_year) %>%
+    query <- tbl(con, I("metrics.pop_housing_normalized_growth")) %>%
+      filter(base_year_population == storm$storm_year) %>%
       inner_join(affected_counties, by = c("state_fips", "county_fips")) %>%
       inner_join(
-        get_tbl("counties", "public"),
+        tbl(con, I("public.counties")),
         by = c("state_fips" = "statefp", "county_fips" = "countyfp")
       ) %>%
       mutate(
@@ -471,7 +404,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
 
     return(result)
   } else {
-    affected_state <- get_tbl("indirect_landfalls", "gis") %>%
+    affected_state <- tbl(con, I("gis.indirect_landfalls")) %>%
       filter(
         storm_basin == storm$storm_basin,
         storm_year == storm$storm_year,
@@ -483,7 +416,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
         state_fips
       )
 
-    baseline_metrics <- get_tbl("yearly_state_metrics") %>%
+    baseline_metrics <- tbl(con, "yearly_state_metrics") %>%
       filter(year == storm$storm_year) %>%
       inner_join(affected_state, by = "state_fips") %>%
       select(
@@ -492,7 +425,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
         baseline_housing = state_housing_units
       )
 
-    normalized_metrics <- get_tbl("yearly_state_metrics") %>%
+    normalized_metrics <- tbl(con, "yearly_state_metrics") %>%
       filter(
         year >= storm$storm_year
       ) %>%
@@ -515,7 +448,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
 
     query <- normalized_metrics %>%
       inner_join(
-        get_tbl("us_states_boundary", "gis") %>%
+        tbl(con, I("gis.us_states_boundary")) %>%
           rename(state_fips = statefp),
         by = "state_fips"
       ) %>%
@@ -544,7 +477,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
 
 # returns all lf type landfalls
 get_all_lf_type_landfalls <- function() {
-  query <- get_tbl("lf_id_location")
+  query <- tbl(con, "lf_id_location")
 
   result <- query %>% collect()
 
@@ -553,7 +486,7 @@ get_all_lf_type_landfalls <- function() {
 
 # returns all storms and factors needed to normalize a lf type landfall
 get_all_lf_type_factors <- function() {
-  query <- get_tbl("lf_landfall_gis")
+  query <- tbl(con, "lf_landfall_gis")
 
   result <- query %>% collect()
 
@@ -562,7 +495,7 @@ get_all_lf_type_factors <- function() {
 
 # returns one storm and factors needed to normalize a lf type landfall
 get_lf_type_factors <- function(storm) {
-  query <- get_tbl("lf_landfall_gis") %>%
+  query <- tbl(con, "lf_landfall_gis") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -579,7 +512,7 @@ get_county_and_state <- function(df) {
   unique_state_fips <- unique(df$state_fips)
   unique_county_fips <- unique(df$county_fips)
 
-  counties <- get_tbl("counties", "public") %>%
+  counties <- tbl(con, I("public.counties")) %>%
     filter(
       statefp %in% !!unique_state_fips,
       countyfp %in% !!unique_county_fips
@@ -592,7 +525,7 @@ get_county_and_state <- function(df) {
     ) %>%
     collect()
 
-  states <- get_tbl("states", "fips") %>%
+  states <- tbl(con, I("fips.states")) %>%
     filter(state_fips %in% !!unique_state_fips) %>%
     select(
       state_fips,
@@ -614,30 +547,3 @@ get_county_and_state <- function(df) {
   return(result)
 }
 
-cache_dir <- file.path(APP_DIR, "cache")
-cache_logfile <- file.path(APP_DIR, "cachelog")
-
-if (!dir.exists(cache_dir)) {
-  dir.create(cache_dir, recursive = TRUE)
-}
-
-query_cache <- cachem::cache_disk(
-  dir = cache_dir,
-  max_age = Inf,
-  evict = "lru",
-  logfile = cache_logfile
-)
-
-get_latest_normalization_year <- memoise(
-  get_latest_normalization_year,
-  cache = query_cache
-)
-get_all_loss_storms <- memoise(get_all_loss_storms, cache = query_cache)
-get_all_hurdat_ids <- memoise(get_all_hurdat_ids, cache = query_cache)
-get_latest_aggregate_losses <- memoise(
-  get_latest_aggregate_losses,
-  cache = query_cache
-)
-get_all_conus_landfalls <- memoise(get_all_conus_landfalls, cache = query_cache)
-get_all_hurdat_tracks <- memoise(get_all_hurdat_tracks, cache = query_cache)
-get_all_lf_type_factors <- memoise(get_all_lf_type_factors, cache = query_cache)