add better markers and path to storm track map

This commit is contained in:
2025-06-05 22:21:51 -04:00
parent 858868c828
commit a0445a3361
+74 -39
View File
@@ -163,13 +163,7 @@ katrinaLfTwoCountyMetrics <- metrics.pop_and_housing %>%
###### REACTIVE VALUES
storm_selection <- reactiveValues(
storm_year = NULL,
storm_name = NULL,
storm_basin = NULL,
lf_id = NULL,
is_selected = FALSE
)
######
@@ -209,7 +203,7 @@ loss_storms <- econ.storm_base_loss %>%
mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)),
by = c("storm_basin", "storm_year", "storm_name")) %>%
select(
hurdatId, storm_name, storm_year
hurdatId, storm_basin, storm_name, storm_year
) %>%
collect()
@@ -262,6 +256,15 @@ normalized_losses_2024 <- econ.normalized_landfalls %>%
) %>%
filter(!is.na(mmh) & !is.na(mmp)) %>%
collect()
storm_selection <- reactiveValues(
storm_year = NULL,
storm_name = NULL,
storm_basin = NULL,
lf_id = NULL,
is_selected = FALSE,
is_table_selection = FALSE,
)
```
```{r}
@@ -397,7 +400,7 @@ Col {data-width=500}
```{r}
fluidRow(
column(6,
h5("Select Storm Name and Year"),
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")
@@ -409,47 +412,36 @@ fluidRow(
)
)
output$storm_selector_table <- renderDT({
datatable(
loss_storms,
rownames = F,
options = list(
pageLength = 1000,
order = list(2, 'desc'),
searching = F,
paging = F,
info = F,
lengthChange = F,
server = T
)
)
})
observeEvent(input$stormYear, {
stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ]
stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear)
updateSelectInput(session, "stormName",
choices = stormsByChosenYear$storm_name,
selected = NULL)
choices = stormsByYear$storm_name,
selected = NULL
)
})
observeEvent(input$selectStorm, {
storm_selection$storm_basin <- input$stormBasin
storm_selection$storm_year <- input$stormYear
storm_selection$storm_name <- input$stormName
storm_selection$storm_basin <- "AL"
storm_selection$is_selected <- TRUE
showNotification("Storm selection updated!", type = "message")
})
```
### All Storms {data-height=500 .no-padding}
```{r}
output$allStorms <- renderDT({
output$normalized_storms_table <- renderDT({
datatable(
normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp),
rownames = F,
selection = "single",
options = list(
pageLength = 1000,
order = list(2, 'desc'),
@@ -463,7 +455,7 @@ output$allStorms <- renderDT({
formatCurrency(c("MMH24", "MMP24"), "$", digits = 0)
})
DTOutput("allStorms")
DTOutput("normalized_storms_table")
```
@@ -666,8 +658,6 @@ Col {data-width=500}
### Fatalities {data-height=200}
```{r}
# TODO: fatalities dashboard
fluidRow(
column(6,
HTML('
@@ -734,21 +724,66 @@ DTOutput("landfalls_table")
### Storm Track {data-height=500 .no-padding}
```{r}
storm_track <- reactive({
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
) %>%
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(),
lng = ~lon,
lat = ~lat,
weight = 4,
color = "blue"
) %>%
addCircleMarkers(
#data = katrinaTrack,
#lng = ~Longitude,
#lat = ~Latitude,
data = selected.best_track(),
data = storm_track() %>% filter(record_identifier == "L"),
lng = ~lon,
lat = ~lat,
radius = 5,
color = ~ifelse(record_identifier == "L", "red", "blue"),
fillColor = ~ifelse(record_identifier == "L", "red", "blue")
)
weight = 0,
color = "red",
fillColor = "red",
fillOpacity = 0.8
) %>%
addCircles(
data = storm_track() %>% filter(record_identifier == "L"),
lng = ~lon,
lat = ~lat,
radius = ~rmw_meters,
weight = 2,
color = "red",
fillColor = "red",
fillOpacity = 0.3
)
})
leafletOutput("trackMap", height="100%")