mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-29 21:01:27 +00:00
add queries.R to move query functions to separate file
This commit is contained in:
+179
-78
@@ -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()
|
||||
|
||||
@@ -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)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user