diff --git a/app/queries.R b/app/queries.R index 354e198..84d9afb 100644 --- a/app/queries.R +++ b/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")) -econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss")) -econ.usa_yearly <- tbl(con, I("econ.usa_yearly")) +get_tbl <- function(name, schema = NULL) { + key <- if (is.null(schema)) name else paste0(schema, ".", name) -fatal.storm_fatalities_type <- tbl(con, I("fatal.storm_fatalities_type")) -fatal.storm_total_fatalities <- tbl(con, I("fatal.storm_total_fatalities")) + 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))) + } + } -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")) -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") + .tbl_cache[[key]] +} #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)