dylan/hurricane_normalization_app
1
0
Fork 0
mirror of https://github.com/dylanbenzi/hurricane_normalization_app.git synced 2026-07-29 21:01:27 +00:00
Code Issues Packages Projects Releases Wiki Activity

update time series cost index chart

Browse Source
This commit is contained in:
dylan
2025-06-04 16:16:19 -04:00
parent 669a8c7ad4
commit f86221b0f6
1 changed files with 113 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dashboard.Rmd
+113 -78
View File
@@ -471,78 +471,150 @@ DTOutput("allStorms")
Storm Overview {data-navmenu="Storm Details"}
====================================
```{r}
### REACTIVE VALUES FOR STORM OVERVIEW
storm_overview_reactive <- reactiveValues(
lf_type = NULL,
lf_id = NULL,
full_lf_id = NULL,
)
```
Col {data-width=500}
------------------------------------
### Storm Details {data-height=200}
```{r}
# TODO: add storm details section: name, base loss, base loss source, etc.
HTML('
<h6>Katrina</h6>
<p>Hurricane Katrina was a powerful, devestating and historic tropical cyclone that caused 1,392 fatalities and damages estimated at $125 billion in late August 2005.</p>
')
```
### Normalization Cost Index {data-height=800}
```{r}
##BY LANDFALL###
##MULTIPLE LINES###
dbNormalizedLandfalls <- reactive({
storm_unique_landfalls <- reactive({
req(storm_selection$is_selected)
query <- paste0("
SELECT *, CONCAT(lf_type, lf_id) as lfid FROM econ.normalized_landfalls
WHERE storm_basin = '", storm_selection$storm_basin,
"' AND storm_year = ", storm_selection$storm_year,
" AND storm_name = '", storm_selection$storm_name,
"'")
result <- dbGetQuery(con, query)
#cat(str(result))
showNotification(nrow(result))
result <- econ.storm_base_loss %>%
filter(
storm_basin == storm_selection$storm_basin,
storm_year == storm_selection$storm_year,
storm_name == storm_selection$storm_name
) %>%
mutate(
full_lf_id = paste0(lf_type, lf_id)
) %>%
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
) %>%
collect()
return(result)
})
dbUniq <- reactive({
req(dbNormalizedLandfalls(), nrow(dbNormalizedLandfalls()) > 0)
storm_normalized_landfall <- reactive({
req(storm_overview_reactive$full_lf_id)
dbNormalizedLandfalls() %>%
distinct(lfid)
result <- econ.normalized_landfalls %>%
filter(
storm_basin == storm_selection$storm_basin,
storm_year == storm_selection$storm_year,
storm_name == storm_selection$storm_name,
lf_type == storm_overview_reactive$lf_type,
lf_id == storm_overview_reactive$lf_id
) %>%
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_index = (gdp_deflator * rwhu * affected_housing),
mmp_index = (gdp_deflator * rwpc * affected_population),
mmh = (base_loss * mmh_index),
mmp = (base_loss * mmp_index)
) %>%
select(
-base_loss_source, -base_loss, -base_loss_citation, -doi, -notes, -ncei_priority
) %>%
collect()
cat(str(result))
return(result)
})
lfNormalized <- reactive({
req(storm_selection$lf_id)
storm_cost_index_ts <- reactive({
req(storm_normalized_landfall())
lf <- dbNormalizedLandfalls() %>%
filter(lfid == storm_selection$lf_id) %>%
mutate(
mmh = gdp_deflator * rwhu * affected_housing,
mmp = gdp_deflator * rwpc * affected_population,
years = as.Date(paste0(normalization_year, "-01-01"))
) %>%
cost_index <- storm_normalized_landfall() %>%
select(
years, mmh, mmp
)
normalization_year, mmh_index, mmp_index
) %>%
mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01")))
lf_ts <- lf %>%
select(-years) %>%
xts(order.by = lf$years)
cost_index_ts <- cost_index %>%
select(-normalization_year) %>%
xts(order.by = cost_index$normalization_year)
cat(storm_selection$lf_id)
cat(str(lf_ts))
cat(str(cost_index_ts))
return(lf_ts)
result <- cost_index_ts
return(result)
})
observe({
req(storm_unique_landfalls())
storm_overview_reactive$lf_type = storm_unique_landfalls()$lf_type[1]
storm_overview_reactive$lf_id = storm_unique_landfalls()$lf_id[1]
storm_overview_reactive$full_lf_id = storm_unique_landfalls()$full_lf_id[1]
})
observe({
req(storm_overview_reactive$full_lf_id)
updateSelectInput(
session,
"storm_overview_cost_index_lf",
choices = storm_unique_landfalls()$full_lf_id,
selected = storm_overview_reactive$full_lf_id
)
})
output$costIndex <- renderDygraph({
req(storm_cost_index_ts())
dygraph(storm_cost_index_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>%
dySeries("mmh_index", label = "MMH") %>%
dySeries("mmp_index", label = "MMP") %>%
dyRangeSelector(height = 30)
})
fillCol(
flex = c(.2, .8),
fluidRow(
column(4,
selectInput("lfSelect", "Landfall Select", choices = NULL)
selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL)
),
column(4,
#checkboxInput("mmhSelect", "Display MMH", value = T)
@@ -553,43 +625,6 @@ fillCol(
),
dygraphOutput("costIndex")
)
observe({
req(dbUniq(), nrow(dbUniq()) > 0)
updateSelectInput(
session,
"lfSelect",
choices = dbUniq()$lfid,
selected = dbUniq()$lfid[1]
)
updateSelectInput(
session,
"growthTrendLfSelect",
choices = dbUniq()$lfid,
selected = dbUniq()$lfid[1]
)
storm_selection$lf_id = dbUniq()$lfid[1]
})
observeEvent(input$lfSelect, {
storm_selection$lf_id = input$lfSelect
showNotification("Landfall updated", type = "message")
})
output$costIndex <- renderDygraph({
req(lfNormalized())
dygraph(lfNormalized(), main = "Cost Index") %>%
dySeries("mmh", label = "MMH") %>%
dySeries("mmp", label = "MMP") %>%
dyRangeSelector(height = 30)
})
```
Col {data-width=500}