mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
add better markers and path to storm track map
This commit is contained in:
+73
-38
@@ -163,13 +163,7 @@ katrinaLfTwoCountyMetrics <- metrics.pop_and_housing %>%
|
|||||||
|
|
||||||
###### REACTIVE VALUES
|
###### 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)),
|
mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)),
|
||||||
by = c("storm_basin", "storm_year", "storm_name")) %>%
|
by = c("storm_basin", "storm_year", "storm_name")) %>%
|
||||||
select(
|
select(
|
||||||
hurdatId, storm_name, storm_year
|
hurdatId, storm_basin, storm_name, storm_year
|
||||||
) %>%
|
) %>%
|
||||||
collect()
|
collect()
|
||||||
|
|
||||||
@@ -262,6 +256,15 @@ normalized_losses_2024 <- econ.normalized_landfalls %>%
|
|||||||
) %>%
|
) %>%
|
||||||
filter(!is.na(mmh) & !is.na(mmp)) %>%
|
filter(!is.na(mmh) & !is.na(mmp)) %>%
|
||||||
collect()
|
collect()
|
||||||
|
|
||||||
|
storm_selection <- reactiveValues(
|
||||||
|
storm_year = NULL,
|
||||||
|
storm_name = NULL,
|
||||||
|
storm_basin = NULL,
|
||||||
|
lf_id = NULL,
|
||||||
|
is_selected = FALSE,
|
||||||
|
is_table_selection = FALSE,
|
||||||
|
)
|
||||||
```
|
```
|
||||||
|
|
||||||
```{r}
|
```{r}
|
||||||
@@ -397,7 +400,7 @@ Col {data-width=500}
|
|||||||
```{r}
|
```{r}
|
||||||
fluidRow(
|
fluidRow(
|
||||||
column(6,
|
column(6,
|
||||||
h5("Select Storm Name and Year"),
|
selectInput("stormBasin", "Select Basin", choices = "AL"),
|
||||||
selectInput("stormYear", "Select Year", choices = loss_storms$storm_year),
|
selectInput("stormYear", "Select Year", choices = loss_storms$storm_year),
|
||||||
selectInput("stormName", "Select Storm", choices = NULL),
|
selectInput("stormName", "Select Storm", choices = NULL),
|
||||||
actionButton("selectStorm", "Submit", class = "btn-primary")
|
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, {
|
observeEvent(input$stormYear, {
|
||||||
stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ]
|
stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ]
|
||||||
|
|
||||||
|
stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear)
|
||||||
|
|
||||||
updateSelectInput(session, "stormName",
|
updateSelectInput(session, "stormName",
|
||||||
choices = stormsByChosenYear$storm_name,
|
choices = stormsByYear$storm_name,
|
||||||
selected = NULL)
|
selected = NULL
|
||||||
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
observeEvent(input$selectStorm, {
|
observeEvent(input$selectStorm, {
|
||||||
|
storm_selection$storm_basin <- input$stormBasin
|
||||||
storm_selection$storm_year <- input$stormYear
|
storm_selection$storm_year <- input$stormYear
|
||||||
storm_selection$storm_name <- input$stormName
|
storm_selection$storm_name <- input$stormName
|
||||||
storm_selection$storm_basin <- "AL"
|
|
||||||
storm_selection$is_selected <- TRUE
|
storm_selection$is_selected <- TRUE
|
||||||
|
|
||||||
showNotification("Storm selection updated!", type = "message")
|
showNotification("Storm selection updated!", type = "message")
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
```
|
```
|
||||||
|
|
||||||
### All Storms {data-height=500 .no-padding}
|
### All Storms {data-height=500 .no-padding}
|
||||||
```{r}
|
```{r}
|
||||||
output$allStorms <- renderDT({
|
output$normalized_storms_table <- renderDT({
|
||||||
datatable(
|
datatable(
|
||||||
normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp),
|
normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp),
|
||||||
rownames = F,
|
rownames = F,
|
||||||
|
selection = "single",
|
||||||
options = list(
|
options = list(
|
||||||
pageLength = 1000,
|
pageLength = 1000,
|
||||||
order = list(2, 'desc'),
|
order = list(2, 'desc'),
|
||||||
@@ -463,7 +455,7 @@ output$allStorms <- renderDT({
|
|||||||
formatCurrency(c("MMH24", "MMP24"), "$", digits = 0)
|
formatCurrency(c("MMH24", "MMP24"), "$", digits = 0)
|
||||||
})
|
})
|
||||||
|
|
||||||
DTOutput("allStorms")
|
DTOutput("normalized_storms_table")
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
||||||
@@ -666,8 +658,6 @@ Col {data-width=500}
|
|||||||
|
|
||||||
### Fatalities {data-height=200}
|
### Fatalities {data-height=200}
|
||||||
```{r}
|
```{r}
|
||||||
# TODO: fatalities dashboard
|
|
||||||
|
|
||||||
fluidRow(
|
fluidRow(
|
||||||
column(6,
|
column(6,
|
||||||
HTML('
|
HTML('
|
||||||
@@ -734,20 +724,65 @@ DTOutput("landfalls_table")
|
|||||||
|
|
||||||
### Storm Track {data-height=500 .no-padding}
|
### Storm Track {data-height=500 .no-padding}
|
||||||
```{r}
|
```{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({
|
output$trackMap <- renderLeaflet({
|
||||||
leaflet() %>%
|
leaflet() %>%
|
||||||
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>%
|
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>%
|
||||||
setView(lng = -80, lat = 32, zoom = 4) %>%
|
setView(lng = -80, lat = 32, zoom = 4) %>%
|
||||||
|
addPolylines(
|
||||||
|
data = storm_track(),
|
||||||
|
lng = ~lon,
|
||||||
|
lat = ~lat,
|
||||||
|
weight = 4,
|
||||||
|
color = "blue"
|
||||||
|
) %>%
|
||||||
addCircleMarkers(
|
addCircleMarkers(
|
||||||
#data = katrinaTrack,
|
data = storm_track() %>% filter(record_identifier == "L"),
|
||||||
#lng = ~Longitude,
|
|
||||||
#lat = ~Latitude,
|
|
||||||
data = selected.best_track(),
|
|
||||||
lng = ~lon,
|
lng = ~lon,
|
||||||
lat = ~lat,
|
lat = ~lat,
|
||||||
radius = 5,
|
radius = 5,
|
||||||
color = ~ifelse(record_identifier == "L", "red", "blue"),
|
weight = 0,
|
||||||
fillColor = ~ifelse(record_identifier == "L", "red", "blue")
|
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
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user