add memoisation and cache query functions

app/queries.R

@@ -4,6 +4,8 @@ library(tidyverse)
 library(dplyr)
 library(DBI)
 library(xts)
+library(memoise)
+library(cachem)
 
 config <- config::get(file = "config.yml")
 
@@ -17,46 +19,21 @@ con <- dbConnect(
   password = config$db_password
 )
 
-# DB TABLES
+.tbl_cache <- new.env(parent = emptyenv())
 
-econ.normalized_landfalls <- tbl(con, I("econ.all_normalized_landfalls"))
+get_tbl <- function(name, schema = NULL) {
-econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss"))
+  key <- if (is.null(schema)) name else paste0(schema, ".", name)
-econ.usa_yearly <- tbl(con, I("econ.usa_yearly"))
 
-fatal.storm_fatalities_type <- tbl(con, I("fatal.storm_fatalities_type"))
+  if (!exists(key, .tbl_cache)) {
-fatal.storm_total_fatalities <- tbl(con, I("fatal.storm_total_fatalities"))
+    if (is.null(schema)) {
+      .tbl_cache[[key]] <- tbl(con, name)
+    } else {
+      .tbl_cache[[key]] <- tbl(con, I(paste0(schema, ".", name)))
+    }
+  }
 
-fips.counties <- tbl(con, I("fips.counties"))
+  .tbl_cache[[key]]
-fips.states <- tbl(con, I("fips.states"))
+}
-
-gis.affected_area_landfalls <- tbl(con, I("gis.affected_area_landfalls"))
-gis.indirect_landfalls <- tbl(con, I("gis.indirect_landfalls"))
-gis.us_states_boundary <- tbl(con, I("gis.us_states_boundary"))
-
-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"))
-metrics.usa_pop_hu <- tbl(con, I("metrics.usa_pop_hu"))
-
-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")
-view.best_track_summary <- tbl(con, "best_track_summary")
-view.yearly_state_metrics <- tbl(con, "yearly_state_metrics")
 #qry <- econ.storm_base_loss %>%
 #  left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name"))
 
@@ -103,7 +80,7 @@ split_full_lf_id <- function(full_lf_id) {
 # DB getters
 
 get_yearly_economics <- function(yr) {
-  query <- econ.usa_yearly %>%
+  query <- get_tbl("usa_yearly", "econ") %>%
     filter(year == yr)
 
   result <- query %>% collect()
@@ -112,7 +89,7 @@ get_yearly_economics <- function(yr) {
 }
 
 get_latest_normalization_year <- function() {
-  query <- view.yearly_normalized_losses %>%
+  query <- get_tbl("all_yearly_normalized_losses") %>%
     summarize(latest_year = max(normalization_year))
 
   result <- query %>% collect()
@@ -121,7 +98,7 @@ get_latest_normalization_year <- function() {
 }
 
 get_yearly_usa_pop_hu <- function(yr) {
-  query <- metrics.usa_pop_hu %>%
+  query <- get_tbl("usa_pop_hu", "metrics") %>%
     filter(year == yr)
 
   result <- query %>% collect()
@@ -130,7 +107,7 @@ get_yearly_usa_pop_hu <- function(yr) {
 }
 
 get_best_track_summary <- function(storm) {
-  query <- view.best_track_summary %>%
+  query <- get_tbl("best_track_summary") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -143,7 +120,7 @@ get_best_track_summary <- function(storm) {
 }
 
 get_hurdat_id <- function(storm) {
-  query <- view.hurdat_ids %>%
+  query <- get_tbl("hurdat_ids") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -157,7 +134,7 @@ get_hurdat_id <- function(storm) {
 
 # returns a list of loss storms we have data on
 get_all_loss_storms <- function() {
-  query <- view.all_loss_storms
+  query <- get_tbl("all_loss_storms")
 
   result <- query %>% collect()
 
@@ -166,7 +143,7 @@ get_all_loss_storms <- function() {
 
 # returns a list of all stored hurdat ids
 get_all_hurdat_ids <- function() {
-  query <- view.hurdat_ids
+  query <- get_tbl("hurdat_ids")
 
   result <- query %>% collect()
 
@@ -175,7 +152,7 @@ get_all_hurdat_ids <- function() {
 
 # returns a list of latest normalized losses
 get_latest_aggregate_losses <- function() {
-  query <- view.all_normalized_losses
+  query <- get_tbl("all_normalized_losses")
 
   result <- query %>% collect()
 
@@ -183,7 +160,7 @@ get_latest_aggregate_losses <- function() {
 }
 
 get_latest_aggregate_loss <- function(storm) {
-  query <- view.all_normalized_losses %>%
+  query <- get_tbl("all_normalized_losses") %>%
     filter(
       storm_year == storm$storm_year,
       storm_name == storm$storm_name
@@ -196,7 +173,7 @@ get_latest_aggregate_loss <- function(storm) {
 
 # returns unique lf ids for a storm
 get_unique_lf_ids <- function(storm) {
-  query <- view.all_loss_landfalls %>%
+  query <- get_tbl("all_loss_landfalls") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -227,7 +204,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 <- view.yearly_normalized_losses %>%
+  query <- get_tbl("all_yearly_normalized_losses") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -297,7 +274,7 @@ ORDER BY year;"
 
 # returns normalized mmh/mmp indexes and costs over time by storm
 get_all_normalized_cost_index <- function(storm) {
-  query <- view.yearly_normalized_losses %>%
+  query <- get_tbl("all_yearly_normalized_losses") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -322,7 +299,7 @@ get_all_normalized_cost_index <- function(storm) {
 
 # returns landfalls and data at landfall from HURDAT
 get_hurdat_landfalls <- function(storm) {
-  query <- view.hurdat_track %>%
+  query <- get_tbl("hurdat_track") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -354,7 +331,7 @@ get_hurdat_landfalls <- function(storm) {
 
 # returns all tracked storm conus landfalls
 get_all_conus_landfalls <- function() {
-  query <- view.all_conus_landfalls %>%
+  query <- get_tbl("all_conus_landfalls") %>%
     select(
       storm_year,
       storm_name,
@@ -370,7 +347,7 @@ get_all_conus_landfalls <- function() {
 
 # returns all storm tracks from HURDAT
 get_all_hurdat_tracks <- function() {
-  query <- view.all_loss_storms_tracks
+  query <- get_tbl("all_loss_storms_tracks")
 
   result <- query %>% collect()
 
@@ -379,7 +356,7 @@ get_all_hurdat_tracks <- function() {
 
 # returns storm track from HURDAT
 get_hurdat_track <- function(storm) {
-  query <- view.hurdat_track %>%
+  query <- get_tbl("hurdat_track") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -428,7 +405,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 <- gis.affected_area_landfalls %>%
+    affected_counties <- get_tbl("affected_area_landfalls", "gis") %>%
       filter(
         storm_basin == storm$storm_basin,
         storm_year == storm$storm_year,
@@ -438,7 +415,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
       ) %>%
       select(state_fips, county_fips)
 
-    baseline_metrics <- metrics.pop_and_housing %>%
+    baseline_metrics <- get_tbl("pop_and_housing", "metrics") %>%
       filter(
         year == storm$storm_year
       ) %>%
@@ -450,7 +427,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
         baseline_housing = housing_units
       )
 
-    normalized_metrics <- metrics.pop_and_housing %>%
+    normalized_metrics <- get_tbl("pop_and_housing", "metrics") %>%
       filter(
         year >= storm$storm_year
       ) %>%
@@ -474,7 +451,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
 
     query <- normalized_metrics %>%
       inner_join(
-        public.counties,
+        get_tbl("counties", "public"),
         by = c("state_fips" = "statefp", "county_fips" = "countyfp")
       ) %>%
       mutate(
@@ -495,7 +472,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
       ) %>%
       arrange(state_fips, county_fips, year)
   } else {
-    affected_state <- gis.indirect_landfalls %>%
+    affected_state <- get_tbl("indirect_landfalls", "gis") %>%
       filter(
         storm_basin == storm$storm_basin,
         storm_year == storm$storm_year,
@@ -507,7 +484,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
         state_fips
       )
 
-    baseline_metrics <- view.yearly_state_metrics %>%
+    baseline_metrics <- get_tbl("yearly_state_metrics") %>%
       filter(year == storm$storm_year) %>%
       inner_join(affected_state, by = "state_fips") %>%
       select(
@@ -516,7 +493,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
         baseline_housing = state_housing_units
       )
 
-    normalized_metrics <- view.yearly_state_metrics %>%
+    normalized_metrics <- get_tbl("yearly_state_metrics") %>%
       filter(
         year >= storm$storm_year
       ) %>%
@@ -539,7 +516,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
 
     query <- normalized_metrics %>%
       inner_join(
-        gis.us_states_boundary %>%
+        get_tbl("us_states_boundary", "gis") %>%
           rename(state_fips = statefp),
         by = "state_fips"
       ) %>%
@@ -568,7 +545,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
 
 # returns all lf type landfalls
 get_all_lf_type_landfalls <- function() {
-  query <- view.lf_id_location
+  query <- get_tbl("lf_id_location")
 
   result <- query %>% collect()
 
@@ -577,7 +554,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 <- view.lf_landfall_gis
+  query <- get_tbl("lf_landfall_gis")
 
   result <- query %>% collect()
 
@@ -586,7 +563,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 <- view.lf_landfall_gis %>%
+  query <- get_tbl("lf_landfall_gis") %>%
     filter(
       storm_basin == storm$storm_basin,
       storm_year == storm$storm_year,
@@ -603,7 +580,7 @@ get_county_and_state <- function(df) {
   unique_state_fips <- unique(df$state_fips)
   unique_county_fips <- unique(df$county_fips)
 
-  counties <- public.counties %>%
+  counties <- get_tbl("counties", "public") %>%
     filter(
       statefp %in% !!unique_state_fips,
       countyfp %in% !!unique_county_fips
@@ -616,7 +593,7 @@ get_county_and_state <- function(df) {
     ) %>%
     collect()
 
-  states <- fips.states %>%
+  states <- get_tbl("states", "fips") %>%
     filter(state_fips %in% !!unique_state_fips) %>%
     select(
       state_fips,
@@ -637,3 +614,57 @@ get_county_and_state <- function(df) {
 
   return(result)
 }
+
+cache_dir <- "cache"
+if (!dir.exists(cache_dir)) {
+  dir.create(cache_dir, recursive = TRUE)
+}
+
+query_cache <- cachem::cache_disk(
+  dir = cache_dir,
+  max_size = 1000 * 1024^2,
+  evict = "lru"
+)
+
+get_yearly_economics <- memoise(get_yearly_economics, cache = query_cache)
+get_latest_normalization_year <- memoise(
+  get_latest_normalization_year,
+  cache = query_cache
+)
+get_yearly_usa_pop_hu <- memoise(get_yearly_usa_pop_hu, cache = query_cache)
+get_best_track_summary <- memoise(get_best_track_summary, cache = query_cache)
+get_hurdat_id <- memoise(get_hurdat_id, 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_latest_aggregate_loss <- memoise(
+  get_latest_aggregate_loss,
+  cache = query_cache
+)
+get_unique_lf_ids <- memoise(get_unique_lf_ids, cache = query_cache)
+get_normalized_cost_index <- memoise(
+  get_normalized_cost_index,
+  cache = query_cache
+)
+get_all_normalized_cost_index <- memoise(
+  get_all_normalized_cost_index,
+  cache = query_cache
+)
+get_hurdat_landfalls <- memoise(get_hurdat_landfalls, 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_hurdat_track <- memoise(get_hurdat_track, cache = query_cache)
+get_normalized_metric_growth <- memoise(
+  get_normalized_metric_growth,
+  cache = query_cache
+)
+get_all_lf_type_landfalls <- memoise(
+  get_all_lf_type_landfalls,
+  cache = query_cache
+)
+get_all_lf_type_factors <- memoise(get_all_lf_type_factors, cache = query_cache)
+get_lf_type_factors <- memoise(get_lf_type_factors, cache = query_cache)
+get_county_and_state <- memoise(get_county_and_state, cache = query_cache)