mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-29 21:01:27 +00:00
modify all R code with air and quarto formatting
This commit is contained in:
+3
-1
@@ -1,6 +1,8 @@
|
||||
library(profvis)
|
||||
|
||||
setwd("/home/dylan/Personal/Projects/Hurricane Normalization/R/dataScripts/restructured/app")
|
||||
setwd(
|
||||
"/home/dylan/Personal/Projects/Hurricane Normalization/R/dataScripts/restructured/app"
|
||||
)
|
||||
|
||||
profvis({
|
||||
rmarkdown::render("dashboard.Rmd")
|
||||
|
||||
+667
-323
File diff suppressed because it is too large
Load Diff
@@ -9,7 +9,9 @@ macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
|
||||
#baseDir <- macdir
|
||||
baseDir <- linuxdir
|
||||
|
||||
config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml"))
|
||||
config <- config::get(
|
||||
file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")
|
||||
)
|
||||
|
||||
# SUPABASE CON
|
||||
con <- dbConnect(
|
||||
@@ -53,7 +55,7 @@ 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")
|
||||
|
||||
#qry <- econ.storm_base_loss %>%
|
||||
#qry <- econ.storm_base_loss %>%
|
||||
# left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name"))
|
||||
|
||||
#show_query(qry)
|
||||
@@ -88,11 +90,11 @@ disconnect_db <- function() {
|
||||
dbDisconnect(con)
|
||||
}
|
||||
|
||||
# splits full_lf_id into lf_type and lf_id
|
||||
# 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))
|
||||
}
|
||||
|
||||
@@ -101,68 +103,77 @@ split_full_lf_id <- function(full_lf_id) {
|
||||
# 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 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 %>%
|
||||
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
|
||||
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 %>%
|
||||
|
||||
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
|
||||
normalization_year,
|
||||
mmh,
|
||||
mmp
|
||||
)
|
||||
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
||||
test_query <- function() {
|
||||
result <- dbGetQuery(con, "WITH yearly_totals AS (
|
||||
result <- dbGetQuery(
|
||||
con,
|
||||
"WITH yearly_totals AS (
|
||||
SELECT
|
||||
year,
|
||||
SUM(population) as total_population,
|
||||
@@ -188,63 +199,71 @@ SELECT
|
||||
ROUND(total_housing_units / base_housing, 4) as housing_index
|
||||
FROM yearly_totals
|
||||
CROSS JOIN base_year
|
||||
ORDER BY year;")
|
||||
ORDER BY year;"
|
||||
)
|
||||
|
||||
result <- result %>%
|
||||
result <- result %>%
|
||||
mutate(
|
||||
year = as.Date(paste0(year, "-01-01"))
|
||||
) %>%
|
||||
) %>%
|
||||
select(
|
||||
year, population_index, housing_index
|
||||
year,
|
||||
population_index,
|
||||
housing_index
|
||||
)
|
||||
|
||||
result_ts <- result %>%
|
||||
select(-year) %>%
|
||||
|
||||
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 %>%
|
||||
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
|
||||
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 %>%
|
||||
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,
|
||||
datetime,
|
||||
lon,
|
||||
lat,
|
||||
rmw,
|
||||
pressure,
|
||||
windspeed
|
||||
)
|
||||
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
|
||||
#return(
|
||||
# list(
|
||||
# data = result,
|
||||
@@ -253,31 +272,31 @@ get_hurdat_landfalls <- function(storm) {
|
||||
# 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 %>%
|
||||
query <- view.hurdat_track %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
@@ -289,13 +308,13 @@ get_hurdat_track <- function(storm) {
|
||||
lon,
|
||||
lat,
|
||||
rmw,
|
||||
pressure,
|
||||
pressure,
|
||||
windspeed,
|
||||
record_identifier,
|
||||
rmw_meters
|
||||
)
|
||||
|
||||
result <- query %>%
|
||||
|
||||
result <- query %>%
|
||||
collect() %>%
|
||||
mutate(
|
||||
formatted_datetime = paste0(
|
||||
@@ -312,51 +331,53 @@ get_hurdat_track <- function(storm) {
|
||||
lon,
|
||||
lat,
|
||||
rmw,
|
||||
pressure,
|
||||
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 %>%
|
||||
|
||||
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 %>%
|
||||
|
||||
baseline_metrics <- metrics.pop_and_housing %>%
|
||||
filter(
|
||||
year == storm$storm_year
|
||||
) %>%
|
||||
inner_join(affected_counties, by = c("state_fips", "county_fips")) %>%
|
||||
) %>%
|
||||
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 %>%
|
||||
)
|
||||
|
||||
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")) %>%
|
||||
) %>%
|
||||
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)
|
||||
) %>%
|
||||
normalized_population = as.numeric(population) /
|
||||
as.numeric(baseline_population),
|
||||
normalized_housing = as.numeric(housing_units) /
|
||||
as.numeric(baseline_housing)
|
||||
) %>%
|
||||
select(
|
||||
state_fips,
|
||||
county_fips,
|
||||
@@ -366,12 +387,17 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
normalized_population,
|
||||
normalized_housing
|
||||
)
|
||||
|
||||
query <- normalized_metrics %>%
|
||||
inner_join(public.counties, by = c("state_fips" = "statefp", "county_fips" = "countyfp")) %>%
|
||||
|
||||
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))")
|
||||
) %>%
|
||||
geom_wkt = sql(
|
||||
"ST_AsText(ST_SimplifyPreserveTopology(ST_Transform(geom, 4326), .001))"
|
||||
)
|
||||
) %>%
|
||||
select(
|
||||
state_fips,
|
||||
county_fips,
|
||||
@@ -381,17 +407,17 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
normalized_population,
|
||||
normalized_housing,
|
||||
geom_wkt
|
||||
) %>%
|
||||
) %>%
|
||||
arrange(state_fips, county_fips, year)
|
||||
|
||||
#query <- normalized_metrics %>%
|
||||
|
||||
#query <- normalized_metrics %>%
|
||||
# inner_join(
|
||||
# public.counties,
|
||||
# by = c("state_fips" = "statefp", "county_fips" = "countyfp")
|
||||
# ) %>%
|
||||
# by = c("state_fips" = "statefp", "county_fips" = "countyfp")
|
||||
# ) %>%
|
||||
# mutate(
|
||||
# geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))")
|
||||
# ) %>%
|
||||
# ) %>%
|
||||
# select(
|
||||
# state_fips,
|
||||
# county_fips,
|
||||
@@ -401,10 +427,10 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
|
||||
# normalized_population,
|
||||
# normalized_housing,
|
||||
# geom_wkt
|
||||
# ) %>%
|
||||
# ) %>%
|
||||
# arrange(state_fips, county_fips, year)
|
||||
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user