mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
update normalized cost data loading
This commit is contained in:
+58
-30
@@ -11,6 +11,10 @@ output:
|
|||||||
---
|
---
|
||||||
|
|
||||||
```{r setup, include=FALSE}
|
```{r setup, include=FALSE}
|
||||||
|
# TODO:
|
||||||
|
# - update normalization to new 2024 data
|
||||||
|
# -
|
||||||
|
|
||||||
library(flexdashboard)
|
library(flexdashboard)
|
||||||
library(shiny)
|
library(shiny)
|
||||||
library(leaflet)
|
library(leaflet)
|
||||||
@@ -169,35 +173,6 @@ storm_selection <- reactiveValues(
|
|||||||
|
|
||||||
######
|
######
|
||||||
|
|
||||||
###### SUPABASE PORT
|
|
||||||
econ.normalized_landfalls <- dbGetQuery(con, "SELECT * FROM econ.normalized_landfalls")
|
|
||||||
|
|
||||||
econ.storm_base_loss <- reactive({
|
|
||||||
req(storm_selection$is_selected)
|
|
||||||
|
|
||||||
query <- paste0("
|
|
||||||
SELECT DISTINCT ON (storm_basin, storm_year, storm_name, lf_type, lf_id)
|
|
||||||
storm_basin,
|
|
||||||
storm_year,
|
|
||||||
storm_name,
|
|
||||||
lf_type,
|
|
||||||
lf_id,
|
|
||||||
base_loss_source,
|
|
||||||
base_loss
|
|
||||||
FROM econ.storm_base_loss
|
|
||||||
WHERE base_loss IS NOT NULL
|
|
||||||
ORDER BY
|
|
||||||
storm_basin, storm_year, storm_name, lf_type, lf_id,
|
|
||||||
CASE
|
|
||||||
WHEN base_loss_source LIKE '%ncei%' THEN 1
|
|
||||||
WHEN base_loss_source LIKE '%mwr%' THEN 2
|
|
||||||
ELSE 3
|
|
||||||
END
|
|
||||||
")
|
|
||||||
|
|
||||||
dbGetQuery(con, query)
|
|
||||||
})
|
|
||||||
|
|
||||||
# LAZY LOAD DB TABLES
|
# LAZY LOAD DB TABLES
|
||||||
|
|
||||||
econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls"))
|
econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls"))
|
||||||
@@ -219,6 +194,58 @@ metrics.geo_attributes <- tbl(con, I("metrics.geo_attributes"))
|
|||||||
#metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing"))
|
#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"))
|
||||||
|
|
||||||
|
### COMMONLY USED DATA
|
||||||
|
|
||||||
|
base_losses_by_lf <- econ.storm_base_loss %>%
|
||||||
|
filter(!is.na(base_loss)) %>%
|
||||||
|
mutate(
|
||||||
|
ncei_priority = case_when(
|
||||||
|
str_like(base_loss_source, "%ncei%") ~ 1,
|
||||||
|
str_like(base_loss_source, "%ncei%") ~ 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() %>%
|
||||||
|
collect()
|
||||||
|
|
||||||
|
total_base_losses <- base_losses_by_lf %>%
|
||||||
|
group_by(storm_basin, storm_year, storm_name) %>%
|
||||||
|
summarize(
|
||||||
|
total_base_loss = sum(base_loss),
|
||||||
|
.groups = "drop"
|
||||||
|
) %>%
|
||||||
|
collect()
|
||||||
|
|
||||||
|
normalized_losses_2024 <- econ.normalized_landfalls %>%
|
||||||
|
filter(normalization_year == 2024) %>%
|
||||||
|
left_join(econ.storm_base_loss %>%
|
||||||
|
filter(!is.na(base_loss)) %>%
|
||||||
|
mutate(
|
||||||
|
ncei_priority = case_when(
|
||||||
|
str_like(base_loss_source, "%ncei%") ~ 1,
|
||||||
|
str_like(base_loss_source, "%ncei%") ~ 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_lf = (base_loss * gdp_deflator * rwhu * affected_housing),
|
||||||
|
mmp_lf = (base_loss * gdp_deflator * rwpc * affected_population)
|
||||||
|
) %>%
|
||||||
|
group_by(storm_basin, storm_year, storm_name) %>%
|
||||||
|
summarize(
|
||||||
|
mmh = sum(mmh_lf, na.rm = T),
|
||||||
|
mmp = sum(mmp_lf, na.rm = T),
|
||||||
|
.groups = "drop"
|
||||||
|
) %>%
|
||||||
|
filter(!is.na(mmh) & !is.na(mmp)) %>%
|
||||||
|
collect()
|
||||||
```
|
```
|
||||||
|
|
||||||
```{r}
|
```{r}
|
||||||
@@ -424,7 +451,7 @@ observeEvent(input$selectStorm, {
|
|||||||
```{r}
|
```{r}
|
||||||
output$allStorms <- renderDT({
|
output$allStorms <- renderDT({
|
||||||
datatable(
|
datatable(
|
||||||
normalized2024,
|
normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp),
|
||||||
rownames = F,
|
rownames = F,
|
||||||
options = list(
|
options = list(
|
||||||
pageLength = 1000,
|
pageLength = 1000,
|
||||||
@@ -873,6 +900,7 @@ Top 50 Storms
|
|||||||
#DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline?
|
#DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline?
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
```
|
```
|
||||||
|
|
||||||
About
|
About
|
||||||
|
|||||||
Reference in New Issue
Block a user