diff --git a/dashboard.Rmd b/dashboard.Rmd index af1bbe6..ead7131 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -267,38 +267,6 @@ storm_selection <- reactiveValues( ) ``` -```{r} -###### REACTIVE SETUP - -#REACTIVES USE LAZY LOADING - -#hurdat.best_track <- dbGetQuery(con, "SELECT *, ST_X(ST_Transform(location::geometry, 4326)) as lon, ST_Y(ST_Transform(location::geometry, 4326)) as lat FROM hurdat.best_track") - - -selected.best_track <- reactive({ - req(storm_selection$is_selected) - - query <- paste0(" - SELECT *, - ST_X(ST_Transform(location::geometry, 4326)) as lon, - ST_Y(ST_Transform(location::geometry, 4326)) as lat - FROM hurdat.best_track - 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(paste0("DEBUG: selected.best_track returned ", nrow(result))) - - return(result) -}) - - -``` - - Home ============================================= @@ -473,6 +441,13 @@ storm_overview_reactive <- reactiveValues( use_normalized_costs = FALSE ) +growth_trends <- reactiveValues( + lf_type = NULL, + lf_id = NULL, + full_lf_id = NULL +) + + ``` Col {data-width=500} @@ -601,6 +576,10 @@ observe({ 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] + + growth_trends$lf_type = storm_unique_landfalls()$lf_type[1] + growth_trends$lf_id = storm_unique_landfalls()$lf_id[1] + growth_trends$full_lf_id = storm_unique_landfalls()$full_lf_id[1] }) observe({ @@ -798,12 +777,6 @@ Column {data-width=550} ### {data-height=1000 .no-padding} ```{r} -growth_trends <- reactiveValues( - lf_id = NULL -) - - - dbStormCounties <- reactive({ req(storm_selection$is_selected) @@ -875,75 +848,111 @@ fillCol( Column {data-width=450} ---------------------------------- -### Landfall Selection {data-height=150} +### Landfall Selection {data-height=550} ```{r} +#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 +# ) +#}) +normalized_growth_metrics_lf_ts <- reactive ({ + req(growth_trends$full_lf_id) + + growth_metrics_lf_fips <- gis.affected_area_landfalls %>% + filter( + storm_basin == storm_selection$storm_basin, + storm_year == storm_selection$storm_year, + storm_name == storm_selection$storm_name, + lf_type == growth_trends$lf_type, + lf_id == growth_trends$lf_id + ) %>% + mutate( + full_lf_id = paste0(state_fips, county_fips) + ) %>% + collect() -fluidRow( - column(4, - selectInput("growthTrendLfSelect", "Landfall", choices = NULL) - ), - column(4, - - ), - column(4, - + growth_metrics_lf <- metrics.pop_and_housing %>% + mutate( + full_lf_id = paste0(state_fips, county_fips) + ) %>% + filter( + full_lf_id %in% growth_metrics_lf_fips$full_lf_id, + year >= storm_selection$storm_year + ) %>% + group_by( + year + ) %>% + summarize( + aggregate_population = sum(population, na.rm = T), + aggregate_housing_units = sum(housing_units, na.rm = T), + .groups = "drop" + ) %>% + collect() + + normalized_growth_metrics_lf <- growth_metrics_lf %>% + arrange( + year + ) %>% + mutate( + base_population = first(aggregate_population), + base_housing_units = first(aggregate_housing_units), + normalized_population = (aggregate_population / base_population), + normalized_housing_units = (aggregate_housing_units / base_housing_units), + year = as.Date(paste0(year, "-01-01")) + ) %>% + select( + year, normalized_population, normalized_housing_units + ) + + result <- normalized_growth_metrics_lf %>% + select(-year) %>% + xts(order.by = normalized_growth_metrics_lf$year) + + return(result) +}) + +observe({ + req(growth_trends$full_lf_id) + + updateSelectInput( + session, + "growth_trend_lf_select", + choices = storm_unique_landfalls()$full_lf_id, + selected = growth_trends$full_lf_id ) +}) + +observeEvent(input$growth_trend_lf_select, { + growth_trends$full_lf_id = input$growth_trend_lf_select +}) + +fillCol( + flex = c(.2, .8), + fluidRow( + column(6, + selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL) + ), + column(6, + # TODO: add button to select normalized costs + #checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F) + ) + ), + dygraphOutput("popHu") ) -observeEvent(input$growthTrendLfSelect, { - growth_trends$lf_id = input$growthTrendLfSelect - - showNotification("Landfall updated", type = "message") -}) -``` - -### Time Series {data-height=400 .no-padding} -```{r} - - -katrinaLfTwoLong <- katrinaLfTwoCountyMetrics %>% - pivot_longer( - cols = -c(fips, metric), - names_to = "year", - values_to = "value" - ) %>% - group_by( - metric, year - ) %>% - summarize( - aggregateValue = sum(value, na.rm = T), - .groups = "drop" - ) %>% - pivot_wider( - names_from = metric, - values_from = aggregateValue - ) - -normalizedKatrinaLfTwo <- xlallLandfallsNormalized %>% - filter(hurdatId == "AL122005" & lfId == "LF2") %>% - select(normalizationYear, affectedPop, affectedHousing) - -normalizedKatrinaLfTwoTs <- normalizedKatrinaLfTwo %>% - select(-normalizationYear) %>% - as.matrix() %>% - xts(order.by = as.Date(paste0(normalizedKatrinaLfTwo$normalizationYear, "-01-01"))) - -katrinaLfTwoLongTs <- katrinaLfTwoLong %>% - select(-year) %>% - as.matrix() %>% - xts(order.by = as.Date(paste0(katrinaLfTwoLong$year, "-01-01"))) - - output$popHu <- renderDygraph({ - dygraph(normalizedKatrinaLfTwoTs, main = "Normalized LF2 Aggregate Growth") %>% - dySeries("affectedPop", label = "Population") %>% - dySeries("affectedHousing", label = "Housing Units") %>% + dygraph(normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>% + dySeries("normalized_population", label = "Population") %>% + dySeries("normalized_housing_units", label = "Housing Units") %>% dyRangeSelector() }) - -#dygraphOutput("popHu") ``` ### County Data {data-height=450 .no-padding}