mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
update cost graph query
This commit is contained in:
+30
-2
@@ -401,8 +401,35 @@ Col {data-width=500}
|
|||||||
|
|
||||||
### Normalization Cost Index {data-height=700}
|
### Normalization Cost Index {data-height=700}
|
||||||
```{r}
|
```{r}
|
||||||
|
|
||||||
output$cost_index_chart <- renderDygraph({
|
output$cost_index_chart <- renderDygraph({
|
||||||
|
req(storm_selection$is_selected, input$storm_overview_cost_index_lf_select, input$storm_overview_cost_index_mmh_mmp)
|
||||||
|
|
||||||
|
selected_lfs <- input$storm_overview_cost_index_lf_select
|
||||||
|
loss_type <- input$storm_overview_cost_index_mmh_mmp
|
||||||
|
|
||||||
|
display_columns <- c("normalization_year")
|
||||||
|
|
||||||
|
normalizations <- get_normalized_cost_index(storm_selection) %>%
|
||||||
|
rename(
|
||||||
|
hindex = mmh_index,
|
||||||
|
pindex = mmp_index,
|
||||||
|
) %>%
|
||||||
|
mutate(
|
||||||
|
normalization_year = as.Date(paste0(normalization_year, "-01-01"))
|
||||||
|
) %>%
|
||||||
|
pivot_wider(
|
||||||
|
names_from = full_lf_id,
|
||||||
|
values_from = c(hindex, pindex, mmh, mmp),
|
||||||
|
names_glue = "{full_lf_id}_{.value}"
|
||||||
|
) %>%
|
||||||
|
arrange(normalization_year)
|
||||||
|
|
||||||
|
# TODO: add filtering
|
||||||
|
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
output$cost_index_chart_old <- renderDygraph({
|
||||||
req(storm_selection$is_selected, input$storm_overview_cost_index_lf)
|
req(storm_selection$is_selected, input$storm_overview_cost_index_lf)
|
||||||
|
|
||||||
cost_index <- get_normalized_cost_index(storm_selection, input$storm_overview_cost_index_lf) %>%
|
cost_index <- get_normalized_cost_index(storm_selection, input$storm_overview_cost_index_lf) %>%
|
||||||
@@ -437,7 +464,8 @@ fluidRow(
|
|||||||
showValueAsTags = T,
|
showValueAsTags = T,
|
||||||
multiple = T,
|
multiple = T,
|
||||||
autoSelectFirstOption = T),
|
autoSelectFirstOption = T),
|
||||||
radioGroupButtons("storm_overview_cost_index_value", label = "Value", choices = c("Index", "Loss"), status = "outline-primary rounded-0", justified = T)
|
radioGroupButtons("storm_overview_cost_index_value", label = "Value", choices = c("Index", "Loss"), status = "outline-primary rounded-0", justified = T),
|
||||||
|
checkboxGroupButtons("storm_overview_cost_index_mmh_mmp", label = "MMH/MMP", choices = c("MMH", "MMP"), selected = c("MMH", "MMP"), status = "outline-primary rounded-0", justified = T)
|
||||||
),
|
),
|
||||||
column(9,
|
column(9,
|
||||||
dygraphOutput("cost_index_chart")
|
dygraphOutput("cost_index_chart")
|
||||||
|
|||||||
@@ -75,6 +75,12 @@ view.all_conus_landfalls <- tbl(con, "all_conus_landfalls")
|
|||||||
# lf_id = 1
|
# lf_id = 1
|
||||||
#)
|
#)
|
||||||
|
|
||||||
|
agnes <- list(
|
||||||
|
storm_basin = "AL",
|
||||||
|
storm_year = 1972,
|
||||||
|
storm_name = "AGNES"
|
||||||
|
)
|
||||||
|
|
||||||
# helper functions
|
# helper functions
|
||||||
|
|
||||||
# splits full_lf_id into lf_type and lf_id
|
# splits full_lf_id into lf_type and lf_id
|
||||||
@@ -150,6 +156,26 @@ get_normalized_cost_index <- function(storm, full_lf_id) {
|
|||||||
return(result)
|
return(result)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# returns normalized mmh/mmp indexes and costs over time by storm
|
||||||
|
get_all_normalized_cost_index <- function(storm) {
|
||||||
|
query <- view.yearly_normalized_losses %>%
|
||||||
|
filter(
|
||||||
|
storm_basin == storm$storm_basin,
|
||||||
|
storm_year == storm$storm_year,
|
||||||
|
storm_name == storm$storm_name
|
||||||
|
) %>%
|
||||||
|
mutate(
|
||||||
|
full_lf_id = paste0(lf_type, lf_id)
|
||||||
|
) %>%
|
||||||
|
select(
|
||||||
|
normalization_year, mmh_index, mmp_index, mmh, mmp, full_lf_id
|
||||||
|
)
|
||||||
|
|
||||||
|
result <- query %>% collect()
|
||||||
|
|
||||||
|
return(result)
|
||||||
|
}
|
||||||
|
|
||||||
# returns landfalls and data at landfall from HURDAT
|
# returns landfalls and data at landfall from HURDAT
|
||||||
get_hurdat_landfalls <- function(storm) {
|
get_hurdat_landfalls <- function(storm) {
|
||||||
query <- view.hurdat_track %>%
|
query <- view.hurdat_track %>%
|
||||||
|
|||||||
Reference in New Issue
Block a user