From 2e5bf0eebbdf16f7a64336584c80cb45b16240a7 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Tue, 10 Jun 2025 12:51:06 -0400 Subject: [PATCH] update db calls --- dashboard.Rmd | 777 +++++++---------------------------------- hurricane_app/server.R | 28 -- hurricane_app/ui.R | 33 -- queries.R | 264 ++++++++++++++ utils.R | 0 5 files changed, 394 insertions(+), 708 deletions(-) delete mode 100644 hurricane_app/server.R delete mode 100644 hurricane_app/ui.R create mode 100644 utils.R diff --git a/dashboard.Rmd b/dashboard.Rmd index f6b6136..5fa7e89 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -37,6 +37,8 @@ library(sf) library(shinyBS) library(xts) library(tigris) +library(caret) +library(scales) linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/" macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" @@ -57,120 +59,7 @@ con <- dbConnect( password = config$db_password ) -selected_storm_name <- "KATRINA" -selected_storm_year <- 2005 -selected_storm_basin <- "AL" -selected_lf_type = "LF" -selected_lf_id = "2" - -xlallLandfallsNormalized <- read.csv(paste0(baseDir, "R/dataScripts/restructured/normalization/all-landfalls-normalized.csv"), header = T) %>% - select(-X) - - - -normalized2024 <- read.csv(paste0(baseDir, "R/dataScripts/restructured/normalization/2024-normalized.csv"), header = T) %>% - select(-X, -hurdatId, -MMH23, -MMP23) %>% - filter(MMH24 > 0) %>% - mutate( - lf_date = trimws(lf_date) - ) - -normalized2024 <- normalized2024 %>% - mutate( - lf_date = mdy(lf_date) - ) %>% - rename( - Storm = storm_name, - Landfall = lf_date - ) - -pop <- read.csv(paste0(baseDir, "Data/population_with_projections.csv"), stringsAsFactors = F) %>% - pivot_longer( - cols = starts_with("X"), - names_to = "year", - values_to = "pop", - ) %>% - rename(population = pop) %>% - mutate( - year = parse_number(year), - FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS), - state_fips = substr(FIPS, 1, 2), - county_fips = substr(FIPS, 3, 5) - ) %>% - select(!full_county_and_state:County & !county_state & !FIPS) - -housing <- read.csv(paste0(baseDir, "Data/housing_units.csv"), stringsAsFactors = F) %>% - pivot_longer( - cols = starts_with("X"), - names_to = "year", - values_to = "housing" - ) %>% - mutate( - year = parse_number(year), - FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS), - state_fips = substr(FIPS, 1, 2), - county_fips = substr(FIPS, 3, 5) - ) %>% - rename(housing_units = housing) %>% - select(!County.Full:County & !County.State & !FIPS) - -metrics.pop_and_housing <- pop %>% - left_join(housing, by = c("state_fips", "county_fips", "year")) - -weightedCounties <- read.csv(paste0(baseDir, "R/dataScripts/weighted-counties.csv"), header = T) %>% - mutate( - weight = (PERCENTAGE/100), - FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS), - state_fips = substr(FIPS, 1, 2), - county_fips = substr(FIPS, 3, 5) - ) %>% - select( - state_fips, - county_fips, - hurdatId = HURDAT_Cod, - storm_name = Name_1, - lfId = LF_ID_Mull, - lf_date = LF_Date, - year = Year, - rmw = RMW, - lat = Lat, - lon = Long, - rmw_2x = RMW_x2, - area = AREA, - weight - ) - -katrinaAffectedCounties <- weightedCounties %>% - filter(hurdatId == "AL122005" & lfId == "LF2") %>% - mutate( - fips = paste0(state_fips, county_fips) - ) - -katrinaLfTwoCountyMetrics <- metrics.pop_and_housing %>% - filter(year >= 2005) %>% - pivot_longer( - cols = c("population", "housing_units"), - names_to = "metric", - values_to = "value" - ) %>% - pivot_wider( - names_from = year, - values_from = value, - ) %>% - mutate( - fips = paste0(state_fips, county_fips) - ) %>% - filter(fips %in% katrinaAffectedCounties$fips) %>% - select(fips, !state_fips & !county_fips) - -###### REACTIVE VALUES - - - -###### - -# LAZY LOAD DB TABLES - +# lazy load DB tables econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls")) econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss")) econ.usa_yearly <- tbl(con, I("econ.usa_yearly")) @@ -187,79 +76,14 @@ hurdat.best_track <- tbl(con, I("hurdat.best_track")) hurdat.hurdat_storms <- tbl(con, I("hurdat.hurdat_storms")) metrics.geo_attributes <- tbl(con, I("metrics.geo_attributes")) -#metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing")) +metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing")) public.counties <- tbl(con, I("public.counties")) -### COMMONLY USED DATA - -#loss_storms <- econ.storm_base_loss %>% -# select( -# storm_basin, storm_year, storm_name -# ) %>% -# distinct( -# storm_basin, storm_year, storm_name -# ) %>% -# left_join( -# hurdat.hurdat_storms %>% -# mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)), -# by = c("storm_basin", "storm_year", "storm_name")) %>% -# select( -# hurdatId, storm_basin, storm_name, storm_year -# ) %>% -# collect() - +# pull static data loss_storms <- get_all_loss_storms() -base_losses_by_lf <- 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() %>% - collect() - -total_base_losses <- base_losses_by_lf %>% - group_by(storm_basin, storm_year, storm_name) %>% - summarize( - total_base_loss = sum(base_loss), - .groups = "drop" - ) %>% - collect() - -normalized_losses_2024 <- econ.normalized_landfalls %>% - filter(normalization_year == 2024) %>% - 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_lf = (base_loss * gdp_deflator * rwhu * affected_housing), - mmp_lf = (base_loss * gdp_deflator * rwpc * affected_population) - ) %>% - group_by(storm_basin, storm_year, storm_name) %>% - summarize( - mmh = sum(mmh_lf, na.rm = T), - mmp = sum(mmp_lf, na.rm = T), - .groups = "drop" - ) %>% - filter(!is.na(mmh) & !is.na(mmp)) %>% - collect() +latest_normalized_losses <- get_latest_aggregate_losses() storm_selection <- reactiveValues( storm_year = NULL, @@ -269,6 +93,10 @@ storm_selection <- reactiveValues( is_selected = FALSE, is_table_selection = FALSE, ) + +onStop(function() { + dbDisconnect(con) +}) ``` Home @@ -370,20 +198,24 @@ Col {data-width=500} ### Storm Selector {data-height=500} ```{r} +#h5("Select a storm: ") +#h6("Use either the select inputs or the data table below") + fluidRow( - column(6, - selectInput("stormBasin", "Select Basin", choices = "AL"), - selectInput("stormYear", "Select Year", choices = loss_storms$storm_year), - selectInput("stormName", "Select Storm", choices = NULL), - actionButton("selectStorm", "Submit", class = "btn-primary") + column(4, + selectInput("stormBasin", "Select Basin", choices = "AL") ), - column(6, - #TODO: ADD TABLE - - #DTOutput("storm_selector_table") + column(4, + selectInput("stormYear", "Select Year", choices = loss_storms$storm_year) + ), + column(4, + selectInput("stormName", "Select Storm", choices = NULL) ) ) +actionButton("selectStorm", "Submit", class = "btn-primary") + + observeEvent(input$stormYear, { stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ] @@ -411,8 +243,9 @@ observeEvent(input$selectStorm, { ```{r} output$normalized_storms_table <- renderDT({ datatable( - normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp), + latest_normalized_losses, rownames = F, + colnames = c("Storm", "Year", "MMH24", "MMP24"), selection = "single", options = list( pageLength = 1000, @@ -424,7 +257,7 @@ output$normalized_storms_table <- renderDT({ server = T ) ) %>% - formatCurrency(c("MMH24", "MMP24"), "$", digits = 0) + formatCurrency(c("mmh", "mmp"), "$", digits = 0) }) DTOutput("normalized_storms_table") @@ -451,7 +284,25 @@ growth_trends <- reactiveValues( full_lf_id = NULL ) - +observe({ + req(storm_selection$is_selected) + + unique_lfs <- get_unique_lf_ids(storm_selection) + + updateSelectInput( + session, + "storm_overview_cost_index_lf", + choices = unique_lfs$full_lf_id, + selected = unique_lfs$full_lf_id[1] + ) + + updateSelectInput( + session, + "growth_trend_lf_select", + choices = unique_lfs$full_lf_id, + selected = unique_lfs$full_lf_id[1] + ) +}) ``` Col {data-width=500} @@ -467,156 +318,27 @@ HTML(' ### Normalization Cost Index {data-height=800} ```{r} -storm_unique_landfalls <- reactive({ - req(storm_selection$is_selected) - - 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) -}) -storm_normalized_landfall <- reactive({ - req(storm_overview_reactive$full_lf_id) - - 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) -}) -storm_cost_index_base_index_ts <- reactive({ - req(storm_normalized_landfall()) +output$cost_index_chart <- renderDygraph({ + req(storm_selection$is_selected, input$storm_overview_cost_index_lf) - cost_index <- storm_normalized_landfall() %>% - select( - normalization_year, mmh_index, mmp_index - ) %>% + 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) - cat(str(cost_index_ts)) - - result <- cost_index_ts - - return(result) + dygraph(cost_index_ts, main = "Cost Index") %>% + dySeries("mmh", label = "MMH24") %>% + dySeries("mmp", label = "MMP24") %>% + dyRangeSelector(height = 30) }) -storm_cost_index_normalized_costs_ts <- reactive({ - req(storm_normalized_landfall()) - - cost_index <- storm_normalized_landfall() %>% - select( - normalization_year, mmh, mmp - ) %>% - 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) - - cat(str(cost_index_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] - - 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({ - 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 - ) -}) - -observeEvent(input$storm_overview_select_base, { +#observeEvent(input$storm_overview_select_base, { # TODO: add button to select normalized costs -}) - -output$costIndex <- renderDygraph({ - req(storm_normalized_landfall()) - - if(storm_overview_reactive$use_normalized_costs == F) { - dygraph(storm_cost_index_base_index_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>% - dySeries("mmh_index", label = "MMH Index") %>% - dySeries("mmp_index", label = "MMP Index") %>% - dyRangeSelector(height = 30) - }else{ - dygraph(storm_cost_index_normalized_costs_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>% - dySeries("mmh", label = "MMH") %>% - dySeries("mmp", label = "MMP") %>% - dyRangeSelector(height = 30) - } - -}) +#}) fillCol( flex = c(.2, .8), @@ -632,7 +354,7 @@ fillCol( #checkboxInput("mmpSelect", "Display MMP", value = T) ) ), - dygraphOutput("costIndex") + dygraphOutput("cost_index_chart") ) ``` @@ -656,39 +378,15 @@ fluidRow( ### Landfalls {data-height=300 .no-padding} ```{r} -storm_landfalls <- reactive({ +output$landfalls_table <- renderDT({ req(storm_selection$is_selected) - result <- hurdat.best_track %>% - filter( - storm_basin == storm_selection$storm_basin, - storm_year == storm_selection$storm_year, - storm_name == storm_selection$storm_name, - record_identifier == "L" - ) %>% - mutate( - lon = sql("ST_X(ST_Transform(location::geometry, 4326))"), - lat = sql("ST_Y(ST_Transform(location::geometry, 4326))") - ) %>% - select( - Date = datetime, - Longitude = lon, - Latitude = lat, - RMW = rmw, - Pressure = pressure, - Windspeed = windspeed - ) %>% - collect() + hurdat_landfalls <- get_hurdat_landfalls(storm_selection) - cat(str(result)) - - return(result) -}) - -output$landfalls_table <- renderDT({ datatable( - storm_landfalls(), + hurdat_landfalls, rownames = F, + colnames = c("Date", "Longitude", "Latitude", "RMW", "Pressure", "Windspeed"), options = list( order = list(0, 'asc'), paging = F, @@ -698,57 +396,29 @@ output$landfalls_table <- renderDT({ server = T ) ) %>% - formatDate(columns = "Date", method = "toUTCString") + formatDate(columns = "datetime", method = "toUTCString") }) DTOutput("landfalls_table") - ``` ### Storm Track {data-height=500 .no-padding} ```{r} -storm_track <- reactive({ - req(storm_selection$is_selected) +output$track_map <- renderLeaflet({ + storm_track <- get_hurdat_track(storm_selection) - result <- hurdat.best_track %>% - filter( - storm_basin == storm_selection$storm_basin, - storm_year == storm_selection$storm_year, - storm_name == storm_selection$storm_name - ) %>% - mutate( - lon = sql("ST_X(ST_Transform(location::geometry, 4326))"), - lat = sql("ST_Y(ST_Transform(location::geometry, 4326))"), - rmw_meters = (rmw * 1852) - ) %>% - select( - datetime, - lon, - lat, - rmw, - record_identifier, - rmw_meters - ) %>% - collect() - - cat(str(result)) - - return(result) -}) - -output$trackMap <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% setView(lng = -80, lat = 32, zoom = 4) %>% addPolylines( - data = storm_track(), + data = storm_track, lng = ~lon, lat = ~lat, weight = 4, color = "blue" ) %>% addCircleMarkers( - data = storm_track() %>% filter(record_identifier == "L"), + data = storm_track %>% filter(record_identifier == "L"), lng = ~lon, lat = ~lat, radius = 5, @@ -758,7 +428,7 @@ output$trackMap <- renderLeaflet({ fillOpacity = 0.8 ) %>% addCircles( - data = storm_track() %>% filter(record_identifier == "L"), + data = storm_track %>% filter(record_identifier == "L"), lng = ~lon, lat = ~lat, radius = ~rmw_meters, @@ -769,7 +439,7 @@ output$trackMap <- renderLeaflet({ ) }) -leafletOutput("trackMap", height="100%") +leafletOutput("track_map", height="100%") ``` Growth Trends {data-navmenu="Storm Details"} @@ -780,230 +450,76 @@ Column {data-width=550} ### Map Year {data-height=100} ```{r} -sliderInput("growth_trend_map_slider", label = NULL, min = 1900, max = 2024, step = 1, animate = T, value = 2005, sep = "", width = "100%", ticks = F) +observe({ + req(storm_selection$is_selected) + + updateSliderInput(session, + "growth_trend_map_slider", + min = storm_selection$storm_year, + value = storm_selection$storm_year) +}) +sliderInput("growth_trend_map_slider", label = NULL, min = 1700, max = 2024, step = 1, animate = T, value = 1700, sep = "", width = "100%", ticks = F) ``` ### {data-height=900 .no-padding} ```{r} -growth_metrics_lf_fips <- reactive({ - req(growth_trends$full_lf_id) - - result <- 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( - fips = paste0(state_fips, county_fips) - ) %>% - select( - fips - ) %>% - collect() - - return(result) -}) +#storm_metrics_growth_geom <- reactive({ +# req(storm_selection$is_selected) +# +# counties <- get_normalized_metric_growth(storm_selection, input$growth_trend_lf_select) +# +# result <- counties %>% +# st_as_sf(wkt = "geom_wkt") +# #%>% +# # mutate( +# # clamped_population = rescale(normalized_population, to = c(0.1, 0.9), from = range(normalized_population, na.rm = T)), +# # clamped_housing = rescale(normalized_housing, to = c(0.1, 0.9), from = range(normalized_housing, na.rm = T)) +# # ) %>% +# +# +# cat(str(result)) +# +# return(result) +#}) -normalized_growth_metrics_lf <- reactive({ - req(growth_metrics_lf_fips()) - - affected_fips <- growth_metrics_lf_fips()$fips - - affected_counties <- metrics.pop_and_housing %>% - mutate( - fips = paste0(state_fips, county_fips) - ) %>% - filter( - fips %in% affected_fips, - year >= storm_selection$storm_year - ) %>% - group_by( - fips - ) %>% - arrange( - year - ) %>% - mutate( - base_population = first(population), - base_housing_units = first(housing_units), - ) %>% - ungroup() %>% - collect() +#observe({ +# req(storm_selection$is_selected, input$growth_trend_map_slider) +# +# county_data <- storm_metrics_growth_geom() %>% +# filter(year == input$growth_trend_map_slider) +# +# cat(str(county_data)) +# +# leafletProxy("pop_growth_map", session) %>% +# clearShapes() %>% +# addPolygons( +# data = county_data, +# fillColor = "red", +# fillOpacity = 1 +# ) +#}) - affected_counties_geom <- public.counties %>% - mutate( - fips = paste0(statefp, countyfp), - geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))") - ) %>% - filter( - fips %in% affected_fips, - ) %>% - collect() - - result <- affected_counties %>% - left_join( - affected_counties_geom, - by = "fips" - ) %>% - st_as_sf(wkt = "geom_wkt") - - return(result) -}) - -growth_trend_map_year <- reactive({ - req(input$growth_trend_map_slider) - - result <- normalized_growth_metrics_lf() %>% - filter( - year == input$growth_trend_map_slider - ) - - return(result) -}) - -aggregate_growth_metrics_lf <- reactive({ - req(growth_metrics_lf_fips()) - - result <- metrics.pop_and_housing %>% - mutate( - fips = paste0(state_fips, county_fips) - ) %>% - filter( - fips %in% growth_metrics_lf_fips()$fips, - 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() - - return(result) -}) - -aggregate_normalized_growth_metrics_lf <- reactive ({ - req(aggregate_growth_metrics_lf()) - - result <- aggregate_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 - ) - - return(result) -}) - -aggregate_normalized_growth_metrics_lf_ts <- reactive({ - req(aggregate_normalized_growth_metrics_lf()) - - result <- aggregate_normalized_growth_metrics_lf() %>% - select(-year) %>% - xts(order.by = aggregate_normalized_growth_metrics_lf()$year) - - return(result) -}) - -normalized_growth_metrics_lf_ts <- reactive({ - req(normalized_growth_metrics_lf()) - - result <- normalized_growth_metrics_lf() %>% - select(-year) %>% - xts(order.by = normalized_growth_metrics_lf()$year) - - return(result) -}) - -normalized_counties_sf <- reactive({ - req(storm_selection$is_selected) - - affected_counties <- gis.affected_area_landfalls -}) - -dbStormCounties <- reactive({ - req(storm_selection$is_selected) - - sel_storm_basin <- storm_selection$storm_basin - sel_storm_year <- storm_selection$storm_year - sel_storm_name <- storm_selection$storm_name - sel_lfid <- growth_trends$lf_id - - affectedCounties <- gis.affected_area_landfalls %>% - mutate( - fips = paste0(state_fips, county_fips), - lfid = paste0(lf_type, lf_id) - ) %>% - filter( - storm_basin == sel_storm_basin, - storm_year == sel_storm_year, - storm_name == sel_storm_name, - lfid == sel_lfid - ) %>% - left_join( - public.counties %>% - mutate(geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))")) %>% - rename(state_fips = statefp, county_fips = countyfp), - by = c("state_fips", "county_fips") - ) %>% - collect() - - affectedCounties_sf <- affectedCounties %>% - st_as_sf(wkt = "geom_wkt") - - cat(str(affectedCounties_sf)) - - return(affectedCounties_sf) -}) - -output$popMapPoly <- renderLeaflet({ +output$pop_growth_map <- renderLeaflet({ leaflet() %>% - addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% - setView(lng = -89.8, lat = 29.6, zoom = 8) %>% - addPolygons( - data = growth_trend_map_year(), - fillColor = "red", - fillOpacity = 0.3, - color = "black", - weight = 2 - ) + addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) + # %>% setView(lng = -89.8, lat = 29.6, zoom = 8) }) -output$housingMapPoly <- renderLeaflet({ +output$housing_growth_map <- renderLeaflet({ + + leaflet() %>% - addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% - setView(lng = -89.8, lat = 29.6, zoom = 8) #%>% - #addPolygons( - # data = dbStormCounties(), - # fillColor = "blue", - # fillOpacity = 0.3, - # color = "black", - # weight = 2 - #) + addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) + # %>% setView(lng = -89.8, lat = 29.6, zoom = 8) }) fillCol( flex = c(1, 1), - leafletOutput("popMapPoly"), - leafletOutput("housingMapPoly") + leafletOutput("pop_growth_map"), + leafletOutput("housing_growth_map") ) - ``` Column {data-width=450} @@ -1011,23 +527,6 @@ Column {data-width=450} ### Landfall Selection {data-height=550} ```{r} - - -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( @@ -1039,15 +538,15 @@ fillCol( #checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F) ) ), - dygraphOutput("popHu") + #dygraphOutput("popHu") ) -output$popHu <- renderDygraph({ - dygraph(aggregate_normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>% - dySeries("normalized_population", label = "Population") %>% - dySeries("normalized_housing_units", label = "Housing Units") %>% - dyRangeSelector() -}) +#output$popHu <- renderDygraph({ +# dygraph(aggregate_normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>% +# dySeries("normalized_population", label = "Population") %>% +# dySeries("normalized_housing_units", label = "Housing Units") %>% +# dyRangeSelector() +#3}) ``` @@ -1055,27 +554,11 @@ output$popHu <- renderDygraph({ ```{r} -output$katrinaCounties <- renderDT({ - datatable( - katrinaLfTwoCountyMetrics, - rownames = F, - #extensions = "RowGroup", - options = list( - pageLength = 1000, - #rowGroup = list(dataSrc = 1), - paging = F, - searching = F, - info = F, - lengthChange = F, - server = T - ) - ) -}) - -#DTOutput("katrinaCounties") - ``` +Storm Fatalities {data-navmenu="Storm Details"} +=== + Fatalities {data-navmenu="Fatalities"} diff --git a/hurricane_app/server.R b/hurricane_app/server.R deleted file mode 100644 index 85e71a1..0000000 --- a/hurricane_app/server.R +++ /dev/null @@ -1,28 +0,0 @@ -# -# This is the server logic of a Shiny web application. You can run the -# application by clicking 'Run App' above. -# -# Find out more about building applications with Shiny here: -# -# https://shiny.posit.co/ -# - -library(shiny) - -# Define server logic required to draw a histogram -function(input, output, session) { - - output$distPlot <- renderPlot({ - - # generate bins based on input$bins from ui.R - x <- faithful[, 2] - bins <- seq(min(x), max(x), length.out = input$bins + 1) - - # draw the histogram with the specified number of bins - hist(x, breaks = bins, col = 'darkgray', border = 'white', - xlab = 'Waiting time to next eruption (in mins)', - main = 'Histogram of waiting times') - - }) - -} diff --git a/hurricane_app/ui.R b/hurricane_app/ui.R deleted file mode 100644 index 3aa541b..0000000 --- a/hurricane_app/ui.R +++ /dev/null @@ -1,33 +0,0 @@ -# -# This is the user-interface definition of a Shiny web application. You can -# run the application by clicking 'Run App' above. -# -# Find out more about building applications with Shiny here: -# -# https://shiny.posit.co/ -# - -library(shiny) - -# Define UI for application that draws a histogram -fluidPage( - - # Application title - titlePanel("Old Faithful Geyser Data"), - - # Sidebar with a slider input for number of bins - sidebarLayout( - sidebarPanel( - sliderInput("bins", - "Number of bins:", - min = 1, - max = 50, - value = 30) - ), - - # Show a plot of the generated distribution - mainPanel( - plotOutput("distPlot") - ) - ) -) diff --git a/queries.R b/queries.R index 430d4fd..1ce96f4 100644 --- a/queries.R +++ b/queries.R @@ -3,6 +3,7 @@ library(tidyverse) library(dplyr) library(DBI) +#library(sf) linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/" macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" @@ -43,6 +44,18 @@ metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing")) public.counties <- tbl(con, I("public.counties")) +# helper functions + +# splits full_lf_id into lf_type and lf_id +split_full_lf_id <- function(full_lf_id) { + lf_type = gsub('[0-9]+', '', full_lf_id) + lf_id = gsub('[^0-9]', '', full_lf_id) + + return(list(lf_type = lf_type, lf_id = lf_id)) +} + +# DB getters + # returns a list of loss storms we have data on get_all_loss_storms <- function() { query <- econ.storm_base_loss %>% @@ -65,14 +78,265 @@ get_all_loss_storms <- function() { return(result) } +# returns a list of latest normalized losses +get_latest_aggregate_losses <- function() { + latest_loss_year <- econ.normalized_landfalls %>% + select(normalization_year) %>% + arrange(desc(normalization_year)) %>% + head(1) %>% + collect() %>% + pull(normalization_year) + + query <- econ.normalized_landfalls %>% + filter(normalization_year == latest_loss_year) %>% + 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_lf = (base_loss * gdp_deflator * rwhu * affected_housing), + mmp_lf = (base_loss * gdp_deflator * rwpc * affected_population) + ) %>% + group_by(storm_basin, storm_year, storm_name) %>% + summarize( + mmh = sum(mmh_lf, na.rm = T), + mmp = sum(mmp_lf, na.rm = T), + .groups = "drop" + ) %>% + filter(!is.na(mmh) & !is.na(mmp)) %>% + select( + storm_name, + storm_year, + mmh, + mmp + ) + + result <- query %>% collect() + + return(result) +} +# returns unique lf ids for a storm +get_unique_lf_ids <- function(storm) { + query <- econ.storm_base_loss %>% + 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) + ) %>% + 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 + ) + + result <- query %>% collect() + + return(result) +} +# returns normalized mmh/mmp indexes and costs over time by landfall +get_normalized_cost_index <- function(storm, full_lf_id) { + lf_id_parts <- split_full_lf_id(full_lf_id) + + query <- econ.normalized_landfalls %>% + filter( + storm_basin == storm$storm_basin, + storm_year == storm$storm_year, + storm_name == storm$storm_name, + lf_type == lf_id_parts$lf_type, + lf_id == lf_id_parts$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, "%mwr%") ~ 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( + normalization_year, mmh, mmp + ) + + result <- query %>% collect() + + return(result) +} +# returns landfalls and data at landfall from HURDAT +get_hurdat_landfalls <- function(storm) { + query <- hurdat.best_track %>% + filter( + storm_basin == storm$storm_basin, + storm_year == storm$storm_year, + storm_name == storm$storm_name, + record_identifier == "L" + ) %>% + mutate( + lon = sql("ST_X(ST_Transform(location::geometry, 4326))"), + lat = sql("ST_Y(ST_Transform(location::geometry, 4326))") + ) %>% + select( + datetime, + lon, + lat, + rmw, + pressure, + windspeed + ) + + result <- query %>% collect() + + return(result) +} +# returns storm track from HURDAT +get_hurdat_track <- function(storm) { + query <- hurdat.best_track %>% + filter( + storm_basin == storm$storm_basin, + storm_year == storm$storm_year, + storm_name == storm$storm_name + ) %>% + mutate( + lon = sql("ST_X(ST_Transform(location::geometry, 4326))"), + lat = sql("ST_Y(ST_Transform(location::geometry, 4326))"), + rmw_meters = (rmw * 1852) # convert nautical miles to meters + ) %>% + select( + datetime, + lon, + lat, + rmw, + record_identifier, + rmw_meters + ) + + result <- query %>% collect() + + return(result) +} +# returns normalized population and housing growth by county with geometry +#get_normalized_metric_growth <- function(storm, full_lf_id) { +# lf_id_parts <- split_full_lf_id(full_lf_id) +# +# affected_counties <- gis.affected_area_landfalls %>% +# filter( +# storm_basin == storm$storm_basin, +# storm_year == storm$storm_year, +# storm_name == storm$storm_name, +# lf_type == lf_id_parts$lf_type, +# lf_id == lf_id_parts$lf_id +# ) %>% +# select(state_fips, county_fips) +# +# baseline_metrics <- metrics.pop_and_housing %>% +# filter( +# year == storm$storm_year +# ) %>% +# inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% +# select( +# state_fips, +# county_fips, +# baseline_population = population, +# baseline_housing = housing_units +# ) +# +# normalized_metrics <- metrics.pop_and_housing %>% +# filter( +# year >= storm$storm_year +# ) %>% +# inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% +# inner_join(baseline_metrics, by = c("state_fips", "county_fips")) %>% +# mutate( +# normalized_population = as.numeric(population) / as.numeric(baseline_population), +# normalized_housing = as.numeric(housing_units) / as.numeric(baseline_housing) +# ) %>% +# select( +# state_fips, +# county_fips, +# year, +# population, +# housing_units, +# normalized_population, +# normalized_housing +# ) +# +# query <- normalized_metrics %>% +# inner_join( +# public.counties, +# by = c("state_fips" = "statefp", "county_fips" = "countyfp") +# ) %>% +# mutate( +# geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))") +# ) %>% +# select( +# state_fips, +# county_fips, +# year, +# population, +# housing_units, +# normalized_population, +# normalized_housing, +# geom_wkt +# ) %>% +# arrange(state_fips, county_fips, year) +# +# result <- query %>% collect() +# +# return(result) +#} +# test functions +#storm <- list(storm_basin = "AL", storm_name = "KATRINA", storm_year = 2005) +#full_lf_id <- "LF1" +#a <- get_all_loss_storms() + +#b <- get_latest_aggregate_losses() + +#c <- get_unique_lf_ids(storm) + +#d <- get_normalized_cost_index(storm, full_lf_id) + +#e <- get_hurdat_landfalls(storm) + +#f <- get_hurdat_track(storm) + +#g <- get_normalized_metric_growth(storm, full_lf_id) +#g_2 <- g %>% +# st_as_sf(wkt = "geom_wkt") diff --git a/utils.R b/utils.R new file mode 100644 index 0000000..e69de29