diff --git a/dashboard.Rmd b/dashboard.Rmd index 0d9619e..02d2752 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -1014,7 +1014,69 @@ 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, +) + +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} --- ### Impact Map {.no-padding} @@ -1023,35 +1085,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} --- @@ -1059,18 +1116,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, ] @@ -1084,41 +1130,152 @@ 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) { + rmw_meters <- input$impact_rmw_slider * 1852 + + leafletProxy("impact_analysis_map") %>% + setView(lat = new_lat, lng = new_lon, zoom = 9) %>% + 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", + 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", + 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%" @@ -1189,6 +1346,7 @@ div( "impact_rmw_multiplier", label = "RMW Multiplier", choices = c("1x", "2x", "3x"), + selected = "2x", status = "outline-primary rounded-0", justified = T ), diff --git a/queries.R b/queries.R index 7684f9e..100f56a 100644 --- a/queries.R +++ b/queries.R @@ -57,7 +57,8 @@ 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") +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")) @@ -449,7 +450,31 @@ 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() + + 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()