add normalization graph filter functionality

2026-07-30 05:08:57 +00:00 · 2025-07-19 16:21:19 -04:00
parent 8a0c3341dc
commit f9e6ce7a33
2 changed files with 57 additions and 38 deletions
@@ -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,
@@ -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()