diff --git a/dashboard.Rmd b/dashboard.Rmd index 73a6b08..117c06c 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"] @@ -218,10 +219,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] ) @@ -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({ - req(storm_selection$is_selected, input$storm_overview_cost_index_lf) +storm_yearly_normalization <- reactive({ + req(storm_selection$is_selected) - 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 %>% - select(-normalization_year) %>% - xts(order.by = cost_index$normalization_year) + result <- get_all_normalized_cost_index(storm_selection) - dygraph(cost_index_ts, main = "Cost Index") %>% - dySeries("mmh", label = "MMH24") %>% - dySeries("mmp", label = "MMP24") %>% - dyRangeSelector(height = 30) + return(result) }) -fillCol( - flex = c(.2, .8), - fluidRow( - column(4, - selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL) +output$cost_index_chart <- renderDygraph({ + req(storm_yearly_normalization, + input$storm_overview_cost_index_lf_select, + input$storm_overview_cost_index_mmh_mmp, + input$storm_overview_cost_index_scale) + + 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(4, - - ), - column(4, - + 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 diff --git a/queries.R b/queries.R index 4fac158..80ac64e 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 # 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 @@ -359,4 +384,4 @@ get_normalized_metric_growth <- function(storm, full_lf_id) { result <- query %>% collect() return(result) -} \ No newline at end of file +}