diff --git a/app-profile.R b/app-profile.R index 4a51a8c..be4c138 100644 --- a/app-profile.R +++ b/app-profile.R @@ -1,6 +1,8 @@ library(profvis) -setwd("/home/dylan/Personal/Projects/Hurricane Normalization/R/dataScripts/restructured/app") +setwd( + "/home/dylan/Personal/Projects/Hurricane Normalization/R/dataScripts/restructured/app" +) profvis({ rmarkdown::render("dashboard.Rmd") diff --git a/dashboard.Rmd b/dashboard.Rmd index 9383b1a..26875e8 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -13,7 +13,7 @@ output: ```{r global, include=FALSE} # TODO: # - update normalization to new 2024 data -# - +# - library(flexdashboard) library(shiny) @@ -51,22 +51,24 @@ linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/" macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" widir <- "E/..." -if(!is.null(os)) { - if(grepl("darwin", os, ignore.case = T)) { +if (!is.null(os)) { + if (grepl("darwin", os, ignore.case = T)) { cat("OS: Mac") baseDir <- macdir - } else if(grepl("linux", os, ignore.case = T)) { + } else if (grepl("linux", os, ignore.case = T)) { cat("OS: Linux") baseDir <- linuxdir - } else if(grepl("windows", os, ignore.case = T)) { + } else if (grepl("windows", os, ignore.case = T)) { cat("OS: Win") - baseDir <- windir + baseDir <- windir } else { cat("Cannot identify OS") } } -config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")) +config <- config::get( + file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml") +) source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R")) @@ -141,16 +143,29 @@ Col {data-width=500} # Home - Storm Selector fluidRow( - column(6, + column( + 6, div( selectInput("stormBasin", "Basin", choices = "AL", width = "100%"), - selectInput("stormYear", "Year", choices = loss_storms$storm_year, width = "100%"), + selectInput( + "stormYear", + "Year", + choices = loss_storms$storm_year, + width = "100%" + ), selectInput("stormName", "Name", choices = NULL, width = "100%"), - actionButton("selectStorm", "Submit", class = "btn-primary rounded", width = "100%") + actionButton( + "selectStorm", + "Submit", + class = "btn-primary rounded", + width = "100%" + ) ) ), - column(6, - HTML(' + column( + 6, + HTML( + '
Select a Storm
We are currently tracking 201 CONUS storms with over $3.6T in losses spanning from 1900 to 2024 @@ -158,19 +173,22 @@ fluidRow(
Use the storm selector to the left or the table below to select a storm to analyze - ') + ' + ) ) ) observeEvent(input$stormYear, { stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ] - + stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear) - updateSelectInput(session, "stormName", - choices = stormsByYear$storm_name, - selected = NULL - ) + updateSelectInput( + session, + "stormName", + choices = stormsByYear$storm_name, + selected = NULL + ) }) observeEvent(input$selectStorm, { @@ -178,7 +196,7 @@ observeEvent(input$selectStorm, { storm_selection$storm_year <- input$stormYear storm_selection$storm_name <- input$stormName storm_selection$is_selected <- TRUE - + showNotification("Storm selection updated!", type = "message") }) ``` @@ -202,7 +220,7 @@ output$normalized_storms_table <- renderDT({ lengthChange = F, server = T ) - ) %>% + ) %>% formatCurrency(c("mmh", "mmp"), "$", digits = 0) }) @@ -219,19 +237,19 @@ Storm Overview {data-navmenu="Storm Details"} observe({ req(storm_selection$is_selected) - + unique_lfs <- get_unique_lf_ids(storm_selection) - + 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] ) - + updateSelectInput( session, - "growth_trend_lf_select", + "growth_trend_lf_select", choices = unique_lfs$full_lf_id, selected = unique_lfs$full_lf_id[1] ) @@ -249,7 +267,7 @@ Col {data-width=500} storm_track <- reactive({ req(storm_selection, storm_selection$is_selected) result <- get_hurdat_track(storm_selection) - + # HURDAT storm status # TD – Tropical cyclone of tropical depression intensity (< 34 knots) # TS – Tropical cyclone of tropical storm intensity (34-63 knots) @@ -259,10 +277,10 @@ storm_track <- reactive({ # SS – Subtropical cyclone of subtropical storm intensity (> 34 knots) # LO – A low that is neither a tropical cyclone, a subtropical cyclone, nor an extratropical cyclone (of any intensity) # WV – Tropical Wave (of any intensity) - # DB – Disturbance (of any intensity) - + # DB – Disturbance (of any intensity) + # Line Color Storm Type Status Pressure (mb) Wind (mph) Wind (knots) - # Blue Subtropical Depression SD -- <=38 <=33 + # Blue Subtropical Depression SD -- <=38 <=33 # Light Blue Subtropical Storm SS -- 39-73 34-63 # Green Tropical Depression (TD) TD -- <=38 <=33 # Yellow Tropical Storm (TS) TS 980+ 39-73 34-63 @@ -273,75 +291,73 @@ storm_track <- reactive({ # White Major Hurricane (Cat 5) HU <=920 157+ 137+ # Green dashed (- -) Wave/Low/Disturbance WV/LO/DB -- -- -- # Black hatched (++) Extratropical Cyclone EX -- -- -- - + # Category Sustained Windspeed (knots) # 1 64-82 # 2 83-95 # 3 96-112 # 4 113-136 # 5 137+ - + # Preprocess the track data with colors - result <- result %>% + result <- result %>% mutate( hurricane_category = case_when( - # Hurricane Cat 1 storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1, - + # Hurricane Cat 2 storm_status == "HU" & windspeed >= 83 & windspeed <= 95 ~ 2, - + # Hurricane Cat 3 storm_status == "HU" & windspeed >= 96 & windspeed <= 112 ~ 3, - + # Hurricane Cat 4 storm_status == "HU" & windspeed >= 113 & windspeed <= 136 ~ 4, - + # Hurricane Cate 5 storm_status == "HU" & windspeed >= 137 ~ 5, ), line_color = case_when( - # Tropical Depression - Green storm_status == "TD" ~ "#2AFF00", - + # Tropical Storm - Yellow storm_status == "TS" ~ "#FFD020", - + # Hurricane Cat 1 - Red hurricane_category == 1 ~ "#FF4343", - + # Hurricane Cat 2 - Pink hurricane_category == 2 ~ "#FF6FFF", - + # Hurricane Cat 3 - Magenta hurricane_category == 3 ~ "#FF23D3", - + # Hurricane Cat 4 - Purple hurricane_category == 4 ~ "#C916FF", - + # Hurricane Cate 5 - White hurricane_category == 5 ~ "#FFFFFF", - + # Extratropical Cyclone storm_status == "EX" ~ "#202020", - + # Subtropical Depression storm_status == "SD" ~ "#0055FF", - + # Subtropical Storm storm_status == "SS" ~ "#6CE2FF", - + # Low storm_status == "LO" ~ "#A1A1A1", - + # Wave storm_status == "WV" ~ "#A1A1A1", - + # Disturbance storm_status == "DB" ~ "#A1A1A1", - + # Missing TRUE ~ "#FF5C00" ), @@ -363,44 +379,44 @@ storm_track <- reactive({ ) ) %>% arrange(datetime) - + return(result) }) output$track_map <- renderLeaflet({ track_data <- storm_track() - - map <- leaflet() %>% - addProviderTiles("Stadia.AlidadeSmooth") %>% + + map <- leaflet() %>% + addProviderTiles("Stadia.AlidadeSmooth") %>% fitBounds( lng1 = min(track_data$lon), lng2 = max(track_data$lon), lat1 = min(track_data$lat), lat2 = max(track_data$lat) - ) - + ) + map <- map %>% leaflet::addLegend( position = "bottomleft", colors = c( - "#2AFF00", # TD - "#FFD020", # TS - "#FF4343", # Cat 1 - "#FF6FFF", # Cat 2 - "#FF23D3", # Cat 3 - "#C916FF", # Cat 4 - "#FFFFFF", # Cat 5 - "#202020", # EX - "#0055FF", # SD - "#6CE2FF", # SS - "#A1A1A1", # LO/WV/DB - "#FF5C00" # Missing + "#2AFF00", # TD + "#FFD020", # TS + "#FF4343", # Cat 1 + "#FF6FFF", # Cat 2 + "#FF23D3", # Cat 3 + "#C916FF", # Cat 4 + "#FFFFFF", # Cat 5 + "#202020", # EX + "#0055FF", # SD + "#6CE2FF", # SS + "#A1A1A1", # LO/WV/DB + "#FF5C00" # Missing ), labels = c( "Tropical Depression (TD)", "Tropical Storm (TS)", "Hurricane Category 1", - "Hurricane Category 2", + "Hurricane Category 2", "Hurricane Category 3", "Hurricane Category 4", "Hurricane Category 5", @@ -413,12 +429,11 @@ output$track_map <- renderLeaflet({ opacity = 1, title = "Track Legend" ) - - + if (nrow(track_data) >= 2) { for (i in 1:(nrow(track_data) - 1)) { - segment_data <- track_data[i:(i+1), ] - + segment_data <- track_data[i:(i + 1), ] + map <- map %>% addPolylines( data = segment_data, @@ -430,7 +445,7 @@ output$track_map <- renderLeaflet({ ) } } - + map <- map %>% addCircleMarkers( data = track_data, @@ -439,20 +454,31 @@ output$track_map <- renderLeaflet({ radius = 2, color = ~line_color, fillOpacity = 1, - popup = ~paste0("DATE", "
", - datetime, "
", - "CATEGORY", "
", - popup_category, "
", - "WINDSPEED", "
", - windspeed, "kt", "
", - "PRESSURE", "
", - pressure, "mb") + popup = ~ paste0( + "DATE", + "
", + datetime, + "
", + "CATEGORY", + "
", + popup_category, + "
", + "WINDSPEED", + "
", + windspeed, + "kt", + "
", + "PRESSURE", + "
", + pressure, + "mb" + ) ) - - landfall_data <- track_data %>% + + landfall_data <- track_data %>% filter(record_identifier == "L") - - if(nrow(landfall_data) > 0) { + + if (nrow(landfall_data) > 0) { map <- map %>% addCircleMarkers( data = landfall_data, @@ -463,18 +489,32 @@ output$track_map <- renderLeaflet({ color = ~line_color, fillColor = ~line_color, fillOpacity = 1, - popup = ~paste0("LANDFALL", "
", - "DATE", "
", - datetime, "
", - "CATEGORY", "
", - popup_category, "
", - "WINDSPEED", "
", - windspeed, "kt", "
", - "PRESSURE", "
", - pressure, "mb", "
", - "RMW", "
", - rmw, "nm" - ) + popup = ~ paste0( + "LANDFALL", + "
", + "DATE", + "
", + datetime, + "
", + "CATEGORY", + "
", + popup_category, + "
", + "WINDSPEED", + "
", + windspeed, + "kt", + "
", + "PRESSURE", + "
", + pressure, + "mb", + "
", + "RMW", + "
", + rmw, + "nm" + ) ) %>% addCircles( data = landfall_data, @@ -485,21 +525,35 @@ output$track_map <- renderLeaflet({ color = ~line_color, fillColor = ~line_color, fillOpacity = 0.3, - popup = ~paste0("LANDFALL", "
", - "DATE", "
", - datetime, "
", - "CATEGORY", "
", - popup_category, "
", - "WINDSPEED", "
", - windspeed, "kt", "
", - "PRESSURE", "
", - pressure, "mb", "
", - "RMW", "
", - rmw, "nm" - ) + popup = ~ paste0( + "LANDFALL", + "
", + "DATE", + "
", + datetime, + "
", + "CATEGORY", + "
", + popup_category, + "
", + "WINDSPEED", + "
", + windspeed, + "kt", + "
", + "PRESSURE", + "
", + pressure, + "mb", + "
", + "RMW", + "
", + rmw, + "nm" + ) ) } - + return(map) }) @@ -515,93 +569,105 @@ Col {data-width=500 .tabset} storm_yearly_normalization <- reactive({ req(storm_selection$is_selected) - + result <- get_all_normalized_cost_index(storm_selection) - + return(result) }) 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, - input$storm_overview_cost_index_y_scale) - - if(input$storm_overview_cost_index_y_scale == "Log") { + req( + storm_yearly_normalization, + input$storm_overview_cost_index_lf_select, + input$storm_overview_cost_index_mmh_mmp, + input$storm_overview_cost_index_scale, + input$storm_overview_cost_index_y_scale + ) + + if (input$storm_overview_cost_index_y_scale == "Log") { is_y_log <- T - }else{ + } else { is_y_log <- F } - - normalized_data <- storm_yearly_normalization() %>% + + 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") - + y_label <- "Cost Index" } else if (selected_scale == "Loss") { value_columns <- paste0(selected_methods, " Loss") - + y_label <- "Normalized Loss" } - - normalization_index <- normalized_data %>% + + normalization_index <- normalized_data %>% filter( full_lf_id %in% selected_lf - ) %>% + ) %>% mutate( normalization_year = as.Date(paste0(normalization_year, "-01-01")) ) %>% select( - normalization_year, + normalization_year, full_lf_id, - all_of(value_columns) - ) %>% + 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) %>% + + normalization_index_ts <- normalization_index %>% + select(-normalization_year) %>% xts(order.by = normalization_index$normalization_year) - + dygraph(normalization_index_ts, ylab = y_label) %>% dyOptions( - colors = paletteer_d("ggthemes::Classic_Purple_Gray_12", ncol(normalization_index - 1)), + colors = paletteer_d( + "ggthemes::Classic_Purple_Gray_12", + ncol(normalization_index - 1) + ), fillGraph = T, fillAlpha = .2, labelsKMB = T, logscale = is_y_log - ) %>% - dyAxis("x", drawGrid = F) %>% + ) %>% + dyAxis("x", drawGrid = F) %>% dyRangeSelector() }) output$landfalls_table <- renderDT({ req(storm_selection$is_selected) - + hurdat_landfalls <- get_hurdat_landfalls(storm_selection) - + datatable( hurdat_landfalls, rownames = F, - colnames = c("Date", "Longitude", "Latitude", "RMW", "Pressure", "Windspeed"), + colnames = c( + "Date", + "Longitude", + "Latitude", + "RMW", + "Pressure", + "Windspeed" + ), options = list( order = list(0, 'asc'), paging = F, @@ -610,7 +676,7 @@ output$landfalls_table <- renderDT({ lengthChange = F, server = T ) - ) %>% + ) %>% formatDate(columns = "datetime", method = "toUTCString") }) @@ -619,19 +685,40 @@ fillCol( div( fluidRow( style = "height: 100%", - column(3, - virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls", - 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), - radioGroupButtons("storm_overview_cost_index_y_scale", label = "Y-Axis Scale", choices = c("Linear", "Log"), status = "outline-primary rounded-0", justified = T) + column( + 3, + virtualSelectInput( + "storm_overview_cost_index_lf_select", + "Landfalls", + 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 + ), + radioGroupButtons( + "storm_overview_cost_index_y_scale", + label = "Y-Axis Scale", + choices = c("Linear", "Log"), + status = "outline-primary rounded-0", + justified = T + ) ), - column(9, - dygraphOutput("cost_index_chart") - ) + column(9, dygraphOutput("cost_index_chart")) ) ), div( @@ -647,9 +734,26 @@ fillCol( output$track_data <- renderDT({ datatable( - storm_track() %>% select(formatted_datetime, storm_status, lon, lat, rmw, pressure, windspeed), + storm_track() %>% + select( + formatted_datetime, + storm_status, + lon, + lat, + rmw, + pressure, + windspeed + ), rownames = F, - colnames = c("Date", "Status", "Lon", "Lat", "RMW", "Pressure", "Windspeed"), + colnames = c( + "Date", + "Status", + "Lon", + "Lat", + "RMW", + "Pressure", + "Windspeed" + ), selection = "none", options = list( pageLength = 1000, @@ -681,11 +785,13 @@ Column {data-width=550 .tabset} observe({ req(storm_selection$is_selected) - - updateSliderInput(session, - "growth_trend_map_slider", - min = storm_selection$storm_year, - value = storm_selection$storm_year) + + updateSliderInput( + session, + "growth_trend_map_slider", + min = storm_selection$storm_year, + value = storm_selection$storm_year + ) }) test_storm <- reactiveValues( @@ -696,46 +802,54 @@ test_storm <- reactiveValues( test_counties <- reactive({ req(storm_selection$is_selected) - + counties <- get_normalized_metric_growth(test_storm, "LF1") - - result <- counties %>% - filter(year == 2024) %>% + + result <- counties %>% + filter(year == 2024) %>% mutate( - population_opacity = rescale(normalized_population, to = c(0.2, 0.8), from = range(normalized_population, na.rm = T)), - housing_opacity = rescale(normalized_housing, to = c(0.2, 0.8), from = range(normalized_housing, na.rm = T)) - ) %>% + population_opacity = rescale( + normalized_population, + to = c(0.2, 0.8), + from = range(normalized_population, na.rm = T) + ), + housing_opacity = rescale( + normalized_housing, + to = c(0.2, 0.8), + from = range(normalized_housing, na.rm = T) + ) + ) %>% st_as_sf(wkt = "geom_wkt") - + return(result) }) output$pop_growth_map <- renderLeaflet({ - leaflet() %>% + leaflet() %>% addProviderTiles("Stadia.AlidadeSmooth") %>% setView(lng = -81.3, lat = 25.6, zoom = 7) }) output$housing_growth_map <- renderLeaflet({ - leaflet() %>% - addProviderTiles("Stadia.AlidadeSmooth") %>% + leaflet() %>% + addProviderTiles("Stadia.AlidadeSmooth") %>% setView(lng = -81.3, lat = 25.6, zoom = 7) }) observe({ req(test_counties) - - leafletProxy("pop_growth_map", data = test_counties()) %>% - clearShapes() %>% + + leafletProxy("pop_growth_map", data = test_counties()) %>% + clearShapes() %>% addPolygons( fillColor = "red", color = "red", fillOpacity = ~population_opacity, weight = 2 ) - - leafletProxy("housing_growth_map", data = test_counties()) %>% - clearShapes() %>% + + leafletProxy("housing_growth_map", data = test_counties()) %>% + clearShapes() %>% addPolygons( fillColor = "blue", color = "blue", @@ -755,7 +869,18 @@ fillCol( justify-content: center; align-itmes: center; ", - sliderInput("growth_trend_map_slider", label = NULL, min = 1926, max = 2024, step = 1, animate = T, value = 1926, sep = "", width = "100%", ticks = F) + sliderInput( + "growth_trend_map_slider", + label = NULL, + min = 1926, + max = 2024, + step = 1, + animate = T, + value = 1926, + sep = "", + width = "100%", + ticks = F + ) ), leafletOutput("pop_growth_map", height = "100%"), leafletOutput("housing_growth_map", height = "100%") @@ -778,29 +903,28 @@ Column {data-width=450} fillCol( flex = c(.2, .8), fluidRow( - column(6, - selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL) + column( + 6, + selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL) ), - column(6, - - ) + column(6, ) ), dygraphOutput("test_dy") ) output$test_dy <- renderDygraph({ test_ts <- test_query() - - dygraph(test_ts, main = "Normalized Aggregate Growth") %>% - dySeries("population_index", label = "Population") %>% - dySeries("housing_index", label = "Housing Units") %>% + + dygraph(test_ts, main = "Normalized Aggregate Growth") %>% + dySeries("population_index", label = "Population") %>% + dySeries("housing_index", 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") %>% +# 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}) ``` @@ -809,7 +933,12 @@ output$test_dy <- renderDygraph({ ```{r} # Growth - County Table great_miami_data <- data.frame( - county_name = c("Broward County", "Collier County", "Miami-Dade County", "Monroe County"), + county_name = c( + "Broward County", + "Collier County", + "Miami-Dade County", + "Monroe County" + ), housing_1926 = c(3.7, 0, 25, 3.5), housing_2024 = c(869, 250, 1100, 55), population_1926 = c(14, 0, 103, 16), @@ -829,25 +958,34 @@ output$great_miami_dt <- renderDT({ server = T ), colnames = c( - "County", "1926 HU", "2024 HU", "1926 POP", "2024 POP" + "County", + "1926 HU", + "2024 HU", + "1926 POP", + "2024 POP" ), ) %>% - # Format housing columns with blue background - formatStyle( - columns = c("housing_1926", "housing_2024"), - backgroundColor = "rgba(0, 0, 255, 0.2)" - ) %>% - # Format population columns with red background - formatStyle( - columns = c("population_1926", "population_2024"), - backgroundColor = "rgba(255, 0, 0, 0.2)" - ) %>% - formatCurrency( - columns = c("housing_1926", "housing_2024", "population_1926", "population_2024"), - currency = "k", - digits = 0, - before = F - ) + # Format housing columns with blue background + formatStyle( + columns = c("housing_1926", "housing_2024"), + backgroundColor = "rgba(0, 0, 255, 0.2)" + ) %>% + # Format population columns with red background + formatStyle( + columns = c("population_1926", "population_2024"), + backgroundColor = "rgba(255, 0, 0, 0.2)" + ) %>% + formatCurrency( + columns = c( + "housing_1926", + "housing_2024", + "population_1926", + "population_2024" + ), + currency = "k", + digits = 0, + before = F + ) }) DTOutput("great_miami_dt") @@ -872,9 +1010,9 @@ Column {data-width=700 .tabset} # Calculator - Impact Map output$impact_analysis_map <- renderLeaflet({ - leaflet() %>% - addProviderTiles("Stadia.AlidadeSmooth") %>% - setView(lng = -80.3, lat = 25.6, zoom = 10) %>% + leaflet() %>% + addProviderTiles("Stadia.AlidadeSmooth") %>% + setView(lng = -80.3, lat = 25.6, zoom = 10) %>% addCircles( lng = -80.3, lat = 25.6, @@ -882,7 +1020,7 @@ output$impact_analysis_map <- renderLeaflet({ color = "blue", weight = 2, opacity = 0.3 - ) %>% + ) %>% addCircleMarkers( lng = -80.3, lat = 25.6, @@ -891,7 +1029,7 @@ output$impact_analysis_map <- renderLeaflet({ color = "blue", fillColor = "blue", fillOpacity = 0.6 - ) + ) }) leafletOutput("impact_analysis_map", height = "100%") @@ -912,57 +1050,150 @@ Column {data-width=300} div( h6("Storm Selector"), - selectInput("impact_storm_basin", label = NULL, choices = "AL", width = "100%"), - selectInput("impact_storm_year", label = NULL, choices = 1926, width = "100%"), - selectInput("impact_storm_name", label = NULL, choices = "GREAT MIAMI", width = "100%"), - + selectInput( + "impact_storm_basin", + label = NULL, + choices = "AL", + width = "100%" + ), + selectInput( + "impact_storm_year", + label = NULL, + choices = 1926, + width = "100%" + ), + selectInput( + "impact_storm_name", + label = NULL, + choices = "GREAT MIAMI", + width = "100%" + ), + fluidRow( - column(6, - selectInput("impact_storm_lf_type", label = NULL, choices = "LF", width = "100%") + column( + 6, + selectInput( + "impact_storm_lf_type", + label = NULL, + choices = "LF", + width = "100%" + ) ), - column(6, - selectInput("impact_storm_lf_id", label = NULL, choices = "1", width = "100%") + column( + 6, + selectInput( + "impact_storm_lf_id", + label = NULL, + choices = "1", + width = "100%" + ) ) ), - - actionButton("impact_populate_storm", label = "Populate", width = "100%", class = "btn-primary rounded") + + actionButton( + "impact_populate_storm", + label = "Populate", + width = "100%", + class = "btn-primary rounded" + ) ) hr() div( fluidRow( - column(6, - textInput("impact_lat", placeholder = "Lat", value = "25.6", label = "Latitude", width = "100%") + column( + 6, + textInput( + "impact_lat", + placeholder = "Lat", + value = "25.6", + label = "Latitude", + width = "100%" + ) ), - column(6, - textInput("impact_lon", placeholder = "Lon", value = "-80.3", label = "Longitude", width = "100%") + column( + 6, + textInput( + "impact_lon", + placeholder = "Lon", + value = "-80.3", + label = "Longitude", + width = "100%" + ) ) ), - + fluidRow( - column(4, - textInput("impact_rmw", placeholder = "RMW", value = "20", label = "RMW (NM)", width = "100%") + column( + 4, + textInput( + "impact_rmw", + placeholder = "RMW", + value = "20", + label = "RMW (NM)", + width = "100%" + ) ), - column(8, - sliderInput("impact_rmw_slider", label = NULL, min = 1, max = 150, value = 20, ticks = F, width = "100%") + column( + 8, + sliderInput( + "impact_rmw_slider", + label = NULL, + min = 1, + max = 150, + value = 20, + ticks = F, + width = "100%" + ) ) ), - - radioGroupButtons("impact_rmw_multiplier", label = "RMW Multiplier", choices = c("1x", "2x", "3x"), status = "outline-primary rounded-0", justified = T), - + + radioGroupButtons( + "impact_rmw_multiplier", + label = "RMW Multiplier", + choices = c("1x", "2x", "3x"), + status = "outline-primary rounded-0", + justified = T + ), + fluidRow( - column(6, - textInput("impact_base_year", placeholder = "Impact Year", value = "1926", label = "Base Year", width = "100%") + column( + 6, + textInput( + "impact_base_year", + placeholder = "Impact Year", + value = "1926", + label = "Base Year", + width = "100%" + ) ), - column(6, - textInput("impact_ref_year", placeholder = "Reference Year", value = "2024", label = "Ref Year", width = "100%") + column( + 6, + textInput( + "impact_ref_year", + placeholder = "Reference Year", + value = "2024", + label = "Ref Year", + width = "100%" + ) ) ), - - textInput("impact_base_damage", placeholder = "Storm Base Damage", label = "Base Damage", value = "76,000,000", width = "100%"), - - actionButton("impact_calculate", label = "Calculate", width = "100%", class = "btn-primary rounded") + + textInput( + "impact_base_damage", + placeholder = "Storm Base Damage", + label = "Base Damage", + value = "76,000,000", + width = "100%" + ), + + actionButton( + "impact_calculate", + label = "Calculate", + width = "100%", + class = "btn-primary rounded" + ) ) ``` @@ -973,9 +1204,22 @@ Data Export {data-navmenu="Compute"} # Export - Mock Data datasets_info <- data.frame( - id = c("hurricane_costs", "population_housing", "fatalities", "storm_tracks", "affected_areas", "economic_data"), - name = c("Hurricane Cost Normalization", "Population & Housing", "Storm Fatalities", - "Hurricane Best Track", "Affected Areas", "Yearly Economics"), + id = c( + "hurricane_costs", + "population_housing", + "fatalities", + "storm_tracks", + "affected_areas", + "economic_data" + ), + name = c( + "Hurricane Cost Normalization", + "Population & Housing", + "Storm Fatalities", + "Hurricane Best Track", + "Affected Areas", + "Yearly Economics" + ), description = c( "Normalized economic damage estimates for US landfalling hurricanes 1900-2023 using updated RMW methodology", "County-level population and housing unit data used for normalization calculations", @@ -984,13 +1228,30 @@ datasets_info <- data.frame( "Geographic areas impacted by hurricane landfalls with RMW coverage percentages", "Yearly economic data used in normalization calculations" ), - size = c("~200 storms", "3,000+ counties", "150+ storms", "2,000+ storms", "5,000+ records", "100+ years"), - last_updated = c("2024-12-01", "2024-11-15", "2024-10-30", "2024-12-15", "2024-11-30", "2025-01-01"), - tables = c("econ.normalized_landfalls, econ.storm_base_loss", - "metrics.pop_and_housing", - "fatal.storm_total_fatalities, fatal.storm_fatalities_type", - "hurdat.best_track, hurdat.hurdat_storms", - "gis.affected_area_landfalls", "econ.usa_yearly"), + size = c( + "~200 storms", + "3,000+ counties", + "150+ storms", + "2,000+ storms", + "5,000+ records", + "100+ years" + ), + last_updated = c( + "2024-12-01", + "2024-11-15", + "2024-10-30", + "2024-12-15", + "2024-11-30", + "2025-01-01" + ), + tables = c( + "econ.normalized_landfalls, econ.storm_base_loss", + "metrics.pop_and_housing", + "fatal.storm_total_fatalities, fatal.storm_fatalities_type", + "hurdat.best_track, hurdat.hurdat_storms", + "gis.affected_area_landfalls", + "econ.usa_yearly" + ), stringsAsFactors = FALSE ) @@ -1007,30 +1268,51 @@ Column {data-width=600} # Export - Datasets create_dataset_card <- function(dataset_row) { card_id <- paste0("card_", dataset_row$id) - + div( class = "dataset-card", id = card_id, style = "border: 2px solid #e3e3e3; border-radius: 8px; padding: 15px; margin: 10px 0; cursor: pointer; transition: all 0.3s ease;", - + div( style = "display: flex; justify-content: space-between; align-items: flex-start;", - + # Left content div( style = "flex: 1;", - tags$b(dataset_row$name, style = "font-size: 16px; margin: 0 0 8px 0; color: #2c3e50; display: block;"), - p(dataset_row$description, style = "margin: 0 0 10px 0; color: #5a6c7d; font-size: 14px; line-height: 1.4;"), - + tags$b( + dataset_row$name, + style = "font-size: 16px; margin: 0 0 8px 0; color: #2c3e50; display: block;" + ), + p( + dataset_row$description, + style = "margin: 0 0 10px 0; color: #5a6c7d; font-size: 14px; line-height: 1.4;" + ), + # Metadata row div( style = "display: flex; gap: 20px; flex-wrap: wrap;", - span(icon("database"), strong("Size: "), dataset_row$size, style = "color: #7f8c8d; font-size: 12px;"), - span(icon("calendar"), strong("Updated: "), dataset_row$last_updated, style = "color: #7f8c8d; font-size: 12px;"), - span(icon("table"), strong("Tables: "), dataset_row$tables, style = "color: #7f8c8d; font-size: 11px;") + span( + icon("database"), + strong("Size: "), + dataset_row$size, + style = "color: #7f8c8d; font-size: 12px;" + ), + span( + icon("calendar"), + strong("Updated: "), + dataset_row$last_updated, + style = "color: #7f8c8d; font-size: 12px;" + ), + span( + icon("table"), + strong("Tables: "), + dataset_row$tables, + style = "color: #7f8c8d; font-size: 11px;" + ) ) ), - + # Selection checkbox div( style = "margin-left: 15px;", @@ -1048,9 +1330,9 @@ create_dataset_card <- function(dataset_row) { # Update selected datasets based on checkboxes observe({ selected <- character(0) - for(i in 1:nrow(datasets_info)) { + for (i in 1:nrow(datasets_info)) { dataset_id <- datasets_info[i, "id"] - if(isTruthy(input[[paste0("select_", dataset_id)]])) { + if (isTruthy(input[[paste0("select_", dataset_id)]])) { selected <- c(selected, dataset_id) } } @@ -1058,7 +1340,8 @@ observe({ }) # Add JavaScript for card click interaction -tags$script(HTML(" +tags$script(HTML( + " $(document).on('click', '.dataset-card', function() { var checkbox = $(this).find('input[type=\"checkbox\"]'); checkbox.prop('checked', !checkbox.prop('checked')).trigger('change'); @@ -1069,13 +1352,17 @@ tags$script(HTML(" $(this).removeClass('selected'); } }); -")) +" +)) # Instructions div( style = "margin-bottom: 20px; padding: 15px; background-color: #f0f8ff; border-radius: 0; border-left: 4px solid #3498db;", - p(strong("Instructions:"), "Select datasets from the cards below by clicking on them. Your selected datasets will appear in the export panel on the right.", - style = "margin: 0; color: #2c3e50;") + p( + strong("Instructions:"), + "Select datasets from the cards below by clicking on them. Your selected datasets will appear in the export panel on the right.", + style = "margin: 0; color: #2c3e50;" + ) ) # Render dataset cards @@ -1099,19 +1386,28 @@ Column {data-width=400} div( class = "export-box", - - tags$b("Export Selected Data", style = "font-size: 18px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 15px;"), - + + tags$b( + "Export Selected Data", + style = "font-size: 18px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 15px;" + ), + # Selected datasets display - tags$b("Selected Datasets:", style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"), + tags$b( + "Selected Datasets:", + style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;" + ), div( id = "selected-datasets-display", style = "min-height: 60px; margin-bottom: 20px; padding: 10px; background-color: white; border-radius: 4px; border: 1px solid #ddd;", uiOutput("selected_datasets_display") ), - + # Format selection - tags$b("Export Format:", style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;"), + tags$b( + "Export Format:", + style = "font-size: 14px; margin-bottom: 10px; color: #34495e; display: block;" + ), radioButtons( "export_format", label = NULL, @@ -1122,14 +1418,14 @@ div( selected = "csv", inline = FALSE ), - + # Export options checkboxInput( "include_documentation", "Include documentation", value = TRUE ), - + # Export button br(), downloadButton( @@ -1142,14 +1438,21 @@ div( # Display selected datasets output$selected_datasets_display <- renderUI({ - if(length(values$selected_datasets) == 0) { - p("No datasets selected", style = "color: #95a5a6; font-style: italic; margin: 20px 0;") + if (length(values$selected_datasets) == 0) { + p( + "No datasets selected", + style = "color: #95a5a6; font-style: italic; margin: 20px 0;" + ) } else { - selected_names <- datasets_info$name[datasets_info$id %in% values$selected_datasets] + selected_names <- datasets_info$name[ + datasets_info$id %in% values$selected_datasets + ] lapply(selected_names, function(name) { span( class = "selected-item", - icon("check-circle"), " ", name + icon("check-circle"), + " ", + name ) }) } @@ -1163,11 +1466,21 @@ output$selected_datasets_display <- renderUI({ div( class = "info-box", - tags$b("Need More Data?", style = "font-size: 16px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 10px;"), - p("Additional datasets, custom queries, and research collaborations are available through our team.", - style = "margin-bottom: 15px; color: #5a6c7d; font-size: 14px;"), - - p(icon("envelope"), strong(" Email:"), " [CONTACT US EMAIL]", style = "margin: 5px 0; color: #34495e; font-size: 14px;") + tags$b( + "Need More Data?", + style = "font-size: 16px; margin-top: 0; color: #2c3e50; display: block; margin-bottom: 10px;" + ), + p( + "Additional datasets, custom queries, and research collaborations are available through our team.", + style = "margin-bottom: 15px; color: #5a6c7d; font-size: 14px;" + ), + + p( + icon("envelope"), + strong(" Email:"), + " [CONTACT US EMAIL]", + style = "margin: 5px 0; color: #34495e; font-size: 14px;" + ) ) ``` @@ -1193,7 +1506,7 @@ output$normalized_storms_full_table <- renderDT({ order = list(0, 'asc'), server = T ) - ) %>% + ) %>% formatCurrency(c("mmh", "mmp"), "$", digits = 0) }) @@ -1208,30 +1521,30 @@ Column {data-width=350} # Tracking - Storms Map output$all_storms_map <- renderLeaflet({ - leaflet() %>% - addProviderTiles("Stadia.AlidadeSmooth") %>% + leaflet() %>% + addProviderTiles("Stadia.AlidadeSmooth") %>% addCircleMarkers( data = all_conus_landfalls, lng = ~lon, lat = ~lat, radius = 2, - popup = ~paste0(storm_name, " ", storm_year), + popup = ~ paste0(storm_name, " ", storm_year), weight = 0, color = "blue", fillColor = "blue", fillOpacity = 0.5 - ) %>% + ) %>% addCircles( data = all_conus_landfalls, lng = ~lon, lat = ~lat, radius = ~rmw_meters, - popup = ~paste0(storm_name, " ", storm_year), + popup = ~ paste0(storm_name, " ", storm_year), weight = 1, color = "blue", fillColor = "blue", fillOpacity = 0.05 - ) + ) }) leafletOutput("all_storms_map", height = "100%") @@ -1246,19 +1559,23 @@ fatality_years <- seq(1900, 2010, by = 10) direct_deaths <- c(6000, 275, 0, 408, 26, 654, 466, 213, 104, 228, 1136, 321) indirect_deaths <- c(0, 0, 0, 0, 0, 1, 8, 15, 40, 54, 1171, 368) -yearly_fatalities <- data.frame(fatality_years, direct_deaths, indirect_deaths) %>% +yearly_fatalities <- data.frame( + fatality_years, + direct_deaths, + indirect_deaths +) %>% mutate( fatality_years = as.Date(paste0(fatality_years, "-01-01")) ) -yearly_fatalities_ts <- yearly_fatalities %>% - select(-fatality_years) %>% +yearly_fatalities_ts <- yearly_fatalities %>% + select(-fatality_years) %>% xts(order.by = yearly_fatalities$fatality_years) output$decade_fatalities <- renderDygraph( - dygraph(yearly_fatalities_ts, main = "Fatalities By Decade") %>% - dySeries("direct_deaths", label = "Direct Deaths") %>% - dySeries("indirect_deaths", label = "Indirect Deaths") %>% + dygraph(yearly_fatalities_ts, main = "Fatalities By Decade") %>% + dySeries("direct_deaths", label = "Direct Deaths") %>% + dySeries("indirect_deaths", label = "Indirect Deaths") %>% dyRangeSelector() ) @@ -1280,29 +1597,43 @@ traffic_accident_yearly <- c(0, 0, 0, 0, 0, 0, 5, 0, 0, 8, 26, 11) electrocution_yearly <- c(0, 0, 0, 0, 0, 0, 2, 0, 0, 5, 2, 7) other_yearly <- c(0, 0, 0, 0, 5, 0, 5, 11, 15, 13, 37, 7) -yearly_fatalities_type <- data.frame(fatality_years, surge_yearly, surf_yearly, rough_seas_yearly, rip_current_yearly, freshwater_floods_yearly, wind_yearly, tree_fall_yearly, tornado_yearly, traffic_yearly, traffic_accident_yearly, electrocution_yearly, other_yearly) %>% +yearly_fatalities_type <- data.frame( + fatality_years, + surge_yearly, + surf_yearly, + rough_seas_yearly, + rip_current_yearly, + freshwater_floods_yearly, + wind_yearly, + tree_fall_yearly, + tornado_yearly, + traffic_yearly, + traffic_accident_yearly, + electrocution_yearly, + other_yearly +) %>% mutate( fatality_years = as.Date(paste0(fatality_years, "-01-01")) ) -yearly_fatalities_type_ts <- yearly_fatalities_type %>% - select(-fatality_years) %>% +yearly_fatalities_type_ts <- yearly_fatalities_type %>% + select(-fatality_years) %>% xts(order.by = yearly_fatalities_type$fatality_years) output$decade_fatalities_type <- renderDygraph( - dygraph(yearly_fatalities_type_ts, main = "Fatality Types By Decade") %>% - dySeries("surge_yearly", label = "Surge") %>% - dySeries("surf_yearly", label = "Surf") %>% - dySeries("rough_seas_yearly", label = "Rough Seas") %>% - dySeries("rip_current_yearly", label = "Rip Current") %>% - dySeries("freshwater_floods_yearly", label = "Freshwater Floods") %>% - dySeries("wind_yearly", label = "Wind") %>% - dySeries("tree_fall_yearly", label = "Tree Fall") %>% - dySeries("tornado_yearly", label = "Tornado") %>% - dySeries("traffic_yearly", label = "Traffic") %>% - dySeries("traffic_accident_yearly", label = "Traffic Accident") %>% - dySeries("electrocution_yearly", label = "Electrocution") %>% - dySeries("other_yearly", label = "Other") %>% + dygraph(yearly_fatalities_type_ts, main = "Fatality Types By Decade") %>% + dySeries("surge_yearly", label = "Surge") %>% + dySeries("surf_yearly", label = "Surf") %>% + dySeries("rough_seas_yearly", label = "Rough Seas") %>% + dySeries("rip_current_yearly", label = "Rip Current") %>% + dySeries("freshwater_floods_yearly", label = "Freshwater Floods") %>% + dySeries("wind_yearly", label = "Wind") %>% + dySeries("tree_fall_yearly", label = "Tree Fall") %>% + dySeries("tornado_yearly", label = "Tornado") %>% + dySeries("traffic_yearly", label = "Traffic") %>% + dySeries("traffic_accident_yearly", label = "Traffic Accident") %>% + dySeries("electrocution_yearly", label = "Electrocution") %>% + dySeries("other_yearly", label = "Other") %>% dyRangeSelector() ) @@ -1311,15 +1642,28 @@ dygraphOutput("decade_fatalities_type") ### {data-height=500} ```{r eval=FALSE, include=FALSE} -fatality_type <- c("Surge", "Surf", "Rough Seas", "Rip Current", "Floods", "Wind", "Tree Fall", "Tornado", "Traffic", "Traffic Accident", "Electrocution", "Other") +fatality_type <- c( + "Surge", + "Surf", + "Rough Seas", + "Rip Current", + "Floods", + "Wind", + "Tree Fall", + "Tornado", + "Traffic", + "Traffic Accident", + "Electrocution", + "Other" +) fatality_totals <- c(520, 56, 77, 23, 826, 131, 91, 88, 10, 45, 16, 56) aggregate_fatality_types <- data.frame(fatality_type, fatality_totals) output$aggregate_fatalities <- renderBillboarder( - billboarder() %>% - bb_piechart(aggregate_fatality_types) - #%>% bb_legend(position = "right") + billboarder() %>% + bb_piechart(aggregate_fatality_types) + #%>% bb_legend(position = "right") ) billboarderOutput("aggregate_fatalities") diff --git a/queries.R b/queries.R index 28a5af2..708ee6b 100644 --- a/queries.R +++ b/queries.R @@ -9,7 +9,9 @@ macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" #baseDir <- macdir baseDir <- linuxdir -config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml")) +config <- config::get( + file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml") +) # SUPABASE CON con <- dbConnect( @@ -53,7 +55,7 @@ view.simplified_county_geom <- tbl(con, "simplified_county_geom") view.all_loss_storms_tracks <- tbl(con, "all_loss_storms_tracks") view.all_conus_landfalls <- tbl(con, "all_conus_landfalls") -#qry <- econ.storm_base_loss %>% +#qry <- econ.storm_base_loss %>% # left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name")) #show_query(qry) @@ -88,11 +90,11 @@ disconnect_db <- function() { dbDisconnect(con) } -# splits full_lf_id into lf_type and lf_id +# 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)) } @@ -101,68 +103,77 @@ split_full_lf_id <- function(full_lf_id) { # returns a list of loss storms we have data on get_all_loss_storms <- function() { query <- view.all_loss_storms - + result <- query %>% collect() - + return(result) } # returns a list of latest normalized losses get_latest_aggregate_losses <- function() { query <- view.all_normalized_losses - + result <- query %>% collect() - + return(result) } # returns unique lf ids for a storm get_unique_lf_ids <- function(storm) { - query <- view.all_loss_landfalls %>% + query <- view.all_loss_landfalls %>% filter( storm_basin == storm$storm_basin, storm_year == storm$storm_year, storm_name == storm$storm_name - ) %>% + ) %>% 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 + 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 <- view.yearly_normalized_losses %>% + + query <- view.yearly_normalized_losses %>% 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( - normalization_year, mmh, mmp + normalization_year, + mmh, + mmp ) - + result <- query %>% collect() - + return(result) } test_query <- function() { - result <- dbGetQuery(con, "WITH yearly_totals AS ( + result <- dbGetQuery( + con, + "WITH yearly_totals AS ( SELECT year, SUM(population) as total_population, @@ -188,63 +199,71 @@ SELECT ROUND(total_housing_units / base_housing, 4) as housing_index FROM yearly_totals CROSS JOIN base_year -ORDER BY year;") +ORDER BY year;" + ) - result <- result %>% + result <- result %>% mutate( year = as.Date(paste0(year, "-01-01")) - ) %>% + ) %>% select( - year, population_index, housing_index + year, + population_index, + housing_index ) - - result_ts <- result %>% - select(-year) %>% + + result_ts <- result %>% + select(-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 %>% + 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 + 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 get_hurdat_landfalls <- function(storm) { - query <- view.hurdat_track %>% + query <- view.hurdat_track %>% filter( storm_basin == storm$storm_basin, storm_year == storm$storm_year, storm_name == storm$storm_name, record_identifier == "L" - ) %>% + ) %>% select( - datetime, + datetime, lon, lat, rmw, pressure, windspeed ) - + result <- query %>% collect() - + #return( # list( # data = result, @@ -253,31 +272,31 @@ get_hurdat_landfalls <- function(storm) { # timestamp = Sys.time() # ) #) - + return(result) } # returns all tracked storm conus landfalls get_all_conus_landfalls <- function() { query <- view.all_conus_landfalls - + result <- query %>% collect() - + return(result) } # returns all storm tracks from HURDAT get_all_hurdat_tracks <- function() { query <- view.all_loss_storms_tracks - + result <- query %>% collect() - + return(result) } # returns storm track from HURDAT get_hurdat_track <- function(storm) { - query <- view.hurdat_track %>% + query <- view.hurdat_track %>% filter( storm_basin == storm$storm_basin, storm_year == storm$storm_year, @@ -289,13 +308,13 @@ get_hurdat_track <- function(storm) { lon, lat, rmw, - pressure, + pressure, windspeed, record_identifier, rmw_meters ) - - result <- query %>% + + result <- query %>% collect() %>% mutate( formatted_datetime = paste0( @@ -312,51 +331,53 @@ get_hurdat_track <- function(storm) { lon, lat, rmw, - pressure, + pressure, windspeed, record_identifier, rmw_meters ) - + 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 %>% + + 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 %>% + + baseline_metrics <- metrics.pop_and_housing %>% filter( year == storm$storm_year - ) %>% - inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% + ) %>% + 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 %>% + ) + + 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")) %>% + ) %>% + 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) - ) %>% + normalized_population = as.numeric(population) / + as.numeric(baseline_population), + normalized_housing = as.numeric(housing_units) / + as.numeric(baseline_housing) + ) %>% select( state_fips, county_fips, @@ -366,12 +387,17 @@ get_normalized_metric_growth <- function(storm, full_lf_id) { normalized_population, normalized_housing ) - - query <- normalized_metrics %>% - inner_join(public.counties, by = c("state_fips" = "statefp", "county_fips" = "countyfp")) %>% + + query <- normalized_metrics %>% + inner_join( + public.counties, + by = c("state_fips" = "statefp", "county_fips" = "countyfp") + ) %>% mutate( - geom_wkt = sql("ST_AsText(ST_SimplifyPreserveTopology(ST_Transform(geom, 4326), .001))") - ) %>% + geom_wkt = sql( + "ST_AsText(ST_SimplifyPreserveTopology(ST_Transform(geom, 4326), .001))" + ) + ) %>% select( state_fips, county_fips, @@ -381,17 +407,17 @@ get_normalized_metric_growth <- function(storm, full_lf_id) { normalized_population, normalized_housing, geom_wkt - ) %>% + ) %>% arrange(state_fips, county_fips, year) - - #query <- normalized_metrics %>% + + #query <- normalized_metrics %>% # inner_join( # public.counties, - # by = c("state_fips" = "statefp", "county_fips" = "countyfp") - # ) %>% + # by = c("state_fips" = "statefp", "county_fips" = "countyfp") + # ) %>% # mutate( # geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))") - # ) %>% + # ) %>% # select( # state_fips, # county_fips, @@ -401,10 +427,10 @@ get_normalized_metric_growth <- function(storm, full_lf_id) { # normalized_population, # normalized_housing, # geom_wkt - # ) %>% + # ) %>% # arrange(state_fips, county_fips, year) - + result <- query %>% collect() - + return(result) }