diff --git a/dashboard.Rmd b/dashboard.Rmd index e4e97f2..f6b6136 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -45,6 +45,8 @@ baseDir <- linuxdir config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")) +source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R")) + # SUPABASE CON con <- dbConnect( RPostgres::Postgres(), @@ -191,21 +193,23 @@ public.counties <- tbl(con, I("public.counties")) ### COMMONLY USED DATA -loss_storms <- econ.storm_base_loss %>% - select( - storm_basin, storm_year, storm_name - ) %>% - distinct( - storm_basin, storm_year, storm_name - ) %>% - left_join( - hurdat.hurdat_storms %>% - mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)), - by = c("storm_basin", "storm_year", "storm_name")) %>% - select( - hurdatId, storm_basin, storm_name, storm_year - ) %>% - collect() +#loss_storms <- econ.storm_base_loss %>% +# select( +# storm_basin, storm_year, storm_name +# ) %>% +# distinct( +# storm_basin, storm_year, storm_name +# ) %>% +# left_join( +# hurdat.hurdat_storms %>% +# mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)), +# by = c("storm_basin", "storm_year", "storm_name")) %>% +# select( +# hurdatId, storm_basin, storm_name, storm_year +# ) %>% +# collect() + +loss_storms <- get_all_loss_storms() base_losses_by_lf <- econ.storm_base_loss %>% filter(!is.na(base_loss)) %>% @@ -776,13 +780,163 @@ Column {data-width=550} ### Map Year {data-height=100} ```{r} -sliderInput("growth_trend_map_year", label = NULL, min = 2005, max = 2024, step = 1, animate = T, value = 2005, sep = "", width = "100%", ticks = F) +sliderInput("growth_trend_map_slider", label = NULL, min = 1900, max = 2024, step = 1, animate = T, value = 2005, sep = "", width = "100%", ticks = F) ``` ### {data-height=900 .no-padding} ```{r} +growth_metrics_lf_fips <- reactive({ + req(growth_trends$full_lf_id) + + result <- gis.affected_area_landfalls %>% + filter( + storm_basin == storm_selection$storm_basin, + storm_year == storm_selection$storm_year, + storm_name == storm_selection$storm_name, + lf_type == growth_trends$lf_type, + lf_id == growth_trends$lf_id + ) %>% + mutate( + fips = paste0(state_fips, county_fips) + ) %>% + select( + fips + ) %>% + collect() + + return(result) +}) + +normalized_growth_metrics_lf <- reactive({ + req(growth_metrics_lf_fips()) + + affected_fips <- growth_metrics_lf_fips()$fips + + affected_counties <- metrics.pop_and_housing %>% + mutate( + fips = paste0(state_fips, county_fips) + ) %>% + filter( + fips %in% affected_fips, + year >= storm_selection$storm_year + ) %>% + group_by( + fips + ) %>% + arrange( + year + ) %>% + mutate( + base_population = first(population), + base_housing_units = first(housing_units), + ) %>% + ungroup() %>% + collect() + + affected_counties_geom <- public.counties %>% + mutate( + fips = paste0(statefp, countyfp), + geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))") + ) %>% + filter( + fips %in% affected_fips, + ) %>% + collect() + + result <- affected_counties %>% + left_join( + affected_counties_geom, + by = "fips" + ) %>% + st_as_sf(wkt = "geom_wkt") + + return(result) +}) + +growth_trend_map_year <- reactive({ + req(input$growth_trend_map_slider) + + result <- normalized_growth_metrics_lf() %>% + filter( + year == input$growth_trend_map_slider + ) + + return(result) +}) + +aggregate_growth_metrics_lf <- reactive({ + req(growth_metrics_lf_fips()) + + result <- metrics.pop_and_housing %>% + mutate( + fips = paste0(state_fips, county_fips) + ) %>% + filter( + fips %in% growth_metrics_lf_fips()$fips, + year >= storm_selection$storm_year + ) %>% + group_by( + year + ) %>% + summarize( + aggregate_population = sum(population, na.rm = T), + aggregate_housing_units = sum(housing_units, na.rm = T), + .groups = "drop" + ) %>% + collect() + + return(result) +}) + +aggregate_normalized_growth_metrics_lf <- reactive ({ + req(aggregate_growth_metrics_lf()) + + result <- aggregate_growth_metrics_lf() %>% + arrange( + year + ) %>% + mutate( + base_population = first(aggregate_population), + base_housing_units = first(aggregate_housing_units), + normalized_population = (aggregate_population / base_population), + normalized_housing_units = (aggregate_housing_units / base_housing_units), + year = as.Date(paste0(year, "-01-01")) + ) %>% + select( + year, normalized_population, normalized_housing_units + ) + + return(result) +}) + +aggregate_normalized_growth_metrics_lf_ts <- reactive({ + req(aggregate_normalized_growth_metrics_lf()) + + result <- aggregate_normalized_growth_metrics_lf() %>% + select(-year) %>% + xts(order.by = aggregate_normalized_growth_metrics_lf()$year) + + return(result) +}) + +normalized_growth_metrics_lf_ts <- reactive({ + req(normalized_growth_metrics_lf()) + + result <- normalized_growth_metrics_lf() %>% + select(-year) %>% + xts(order.by = normalized_growth_metrics_lf()$year) + + return(result) +}) + +normalized_counties_sf <- reactive({ + req(storm_selection$is_selected) + + affected_counties <- gis.affected_area_landfalls +}) + dbStormCounties <- reactive({ req(storm_selection$is_selected) @@ -821,13 +975,14 @@ dbStormCounties <- reactive({ output$popMapPoly <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% - setView(lng = -89.8, lat = 29.6, zoom = 8) #%>% - #addPolygons( - # fillColor = "red", - # fillOpacity = 0.3, - # color = "black", - # weight = 2 - #) + setView(lng = -89.8, lat = 29.6, zoom = 8) %>% + addPolygons( + data = growth_trend_map_year(), + fillColor = "red", + fillOpacity = 0.3, + color = "black", + weight = 2 + ) }) output$housingMapPoly <- renderLeaflet({ @@ -856,61 +1011,7 @@ Column {data-width=450} ### Landfall Selection {data-height=550} ```{r} -normalized_growth_metrics_lf_ts <- reactive ({ - req(growth_trends$full_lf_id) - - growth_metrics_lf_fips <- gis.affected_area_landfalls %>% - filter( - storm_basin == storm_selection$storm_basin, - storm_year == storm_selection$storm_year, - storm_name == storm_selection$storm_name, - lf_type == growth_trends$lf_type, - lf_id == growth_trends$lf_id - ) %>% - mutate( - full_lf_id = paste0(state_fips, county_fips) - ) %>% - collect() - growth_metrics_lf <- metrics.pop_and_housing %>% - mutate( - full_lf_id = paste0(state_fips, county_fips) - ) %>% - filter( - full_lf_id %in% growth_metrics_lf_fips$full_lf_id, - year >= storm_selection$storm_year - ) %>% - group_by( - year - ) %>% - summarize( - aggregate_population = sum(population, na.rm = T), - aggregate_housing_units = sum(housing_units, na.rm = T), - .groups = "drop" - ) %>% - collect() - - normalized_growth_metrics_lf <- growth_metrics_lf %>% - arrange( - year - ) %>% - mutate( - base_population = first(aggregate_population), - base_housing_units = first(aggregate_housing_units), - normalized_population = (aggregate_population / base_population), - normalized_housing_units = (aggregate_housing_units / base_housing_units), - year = as.Date(paste0(year, "-01-01")) - ) %>% - select( - year, normalized_population, normalized_housing_units - ) - - result <- normalized_growth_metrics_lf %>% - select(-year) %>% - xts(order.by = normalized_growth_metrics_lf$year) - - return(result) -}) observe({ req(growth_trends$full_lf_id) @@ -942,7 +1043,7 @@ fillCol( ) output$popHu <- renderDygraph({ - dygraph(normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>% + dygraph(aggregate_normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>% dySeries("normalized_population", label = "Population") %>% dySeries("normalized_housing_units", label = "Housing Units") %>% dyRangeSelector() diff --git a/queries.R b/queries.R new file mode 100644 index 0000000..430d4fd --- /dev/null +++ b/queries.R @@ -0,0 +1,81 @@ +# DB queries for shiny app + +library(tidyverse) +library(dplyr) +library(DBI) + +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")) + +# SUPABASE CON +con <- dbConnect( + RPostgres::Postgres(), + host = config$db_host, + port = config$db_port, + dbname = config$db_dbname, + user = config$db_user, + password = config$db_password +) + +# lazy load DB tables + +econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls")) +econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss")) +econ.usa_yearly <- tbl(con, I("econ.usa_yearly")) + +fatal.storm_fatalities_type <- tbl(con, I("fatal.storm_fatalities_type")) +fatal.storm_total_fatalities <- tbl(con, I("fatal.storm_total_fatalities")) + +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")) + +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")) + +public.counties <- tbl(con, I("public.counties")) + +# returns a list of loss storms we have data on +get_all_loss_storms <- function() { + query <- econ.storm_base_loss %>% + select( + storm_basin, storm_year, storm_name + ) %>% + distinct( + storm_basin, storm_year, storm_name + ) %>% + left_join( + hurdat.hurdat_storms %>% + mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)), + by = c("storm_basin", "storm_year", "storm_name")) %>% + select( + hurdatId, storm_basin, storm_name, storm_year + ) + + result <- query %>% collect() + + return(result) +} + + + + + + + + + + + + + + +