mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
add more db views
This commit is contained in:
@@ -21,7 +21,7 @@ con <- dbConnect(
|
|||||||
password = config$db_password
|
password = config$db_password
|
||||||
)
|
)
|
||||||
|
|
||||||
# lazy load DB tables
|
# DB TABLES
|
||||||
|
|
||||||
econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls"))
|
econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls"))
|
||||||
econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss"))
|
econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss"))
|
||||||
@@ -43,8 +43,16 @@ metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing"))
|
|||||||
|
|
||||||
public.counties <- tbl(con, I("public.counties"))
|
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, "yearly_normalized_losses")
|
||||||
|
view.county_population_housing <- tbl(con, "county_population_housing")
|
||||||
|
|
||||||
# test storm
|
# test storm
|
||||||
test_storm <- list(
|
storm <- list(
|
||||||
storm_basin = "AL",
|
storm_basin = "AL",
|
||||||
storm_year = 2005,
|
storm_year = 2005,
|
||||||
storm_name = "KATRINA",
|
storm_name = "KATRINA",
|
||||||
@@ -66,33 +74,30 @@ split_full_lf_id <- function(full_lf_id) {
|
|||||||
|
|
||||||
# returns a list of loss storms we have data on
|
# returns a list of loss storms we have data on
|
||||||
get_all_loss_storms <- function() {
|
get_all_loss_storms <- function() {
|
||||||
query <- "SELECT * FROM all_loss_storms"
|
query <- view.all_loss_storms
|
||||||
|
|
||||||
result <- dbGetQuery(con, query)
|
result <- query %>% collect()
|
||||||
|
|
||||||
return(result)
|
return(result)
|
||||||
}
|
}
|
||||||
|
|
||||||
# returns a list of latest normalized losses
|
# returns a list of latest normalized losses
|
||||||
get_latest_aggregate_losses <- function() {
|
get_latest_aggregate_losses <- function() {
|
||||||
query <- "SELECT * FROM all_normalized_losses"
|
query <- view.all_normalized_losses
|
||||||
|
|
||||||
result <- dbGetQuery(con, query)
|
result <- query %>% collect()
|
||||||
|
|
||||||
return(result)
|
return(result)
|
||||||
}
|
}
|
||||||
|
|
||||||
# returns unique lf ids for a storm
|
# returns unique lf ids for a storm
|
||||||
get_unique_lf_ids <- function(storm) {
|
get_unique_lf_ids <- function(storm) {
|
||||||
query <- econ.storm_base_loss %>%
|
query <- view.all_loss_landfalls %>%
|
||||||
filter(
|
filter(
|
||||||
storm_basin == storm$storm_basin,
|
storm_basin == storm$storm_basin,
|
||||||
storm_year == storm$storm_year,
|
storm_year == storm$storm_year,
|
||||||
storm_name == storm$storm_name
|
storm_name == storm$storm_name
|
||||||
) %>%
|
) %>%
|
||||||
mutate(
|
|
||||||
full_lf_id = paste0(lf_type, lf_id)
|
|
||||||
) %>%
|
|
||||||
distinct(
|
distinct(
|
||||||
full_lf_id,
|
full_lf_id,
|
||||||
.keep_all = T
|
.keep_all = T
|
||||||
@@ -113,7 +118,7 @@ get_unique_lf_ids <- function(storm) {
|
|||||||
get_normalized_cost_index <- function(storm, full_lf_id) {
|
get_normalized_cost_index <- function(storm, full_lf_id) {
|
||||||
lf_id_parts <- split_full_lf_id(full_lf_id)
|
lf_id_parts <- split_full_lf_id(full_lf_id)
|
||||||
|
|
||||||
query <- econ.normalized_landfalls %>%
|
query <- view.yearly_normalized_losses %>%
|
||||||
filter(
|
filter(
|
||||||
storm_basin == storm$storm_basin,
|
storm_basin == storm$storm_basin,
|
||||||
storm_year == storm$storm_year,
|
storm_year == storm$storm_year,
|
||||||
@@ -121,28 +126,9 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
|
|||||||
lf_type == lf_id_parts$lf_type,
|
lf_type == lf_id_parts$lf_type,
|
||||||
lf_id == lf_id_parts$lf_id
|
lf_id == lf_id_parts$lf_id
|
||||||
) %>%
|
) %>%
|
||||||
left_join(econ.storm_base_loss %>%
|
select(
|
||||||
filter(!is.na(base_loss)) %>%
|
normalization_year, mmh, mmp
|
||||||
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()
|
result <- query %>% collect()
|
||||||
|
|
||||||
@@ -151,17 +137,13 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
|
|||||||
|
|
||||||
# returns landfalls and data at landfall from HURDAT
|
# returns landfalls and data at landfall from HURDAT
|
||||||
get_hurdat_landfalls <- function(storm) {
|
get_hurdat_landfalls <- function(storm) {
|
||||||
query <- hurdat.best_track %>%
|
query <- view.hurdat_track %>%
|
||||||
filter(
|
filter(
|
||||||
storm_basin == storm$storm_basin,
|
storm_basin == storm$storm_basin,
|
||||||
storm_year == storm$storm_year,
|
storm_year == storm$storm_year,
|
||||||
storm_name == storm$storm_name,
|
storm_name == storm$storm_name,
|
||||||
record_identifier == "L"
|
record_identifier == "L"
|
||||||
) %>%
|
) %>%
|
||||||
mutate(
|
|
||||||
lon = sql("ST_X(ST_Transform(location::geometry, 4326))"),
|
|
||||||
lat = sql("ST_Y(ST_Transform(location::geometry, 4326))")
|
|
||||||
) %>%
|
|
||||||
select(
|
select(
|
||||||
datetime,
|
datetime,
|
||||||
lon,
|
lon,
|
||||||
@@ -187,17 +169,12 @@ get_hurdat_landfalls <- function(storm) {
|
|||||||
|
|
||||||
# returns storm track from HURDAT
|
# returns storm track from HURDAT
|
||||||
get_hurdat_track <- function(storm) {
|
get_hurdat_track <- function(storm) {
|
||||||
query <- hurdat.best_track %>%
|
query <- view.hurdat_track %>%
|
||||||
filter(
|
filter(
|
||||||
storm_basin == storm$storm_basin,
|
storm_basin == storm$storm_basin,
|
||||||
storm_year == storm$storm_year,
|
storm_year == storm$storm_year,
|
||||||
storm_name == storm$storm_name
|
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(
|
select(
|
||||||
datetime,
|
datetime,
|
||||||
lon,
|
lon,
|
||||||
@@ -282,55 +259,3 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
|||||||
|
|
||||||
return(result)
|
return(result)
|
||||||
}
|
}
|
||||||
|
|
||||||
async_db_query <- function(query_func, ...) {
|
|
||||||
args <- list(...)
|
|
||||||
|
|
||||||
mirai_call <- mirai({
|
|
||||||
linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
|
|
||||||
macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
|
|
||||||
#baseDir <- macdir
|
|
||||||
baseDir <- linuxdir
|
|
||||||
|
|
||||||
config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml"))
|
|
||||||
|
|
||||||
source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R"))
|
|
||||||
|
|
||||||
if(length(args) == 0) {
|
|
||||||
query_func()
|
|
||||||
}else{
|
|
||||||
do.call(query_func, args)
|
|
||||||
}
|
|
||||||
},
|
|
||||||
environment()
|
|
||||||
)
|
|
||||||
|
|
||||||
return(mirai_call)
|
|
||||||
}
|
|
||||||
|
|
||||||
# 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")
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user