update normalized cost data loading

This commit is contained in:
2025-06-04 14:58:37 -04:00
parent 13e5782fe6
commit 6f7376c693
+58 -30
View File
@@ -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