From f9e6ce7a33cbf27b9be47ecc0f0e3746c0a560a8 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sat, 19 Jul 2025 16:21:19 -0400 Subject: [PATCH] add normalization graph filter functionality --- dashboard.Rmd | 93 +++++++++++++++++++++++++++++++-------------------- queries.R | 2 +- 2 files changed, 57 insertions(+), 38 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index c856821..97d8495 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -41,6 +41,7 @@ library(caret) library(scales) library(billboarder) library(shinyWidgets) +library(paletteer) # local testing env setup os <- Sys.info()["sysname"] @@ -401,59 +402,77 @@ Col {data-width=500} ### Normalization Cost Index {data-height=700} ```{r} +storm_yearly_normalization <- reactive({ + req(storm_selection$is_selected) + + result <- get_all_normalized_cost_index(storm_selection) + + return(result) +}) + output$cost_index_chart <- renderDygraph({ - req(storm_selection$is_selected, input$storm_overview_cost_index_lf_select, input$storm_overview_cost_index_mmh_mmp) + req(storm_yearly_normalization, + input$storm_overview_cost_index_lf_select, + input$storm_overview_cost_index_mmh_mmp, + input$storm_overview_cost_index_scale) - 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) %>% + normalized_data <- storm_yearly_normalization() %>% rename( - hindex = mmh_index, - pindex = mmp_index, + "MMH Index" = mmh_index, + "MMH Loss" = mmh_loss, + "MMP Index" = mmp_index, + "MMP Loss" = mmp_loss + ) + + selected_lf <- input$storm_overview_cost_index_lf_select + selected_normalization <- input$storm_overview_cost_index_mmh_mmp + selected_scale <- input$storm_overview_cost_index_scale + + method_map <- c("MMH", "MMP") + selected_methods <- method_map[method_map %in% selected_normalization] + + if (selected_scale == "Index") { + value_columns <- paste0(selected_methods, " Index") + } else if (selected_scale == "Loss") { + value_columns <- paste0(selected_methods, " Loss") + } + + normalization_index <- normalized_data %>% + filter( + full_lf_id %in% selected_lf ) %>% mutate( normalization_year = as.Date(paste0(normalization_year, "-01-01")) ) %>% + select( + normalization_year, + full_lf_id, + all_of(value_columns) + ) %>% pivot_wider( names_from = full_lf_id, - values_from = c(hindex, pindex, mmh, mmp), - names_glue = "{full_lf_id}_{.value}" - ) %>% - arrange(normalization_year) + values_from = all_of(value_columns), + names_glue = "{full_lf_id} {.value}" + ) - # TODO: add filtering - -}) - - -output$cost_index_chart_old <- renderDygraph({ - 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) %>% - mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01"))) - - cost_index_ts <- cost_index %>% + normalization_index_ts <- normalization_index %>% select(-normalization_year) %>% - xts(order.by = cost_index$normalization_year) + xts(order.by = normalization_index$normalization_year) - dygraph(cost_index_ts, main = "Cost Index") %>% - dySeries("mmh", label = "MMH24") %>% - dySeries("mmp", label = "MMP24") %>% - dyRangeSelector(height = 30) + dygraph(normalization_index_ts) %>% + dyOptions( + colors = paletteer_d("ggthemes::Classic_Purple_Gray_12", ncol(normalization_index - 1)), + fillGraph = T, + fillAlpha = .2, + + ) %>% + dyAxis("x", drawGrid = F) %>% + dyRangeSelector() }) -df <- data.frame(lf_type = c("LF", "LF", "LF", "DIL", "DIL", "DIL", "DIL", "ID", "ID", "ID", "ID"), lf_id = c("1", "2", "3", "1", "2", "3", "4", "1", "2", "3", "4")) - -df_tree <- create_tree(df, levels = names(df)) - fluidRow( style = "height: 100%", column(3, - #selectInput("storm_overview_cost_index_lf", "Landfall", choices = NULL), - #treeInput("storm_overview_cost_index_lf_tree", "Landfalls", choices = df_tree, returnValue = "text") virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls", #choices = list( # "LF" = c("LF1", "LF2", "LF3"), @@ -464,7 +483,7 @@ fluidRow( showValueAsTags = T, multiple = 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_scale", 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, diff --git a/queries.R b/queries.R index 94f4b44..ec2def7 100644 --- a/queries.R +++ b/queries.R @@ -168,7 +168,7 @@ get_all_normalized_cost_index <- function(storm) { full_lf_id = paste0(lf_type, lf_id) ) %>% select( - normalization_year, mmh_index, mmp_index, mmh, mmp, full_lf_id + normalization_year, mmh_index, mmp_index, mmh_loss = mmh, mmp_loss = mmp, full_lf_id ) result <- query %>% collect()