resolve merge conflict storm_details master

dashboard.Rmd

@@ -41,6 +41,7 @@ library(caret)
 library(scales)
 library(billboarder)
 library(shinyWidgets)
+library(paletteer)
 
 # local testing env setup
 os <- Sys.info()["sysname"]
@@ -218,10 +219,17 @@ observe({
   
   unique_lfs <- get_unique_lf_ids(storm_selection)
   
-  updateSelectInput(
+  #updateSelectInput(
-    session,
+  #  session,
-    "storm_overview_cost_index_lf", 
+  #  "storm_overview_cost_index_lf", 
-    choices = unique_lfs$full_lf_id,
+  #  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]
   )
   
@@ -322,45 +330,101 @@ DTOutput("track_data")
 Col {data-width=500}
 ------------------------------------
 
-### Normalization Cost Index {data-height=500}
+### Normalization Cost Index {data-height=700}
 ```{r}
 # Overview - Normalization Chart
-# TODO: chart controls and filter
 
-output$cost_index_chart <- renderDygraph({
+storm_yearly_normalization <- reactive({
-  req(storm_selection$is_selected, input$storm_overview_cost_index_lf)
+  req(storm_selection$is_selected)
   
-  cost_index <- get_normalized_cost_index(storm_selection, input$storm_overview_cost_index_lf) %>% 
+  result <- get_all_normalized_cost_index(storm_selection)
-    mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01")))
   
-  cost_index_ts <- cost_index %>% 
+  return(result)
-    select(-normalization_year) %>% 
-    xts(order.by = cost_index$normalization_year)
-  
-  dygraph(cost_index_ts, main = "Cost Index") %>% 
-      dySeries("mmh", label = "MMH24") %>% 
-      dySeries("mmp", label = "MMP24") %>% 
-      dyRangeSelector(height = 30)
 })
 
-fillCol(
+output$cost_index_chart <- renderDygraph({
-  flex = c(.2, .8),
+  req(storm_yearly_normalization,
-  fluidRow(
+      input$storm_overview_cost_index_lf_select,
-    column(4,
+      input$storm_overview_cost_index_mmh_mmp,
-           selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL)
+      input$storm_overview_cost_index_scale)
-    ),
-    column(4,
-           
-    ),
-    column(4,
   
+  normalized_data <- storm_yearly_normalization() %>% 
+    rename(
+      "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 = all_of(value_columns),
+      names_glue = "{full_lf_id} {.value}"
+    )
+  
+  normalization_index_ts <- normalization_index %>% 
+    select(-normalization_year) %>% 
+    xts(order.by = normalization_index$normalization_year)
+  
+  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()
+})
+
+fluidRow(
+    style = "height: 100%",
+    column(3,
+           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_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,
+           dygraphOutput("cost_index_chart")
     )
-  ),
-  dygraphOutput("cost_index_chart")
 )
 ```
 
-### Landfalls {data-height=500 .no-padding}
+### Landfalls {data-height=300 .no-padding}
 ```{r}
 # Overview - Landfalls Table
 

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
 
 # disconnect db connection
@@ -197,6 +203,25 @@ ORDER BY year;")
     xts(order.by = result$year)
 
   return(result_ts)
+  
+# 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_loss = mmh, mmp_loss = mmp, full_lf_id
+    )
+  
+  result <- query %>% collect()
+  
+  return(result)
 }
 
 # returns landfalls and data at landfall from HURDAT