mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
update time series cost index chart
This commit is contained in:
+114
-79
@@ -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)
|
||||
})
|
||||
|
||||
lfNormalized <- reactive({
|
||||
req(storm_selection$lf_id)
|
||||
|
||||
lf <- dbNormalizedLandfalls() %>%
|
||||
filter(lfid == storm_selection$lf_id) %>%
|
||||
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(
|
||||
mmh = gdp_deflator * rwhu * affected_housing,
|
||||
mmp = gdp_deflator * rwpc * affected_population,
|
||||
years = as.Date(paste0(normalization_year, "-01-01"))
|
||||
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(
|
||||
years, mmh, mmp
|
||||
-base_loss_source, -base_loss, -base_loss_citation, -doi, -notes, -ncei_priority
|
||||
) %>%
|
||||
collect()
|
||||
|
||||
cat(str(result))
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
storm_cost_index_ts <- reactive({
|
||||
req(storm_normalized_landfall())
|
||||
|
||||
cost_index <- storm_normalized_landfall() %>%
|
||||
select(
|
||||
normalization_year, mmh_index, mmp_index
|
||||
) %>%
|
||||
mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01")))
|
||||
|
||||
cost_index_ts <- cost_index %>%
|
||||
select(-normalization_year) %>%
|
||||
xts(order.by = cost_index$normalization_year)
|
||||
|
||||
cat(str(cost_index_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
|
||||
)
|
||||
})
|
||||
|
||||
lf_ts <- lf %>%
|
||||
select(-years) %>%
|
||||
xts(order.by = lf$years)
|
||||
output$costIndex <- renderDygraph({
|
||||
req(storm_cost_index_ts())
|
||||
|
||||
cat(storm_selection$lf_id)
|
||||
cat(str(lf_ts))
|
||||
|
||||
return(lf_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}
|
||||
|
||||
Reference in New Issue
Block a user