dylan/hurricane_normalization_app
1
0
Fork 0
mirror of https://github.com/dylanbenzi/hurricane_normalization_app.git synced 2026-07-30 05:08:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

fix merge conflicts

Browse Source
This commit is contained in:
dylan
2025-09-10 12:36:31 -04:00
parent dd9e5e14d3 b3dfa529f2
commit fd917e4106
2 changed files with 244 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dashboard.Rmd
+217 -59
View File
@@ -1014,7 +1014,69 @@ Storm Fatalities {data-navmenu="Storm Details"}
Normalization Calculator {data-navmenu="Compute"} 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} ### Impact Map {.no-padding}
@@ -1023,35 +1085,30 @@ Column {data-width=700 .tabset}
output$impact_analysis_map <- renderLeaflet({ output$impact_analysis_map <- renderLeaflet({
leaflet() %>% leaflet() %>%
addProviderTiles("Stadia.AlidadeSmooth") %>% addProviderTiles("Stadia.AlidadeSmooth") #%>%
setView(lng = -80.3, lat = 25.6, zoom = 10) %>% #setView(lng = -80.3, lat = 25.6, zoom = 10) %>%
addCircles( #addCircles(
lng = -80.3, # lng = -80.3,
lat = 25.6, # lat = 25.6,
radius = 37040, # radius = 37040,
color = "blue", # color = "blue",
weight = 2, # weight = 2,
opacity = 0.3 # opacity = 0.3
) %>% #) %>%
addCircleMarkers( #addCircleMarkers(
lng = -80.3, # lng = -80.3,
lat = 25.6, # lat = 25.6,
radius = 5, # radius = 5,
weight = 0, # weight = 0,
color = "blue", # color = "blue",
fillColor = "blue", # fillColor = "blue",
fillOpacity = 0.6 # fillOpacity = 0.6
) #)
}) })
leafletOutput("impact_analysis_map", height = "100%") leafletOutput("impact_analysis_map", height = "100%")
``` ```
### Impact Data {.no-padding}
```{r}
# Calculator - Impact Data
```
Column {data-width=300} Column {data-width=300}
--- ---
@@ -1059,18 +1116,7 @@ Column {data-width=300}
```{r} ```{r}
# Calculator - Input # Calculator - Input
# TODO: add data population and compute # 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, { observeEvent(input$impact_storm_year, {
stormsByChosenYear <- all_lf_type_storms[all_lf_type_storms$storm_year == 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( div(
h6("Storm Selector"), 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( fluidRow(
column( column(
6, 6,
selectInput( selectInput(
"impact_storm_lf_type", "impact_storm_basin",
label = NULL, label = NULL,
choices = "LF", choices = "AL",
width = "100%" width = "100%"
) ),
), ),
column( column(
6, 6,
selectInput( 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, label = NULL,
choices = "1", choices = "1",
width = "100%" width = "100%"
@@ -1189,6 +1346,7 @@ div(
"impact_rmw_multiplier", "impact_rmw_multiplier",
label = "RMW Multiplier", label = "RMW Multiplier",
choices = c("1x", "2x", "3x"), choices = c("1x", "2x", "3x"),
selected = "2x",
status = "outline-primary rounded-0", status = "outline-primary rounded-0",
justified = T justified = T
), ),
queries.R
+27 -2
View File
@@ -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.all_conus_landfalls <- tbl(con, "all_conus_landfalls")
view.hurdat_ids <- tbl(con, "hurdat_ids") view.hurdat_ids <- tbl(con, "hurdat_ids")
view.all_lf_type_landfalls <- tbl(con, "all_lf_type_landfalls") 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 %>% #qry <- econ.storm_base_loss %>%
# left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name")) # 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 # returns all lf type landfalls
get_all_lf_type_landfalls <- function() { 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() result <- query %>% collect()