From b341d9ad4509cfc3a16d4c943e50723a3f8a31fe Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Mon, 14 Jul 2025 16:29:20 -0400 Subject: [PATCH 1/4] add ui buttons for cost index chart --- dashboard.Rmd | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 5f71210..857f9e0 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -415,21 +415,15 @@ output$cost_index_chart <- renderDygraph({ # TODO: add button to select normalized costs #}) -fillCol( - flex = c(.2, .8), - fluidRow( - column(4, - selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL) +fluidRow( + style = "height: 100%", + column(3, + selectInput("storm_overview_cost_index_lf", "Landfall", choices = NULL), + radioGroupButtons("storm_overview_cost_index_value", label = "Value", choices = c("Index", "Loss"), status = "outline-primary rounded-0", justified = T) ), - column(4, - # TODO: add button to select normalized costs - #checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F) - ), - column(4, - #checkboxInput("mmpSelect", "Display MMP", value = T) + column(9, + dygraphOutput("cost_index_chart") ) - ), - dygraphOutput("cost_index_chart") ) ``` From 956729f77461c4bdf272c9bd2641ee0c65bf1a7e Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Mon, 14 Jul 2025 17:46:29 -0400 Subject: [PATCH 2/4] update select landfalls input for chart --- dashboard.Rmd | 38 ++++++++++++++++++++++++++++---------- 1 file changed, 28 insertions(+), 10 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 857f9e0..d5d17fb 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -291,10 +291,17 @@ observe({ unique_lfs <- get_unique_lf_ids(storm_selection) - updateSelectInput( - session, - "storm_overview_cost_index_lf", - choices = unique_lfs$full_lf_id, + #updateSelectInput( + # session, + # "storm_overview_cost_index_lf", + # choices = unique_lfs$full_lf_id, + # selected = unique_lfs$full_lf_id[1] + #) + + updateVirtualSelect( + session = session, + "storm_overview_cost_index_lf_select", + choices = prepare_choices(unique_lfs, full_lf_id, full_lf_id, lf_type), selected = unique_lfs$full_lf_id[1] ) @@ -392,7 +399,7 @@ DTOutput("track_data") Col {data-width=500} ------------------------------------ -### Normalization Cost Index {data-height=500} +### Normalization Cost Index {data-height=700} ```{r} output$cost_index_chart <- renderDygraph({ @@ -411,14 +418,25 @@ output$cost_index_chart <- renderDygraph({ dyRangeSelector(height = 30) }) -#observeEvent(input$storm_overview_select_base, { - # TODO: add button to select normalized costs -#}) +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), + #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"), + # "DIL" = c("DIL1", "DIL2", "DIL3", "DIL4"), + # "ID" = c("ID1", "ID2", "ID3", "ID4") + #), + choices = NULL, + 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) ), column(9, @@ -427,7 +445,7 @@ fluidRow( ) ``` -### Landfalls {data-height=500 .no-padding} +### Landfalls {data-height=300 .no-padding} ```{r} output$landfalls_table <- renderDT({ req(storm_selection$is_selected) From 8a0c3341dc621b005a673385624a390f24a6acbc Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Mon, 14 Jul 2025 20:56:36 -0400 Subject: [PATCH 3/4] update cost graph query --- dashboard.Rmd | 32 ++++++++++++++++++++++++++++++-- queries.R | 26 ++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 2 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index d5d17fb..c856821 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -401,8 +401,35 @@ Col {data-width=500} ### Normalization Cost Index {data-height=700} ```{r} - 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) cost_index <- get_normalized_cost_index(storm_selection, input$storm_overview_cost_index_lf) %>% @@ -437,7 +464,8 @@ 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_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, dygraphOutput("cost_index_chart") diff --git a/queries.R b/queries.R index c48e043..94f4b44 100644 --- a/queries.R +++ b/queries.R @@ -75,6 +75,12 @@ view.all_conus_landfalls <- tbl(con, "all_conus_landfalls") # lf_id = 1 #) +agnes <- list( + storm_basin = "AL", + storm_year = 1972, + storm_name = "AGNES" +) + # helper functions # 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) } +# 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 get_hurdat_landfalls <- function(storm) { query <- view.hurdat_track %>% From f9e6ce7a33cbf27b9be47ecc0f0e3746c0a560a8 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sat, 19 Jul 2025 16:21:19 -0400 Subject: [PATCH 4/4] 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()