From 013937bfb269f1b6c242ab489425d5a56b307b1b Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sat, 2 Aug 2025 20:30:52 -0400 Subject: [PATCH 1/5] remove stashed views --- queries.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/queries.R b/queries.R index f81e4d9..7684f9e 100644 --- a/queries.R +++ b/queries.R @@ -55,11 +55,8 @@ view.yearly_normalized_losses <- tbl(con, "yearly_normalized_losses") 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") -<<<<<<< Updated upstream -======= view.hurdat_ids <- tbl(con, "hurdat_ids") view.all_lf_type_landfalls <- tbl(con, "all_lf_type_landfalls") ->>>>>>> Stashed changes #qry <- econ.storm_base_loss %>% # left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name")) From d302d2c59dae57303bdf7caa1b9eee7552c0017d Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sat, 2 Aug 2025 21:31:53 -0400 Subject: [PATCH 2/5] add lfs and lat/lon to calc --- dashboard.Rmd | 166 ++++++++++++++++++++++++++++++++------------------ queries.R | 3 +- 2 files changed, 109 insertions(+), 60 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 67f3e96..420221c 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -1022,7 +1022,20 @@ Storm Fatalities {data-navmenu="Storm Details"} Normalization Calculator {data-navmenu="Compute"} === -Column {data-width=700 .tabset} +```{r} +# Calculator - Setup Code + +calculator_storm_selection <- reactiveValues( + storm_year = NULL, + storm_name = NULL, + storm_basin = NULL, + full_lf_id = NULL, +) + + +``` + +Column {data-width=700} --- ### Impact Map {.no-padding} @@ -1031,35 +1044,30 @@ Column {data-width=700 .tabset} output$impact_analysis_map <- renderLeaflet({ leaflet() %>% - addProviderTiles("Stadia.AlidadeSmooth") %>% - setView(lng = -80.3, lat = 25.6, zoom = 10) %>% - addCircles( - lng = -80.3, - lat = 25.6, - radius = 37040, - color = "blue", - weight = 2, - opacity = 0.3 - ) %>% - addCircleMarkers( - lng = -80.3, - lat = 25.6, - radius = 5, - weight = 0, - color = "blue", - fillColor = "blue", - fillOpacity = 0.6 - ) + addProviderTiles("Stadia.AlidadeSmooth") #%>% + #setView(lng = -80.3, lat = 25.6, zoom = 10) %>% + #addCircles( + # lng = -80.3, + # lat = 25.6, + # radius = 37040, + # color = "blue", + # weight = 2, + # opacity = 0.3 + #) %>% + #addCircleMarkers( + # lng = -80.3, + # lat = 25.6, + # radius = 5, + # weight = 0, + # color = "blue", + # fillColor = "blue", + # fillOpacity = 0.6 + #) }) leafletOutput("impact_analysis_map", height = "100%") ``` -### Impact Data {.no-padding} -```{r} -# Calculator - Impact Data -``` - Column {data-width=300} --- @@ -1067,18 +1075,7 @@ Column {data-width=300} ```{r} # Calculator - Input # TODO: add data population and compute -#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 -# ) -#}) + observeEvent(input$impact_storm_year, { stormsByChosenYear <- all_lf_type_storms[all_lf_type_storms$storm_year == input$impact_storm_year, ] @@ -1092,41 +1089,92 @@ observeEvent(input$impact_storm_year, { ) }) +observeEvent(input$impact_storm_name, { + uniqueLfs <- all_lf_type_storms %>% + filter( + storm_basin == input$impact_storm_basin, + storm_year == input$impact_storm_year, + storm_name == input$impact_storm_name + ) + + updateSelectInput( + session, + "impact_storm_full_lf_id", + choices = uniqueLfs$full_lf_id + ) +}) + +observe({ + req( + input$impact_lat, + input$impact_lon + ) + + new_lat <- as.numeric(input$impact_lat) + new_lon <- as.numeric(input$impact_lon) + + if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) { + leafletProxy("impact_analysis_map") %>% + clearShapes() %>% + clearMarkers() %>% + addCircleMarkers( + lng = new_lon, + lat = new_lat, + radius = 2, + weight = 0, + color = "blue", + fillColor = "blue", + fillOpacity = 0.5 + ) %>% + addCircles( + lng = new_lon, + lat = new_lat, + radius = 18000, + weight = 1, + color = "blue", + fillColor = "blue", + fillOpacity = 0.05 + ) + } +}) + div( h6("Storm Selector"), - selectInput( - "impact_storm_basin", - label = NULL, - choices = "AL", - width = "100%" - ), - selectInput( - "impact_storm_year", - label = NULL, - choices = all_lf_type_storms$storm_year, - width = "100%" - ), - selectInput( - "impact_storm_name", - label = NULL, - choices = NULL, - width = "100%" - ), fluidRow( column( 6, selectInput( - "impact_storm_lf_type", + "impact_storm_basin", label = NULL, - choices = "LF", + choices = "AL", width = "100%" - ) + ), ), column( 6, selectInput( - "impact_storm_lf_id", + "impact_storm_year", + label = NULL, + choices = all_lf_type_storms$storm_year, + width = "100%" + ), + ) + ), + fluidRow( + column( + 6, + selectInput( + "impact_storm_name", + label = NULL, + choices = NULL, + width = "100%" + ), + ), + column( + 6, + selectInput( + "impact_storm_full_lf_id", label = NULL, choices = "1", width = "100%" diff --git a/queries.R b/queries.R index 7684f9e..0932b3a 100644 --- a/queries.R +++ b/queries.R @@ -57,6 +57,7 @@ view.all_loss_storms_tracks <- tbl(con, "all_loss_storms_tracks") view.all_conus_landfalls <- tbl(con, "all_conus_landfalls") view.hurdat_ids <- tbl(con, "hurdat_ids") view.all_lf_type_landfalls <- tbl(con, "all_lf_type_landfalls") +view.lf_id_location <- tbl(con, "lf_id_location") #qry <- econ.storm_base_loss %>% # left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name")) @@ -449,7 +450,7 @@ get_normalized_metric_growth <- function(storm, full_lf_id) { # returns all lf type landfalls get_all_lf_type_landfalls <- function() { - query <- view.all_lf_type_landfalls + query <- view.lf_id_location result <- query %>% collect() From 248665fdf67baaef5a3d62ebddcb6fb1dcf42b66 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 3 Aug 2025 00:46:45 -0400 Subject: [PATCH 3/5] add data population to calc --- dashboard.Rmd | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ queries.R | 26 +++++++++++++++++++++++++- 2 files changed, 74 insertions(+), 1 deletion(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 420221c..27b1322 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -1032,7 +1032,56 @@ calculator_storm_selection <- reactiveValues( full_lf_id = NULL, ) +observeEvent(input$impact_populate_storm, { + calculator_storm_selection$storm_basin = input$impact_storm_basin + calculator_storm_selection$storm_year = input$impact_storm_year + calculator_storm_selection$storm_name = input$impact_storm_name + calculator_storm_selection$full_lf_id = input$impact_storm_full_lf_id + calculator_storm_details <- get_lf_type_factors(calculator_storm_selection) + + updateTextInput( + session, + "impact_lat", + value = calculator_storm_details$lat + ) + + updateTextInput( + session, + "impact_lon", + value = calculator_storm_details$lon + ) + + updateTextInput( + session, + "impact_rmw", + value = calculator_storm_details$rmw + ) + + updateSliderInput( + session, + "impact_rmw_slider", + value = calculator_storm_details$rmw + ) + + updateTextInput( + session, + "impact_base_year", + value = calculator_storm_details$storm_year + ) + + updateTextInput( + session, + "impact_ref_year", + value = "2024" + ) + + updateTextInput( + session, + "impact_base_damage", + value = calculator_storm_details$mwr + ) +}) ``` Column {data-width=700} diff --git a/queries.R b/queries.R index 0932b3a..100f56a 100644 --- a/queries.R +++ b/queries.R @@ -58,7 +58,7 @@ view.all_conus_landfalls <- tbl(con, "all_conus_landfalls") view.hurdat_ids <- tbl(con, "hurdat_ids") view.all_lf_type_landfalls <- tbl(con, "all_lf_type_landfalls") view.lf_id_location <- tbl(con, "lf_id_location") - +view.lf_landfall_gis <- tbl(con, "lf_landfall_gis") #qry <- econ.storm_base_loss %>% # left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name")) @@ -456,3 +456,27 @@ get_all_lf_type_landfalls <- function() { return(result) } + +# returns all storms and factors needed to normalize a lf type landfall +get_all_lf_type_factors <- function() { + query <- view.lf_landfall_gis + + result <- query %>% collect() + + return(result) +} + +# returns one storm and factors needed to normalize a lf type landfall +get_lf_type_factors <- function(storm) { + query <- view.lf_landfall_gis %>% + filter( + storm_basin == storm$storm_basin, + storm_year == storm$storm_year, + storm_name == storm$storm_name, + full_lf_id == storm$full_lf_id + ) + + result <- query %>% collect() + + return(result) +} From f0f1c0e7581218b56bd43f8c544d472183fc3b66 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 3 Aug 2025 01:09:27 -0400 Subject: [PATCH 4/5] add map center on lat/lon change for calc --- dashboard.Rmd | 2 ++ 1 file changed, 2 insertions(+) diff --git a/dashboard.Rmd b/dashboard.Rmd index 27b1322..96d3c8e 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -1164,6 +1164,7 @@ observe({ if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) { leafletProxy("impact_analysis_map") %>% + setView(lat = new_lat, lng = new_lon, zoom = 9) %>% clearShapes() %>% clearMarkers() %>% addCircleMarkers( @@ -1294,6 +1295,7 @@ div( "impact_rmw_multiplier", label = "RMW Multiplier", choices = c("1x", "2x", "3x"), + selected = "2x", status = "outline-primary rounded-0", justified = T ), From b3dfa529f28bf10948c2b7dfa429d9e12bcffa54 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 3 Aug 2025 01:33:24 -0400 Subject: [PATCH 5/5] add rmw inputs to map for calc --- dashboard.Rmd | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 60 insertions(+), 1 deletion(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 96d3c8e..e152d3a 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -1163,6 +1163,8 @@ observe({ new_lon <- as.numeric(input$impact_lon) if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) { + rmw_meters <- input$impact_rmw_slider * 1852 + leafletProxy("impact_analysis_map") %>% setView(lat = new_lat, lng = new_lon, zoom = 9) %>% clearShapes() %>% @@ -1179,7 +1181,64 @@ observe({ addCircles( lng = new_lon, lat = new_lat, - radius = 18000, + radius = rmw_meters, + weight = 1, + color = "blue", + fillColor = "blue", + fillOpacity = 0.05 + ) + } +}) + +observe({ + req(input$impact_rmw) + + if(as.numeric(input$impact_rmw) > 0) { + updateSliderInput( + session, + "impact_rmw_slider", + value = input$impact_rmw + ) + } +}) + +observe({ + req(input$impact_rmw_slider) + + updateTextInput( + session, + "impact_rmw", + value = input$impact_rmw_slider + ) +}) + +observe({ + req(input$impact_rmw, input$impact_rmw_slider) + + rmw_meters <- input$impact_rmw_slider * 1852 + + new_lon = input$impact_storm_lon + new_lat = input$impact_storm_lat + + req(new_lon, new_lat) + + if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) { + leafletProxy("impact_analysis_map") %>% + clearShapes() %>% + clearMarkers() %>% + addCircleMarkers( + lng = new_lon, + lat = new_lat, + radius = 2, + weight = 0, + color = "blue", + fillColor = "blue", + fillOpacity = 0.5 + ) %>% + addCircles( + lng = new_lon, + lat = new_lat, + radius = rmw_meters, weight = 1, color = "blue", fillColor = "blue",