From f86221b0f6558ab4b8062e47a4979aff078a4563 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Wed, 4 Jun 2025 16:16:19 -0400 Subject: [PATCH] update time series cost index chart --- dashboard.Rmd | 191 +++++++++++++++++++++++++++++--------------------- 1 file changed, 113 insertions(+), 78 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 2aba272..a63e7e1 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -471,78 +471,150 @@ DTOutput("allStorms") Storm Overview {data-navmenu="Storm Details"} ==================================== +```{r} +### REACTIVE VALUES FOR STORM OVERVIEW + +storm_overview_reactive <- reactiveValues( + lf_type = NULL, + lf_id = NULL, + full_lf_id = NULL, +) + +``` + Col {data-width=500} ------------------------------------ ### Storm Details {data-height=200} ```{r} +# TODO: add storm details section: name, base loss, base loss source, etc. HTML(' -
Katrina
-

Hurricane Katrina was a powerful, devestating and historic tropical cyclone that caused 1,392 fatalities and damages estimated at $125 billion in late August 2005.

+ ') ``` ### Normalization Cost Index {data-height=800} ```{r} - -##BY LANDFALL### -##MULTIPLE LINES### - -dbNormalizedLandfalls <- reactive({ +storm_unique_landfalls <- reactive({ req(storm_selection$is_selected) - query <- paste0(" - SELECT *, CONCAT(lf_type, lf_id) as lfid FROM econ.normalized_landfalls - WHERE storm_basin = '", storm_selection$storm_basin, - "' AND storm_year = ", storm_selection$storm_year, - " AND storm_name = '", storm_selection$storm_name, - "'") - - result <- dbGetQuery(con, query) - - #cat(str(result)) - - showNotification(nrow(result)) + result <- econ.storm_base_loss %>% + filter( + storm_basin == storm_selection$storm_basin, + storm_year == storm_selection$storm_year, + storm_name == storm_selection$storm_name + ) %>% + mutate( + full_lf_id = paste0(lf_type, lf_id) + ) %>% + distinct( + full_lf_id, + .keep_all = T + ) %>% + arrange( + full_lf_id + ) %>% + select( + storm_basin, storm_year, storm_name, lf_type, lf_id, full_lf_id + ) %>% + collect() return(result) }) -dbUniq <- reactive({ - req(dbNormalizedLandfalls(), nrow(dbNormalizedLandfalls()) > 0) +storm_normalized_landfall <- reactive({ + req(storm_overview_reactive$full_lf_id) - dbNormalizedLandfalls() %>% - distinct(lfid) + result <- econ.normalized_landfalls %>% + filter( + storm_basin == storm_selection$storm_basin, + storm_year == storm_selection$storm_year, + storm_name == storm_selection$storm_name, + lf_type == storm_overview_reactive$lf_type, + lf_id == storm_overview_reactive$lf_id + ) %>% + left_join(econ.storm_base_loss %>% + filter(!is.na(base_loss)) %>% + mutate( + ncei_priority = case_when( + str_like(base_loss_source, "%ncei%") ~ 1, + str_like(base_loss_source, "%ncei%") ~ 2, + TRUE ~ 3 + ) + ) %>% + group_by(storm_basin, storm_year, storm_name, lf_type, lf_id) %>% + slice_min(ncei_priority, n = 1, with_ties = F) %>% + ungroup(), + by = c("storm_basin", "storm_year", "storm_name", "lf_type", "lf_id")) %>% + mutate( + mmh_index = (gdp_deflator * rwhu * affected_housing), + mmp_index = (gdp_deflator * rwpc * affected_population), + mmh = (base_loss * mmh_index), + mmp = (base_loss * mmp_index) + ) %>% + select( + -base_loss_source, -base_loss, -base_loss_citation, -doi, -notes, -ncei_priority + ) %>% + collect() + + cat(str(result)) + + return(result) }) -lfNormalized <- reactive({ - req(storm_selection$lf_id) +storm_cost_index_ts <- reactive({ + req(storm_normalized_landfall()) - lf <- dbNormalizedLandfalls() %>% - filter(lfid == storm_selection$lf_id) %>% - mutate( - mmh = gdp_deflator * rwhu * affected_housing, - mmp = gdp_deflator * rwpc * affected_population, - years = as.Date(paste0(normalization_year, "-01-01")) - ) %>% + cost_index <- storm_normalized_landfall() %>% select( - years, mmh, mmp - ) + normalization_year, mmh_index, mmp_index + ) %>% + mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01"))) - lf_ts <- lf %>% - select(-years) %>% - xts(order.by = lf$years) + cost_index_ts <- cost_index %>% + select(-normalization_year) %>% + xts(order.by = cost_index$normalization_year) - cat(storm_selection$lf_id) - cat(str(lf_ts)) + cat(str(cost_index_ts)) - return(lf_ts) + result <- cost_index_ts + + return(result) +}) + +observe({ + req(storm_unique_landfalls()) + + storm_overview_reactive$lf_type = storm_unique_landfalls()$lf_type[1] + storm_overview_reactive$lf_id = storm_unique_landfalls()$lf_id[1] + storm_overview_reactive$full_lf_id = storm_unique_landfalls()$full_lf_id[1] +}) + +observe({ + req(storm_overview_reactive$full_lf_id) + + updateSelectInput( + session, + "storm_overview_cost_index_lf", + choices = storm_unique_landfalls()$full_lf_id, + selected = storm_overview_reactive$full_lf_id + ) +}) + +output$costIndex <- renderDygraph({ + req(storm_cost_index_ts()) + + dygraph(storm_cost_index_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>% + dySeries("mmh_index", label = "MMH") %>% + dySeries("mmp_index", label = "MMP") %>% + dyRangeSelector(height = 30) }) fillCol( flex = c(.2, .8), fluidRow( column(4, - selectInput("lfSelect", "Landfall Select", choices = NULL) + selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL) ), column(4, #checkboxInput("mmhSelect", "Display MMH", value = T) @@ -553,43 +625,6 @@ fillCol( ), dygraphOutput("costIndex") ) - - -observe({ - req(dbUniq(), nrow(dbUniq()) > 0) - - updateSelectInput( - session, - "lfSelect", - choices = dbUniq()$lfid, - selected = dbUniq()$lfid[1] - ) - - updateSelectInput( - session, - "growthTrendLfSelect", - choices = dbUniq()$lfid, - selected = dbUniq()$lfid[1] - ) - - storm_selection$lf_id = dbUniq()$lfid[1] -}) - -observeEvent(input$lfSelect, { - storm_selection$lf_id = input$lfSelect - - showNotification("Landfall updated", type = "message") -}) - -output$costIndex <- renderDygraph({ - req(lfNormalized()) - - dygraph(lfNormalized(), main = "Cost Index") %>% - dySeries("mmh", label = "MMH") %>% - dySeries("mmp", label = "MMP") %>% - dyRangeSelector(height = 30) -}) - ``` Col {data-width=500}