mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
update map tile provider and add hurricane cat colors
This commit is contained in:
+128
-66
@@ -42,6 +42,7 @@ library(scales)
|
||||
library(billboarder)
|
||||
library(shinyWidgets)
|
||||
library(paletteer)
|
||||
library(shinyjs)
|
||||
|
||||
# local testing env setup
|
||||
os <- Sys.info()["sysname"]
|
||||
@@ -69,6 +70,8 @@ config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/con
|
||||
|
||||
source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R"))
|
||||
|
||||
useShinyjs()
|
||||
|
||||
# pull static data
|
||||
loss_storms <- get_all_loss_storms()
|
||||
|
||||
@@ -244,40 +247,9 @@ Col {data-width=500 .tabset}
|
||||
# TODO: implement hurricane category status
|
||||
|
||||
storm_track <- reactive({
|
||||
req(storm_selection$is_selected)
|
||||
req(storm_selection, storm_selection$is_selected)
|
||||
result <- get_hurdat_track(storm_selection)
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
output$track_map <- renderLeaflet({
|
||||
leaflet() %>%
|
||||
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18))
|
||||
})
|
||||
|
||||
observe({
|
||||
req(storm_selection)
|
||||
|
||||
storm_track <- storm_track()
|
||||
|
||||
first_lf <- storm_track %>%
|
||||
filter(
|
||||
record_identifier == "L"
|
||||
) %>%
|
||||
arrange(
|
||||
desc(datetime)
|
||||
)
|
||||
|
||||
if(nrow(first_lf) > 0) {
|
||||
map_center <- first_lf %>%
|
||||
head(1)
|
||||
}else{
|
||||
map_center <- data.frame(
|
||||
lon = c(-76),
|
||||
lat = c(35)
|
||||
)
|
||||
}
|
||||
|
||||
# HURDAT storm status
|
||||
# TD – Tropical cyclone of tropical depression intensity (< 34 knots)
|
||||
# TS – Tropical cyclone of tropical storm intensity (34-63 knots)
|
||||
@@ -302,71 +274,158 @@ observe({
|
||||
# Green dashed (- -) Wave/Low/Disturbance WV/LO/DB -- -- --
|
||||
# Black hatched (++) Extratropical Cyclone EX -- -- --
|
||||
|
||||
storm_track <- storm_track %>%
|
||||
# Category Sustained Windspeed (knots)
|
||||
# 1 64-82
|
||||
# 2 83-95
|
||||
# 3 96-112
|
||||
# 4 113-136
|
||||
# 5 137+
|
||||
|
||||
# Preprocess the track data with colors
|
||||
result <- result %>%
|
||||
mutate(
|
||||
line_color = case_when(
|
||||
storm_status == "TD" ~ "green",
|
||||
storm_status == "TS" ~ "#FFDF00",
|
||||
storm_status == "HU" ~ "magenta",
|
||||
storm_status == "EX" ~ "black",
|
||||
storm_status == "SD" ~ "blue",
|
||||
storm_status == "SS" ~ "lightblue",
|
||||
storm_status == "LO" ~ "green",
|
||||
storm_status == "WV" ~ "green",
|
||||
storm_status == "DB" ~ "green",
|
||||
TRUE ~ "gray"
|
||||
)
|
||||
)
|
||||
|
||||
proxy <- leafletProxy("track_map") %>%
|
||||
clearShapes() %>%
|
||||
clearMarkers() %>%
|
||||
# Tropical Depression - Green
|
||||
storm_status == "TD" ~ "#2AFF00",
|
||||
|
||||
# Tropical Storm - Yellow
|
||||
storm_status == "TS" ~ "#FFED2C",
|
||||
|
||||
# Hurricane Cat 1 - Red
|
||||
windspeed >= 64 & windspeed <= 82 ~ "#FF4343",
|
||||
|
||||
# Hurricane Cat 2 - Pink
|
||||
windspeed >= 83 & windspeed <= 95 ~ "#FF6FFF",
|
||||
|
||||
# Hurricane Cat 3 - Magenta
|
||||
windspeed >= 96 & windspeed <= 112 ~ "#FF23D3",
|
||||
|
||||
# Hurricane Cat 4 - Purple
|
||||
windspeed >= 113 & windspeed <= 136 ~ "#C916FF",
|
||||
|
||||
# Hurricane Cate 5 - White
|
||||
windspeed >= 137 ~ "#FFFFFF",
|
||||
|
||||
# Extratropical Cyclone
|
||||
storm_status == "EX" ~ "#000000",
|
||||
|
||||
# Subtropical Depression
|
||||
storm_status == "SD" ~ "#0055FF",
|
||||
|
||||
# Subtropical Storm
|
||||
storm_status == "SS" ~ "#6CE2FF",
|
||||
|
||||
# Low
|
||||
storm_status == "LO" ~ "#2AFF00",
|
||||
|
||||
# Wave
|
||||
storm_status == "WV" ~ "#2AFF00",
|
||||
|
||||
# Disturbance
|
||||
storm_status == "DB" ~ "#2AFF00",
|
||||
|
||||
# Missing
|
||||
TRUE ~ "#CCCCCC"
|
||||
),
|
||||
line_stroke = case_when(
|
||||
storm_status == "TD" ~ "0",
|
||||
storm_status == "TS" ~ "0",
|
||||
storm_status == "HU" ~ "0",
|
||||
storm_status == "EX" ~ "0",
|
||||
storm_status == "SD" ~ "0",
|
||||
storm_status == "SS" ~ "0",
|
||||
storm_status == "LO" ~ "5,10",
|
||||
storm_status == "WV" ~ "5,10",
|
||||
storm_status == "DB" ~ "5,10",
|
||||
TRUE ~ "0"
|
||||
)
|
||||
) %>%
|
||||
arrange(datetime)
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
# Reactive for map center based on storm track
|
||||
map_center <- reactive({
|
||||
track_data <- storm_track()
|
||||
|
||||
first_lf <- track_data %>%
|
||||
filter(record_identifier == "L") %>%
|
||||
arrange(desc(datetime))
|
||||
|
||||
if(nrow(first_lf) > 0) {
|
||||
center <- first_lf %>%
|
||||
head(1) %>%
|
||||
select(lon, lat)
|
||||
} else {
|
||||
center <- data.frame(
|
||||
lon = -76,
|
||||
lat = 35
|
||||
)
|
||||
}
|
||||
|
||||
return(center)
|
||||
})
|
||||
|
||||
output$track_map <- renderLeaflet({
|
||||
track_data <- storm_track()
|
||||
center <- map_center()
|
||||
|
||||
map <- leaflet() %>%
|
||||
addProviderTiles("Stadia.AlidadeSmooth",
|
||||
options = providerTileOptions(updateWhenIdle = T)) %>%
|
||||
setView(
|
||||
lng = map_center$lon,
|
||||
lat = map_center$lat,
|
||||
lng = center$lon,
|
||||
lat = center$lat,
|
||||
zoom = 4
|
||||
)
|
||||
|
||||
if (nrow(storm_track) >= 2) {
|
||||
storm_track <- storm_track %>% arrange(datetime)
|
||||
if (nrow(track_data) >= 2) {
|
||||
for (i in 1:(nrow(track_data) - 1)) {
|
||||
segment_data <- track_data[i:(i+1), ]
|
||||
|
||||
for (i in 1:(nrow(storm_track) - 1)) {
|
||||
segment_data <- storm_track[i:(i+1), ]
|
||||
|
||||
proxy <- proxy %>%
|
||||
map <- map %>%
|
||||
addPolylines(
|
||||
data = segment_data,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
weight = 2,
|
||||
color = storm_track$line_color[i],
|
||||
opacity = 0.8
|
||||
color = track_data$line_color[i],
|
||||
dashArray = track_data$line_stroke[i],
|
||||
opacity = 1
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
proxy %>%
|
||||
map <- map %>%
|
||||
addCircleMarkers(
|
||||
data = storm_track,
|
||||
data = track_data,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = 1,
|
||||
radius = 2,
|
||||
color = ~line_color,
|
||||
fillOpacity = 0.8,
|
||||
fillOpacity = 1,
|
||||
popup = ~storm_status
|
||||
) %>%
|
||||
)
|
||||
|
||||
landfall_data <- track_data %>%
|
||||
filter(record_identifier == "L")
|
||||
|
||||
if(nrow(landfall_data) > 0) {
|
||||
map <- map %>%
|
||||
addCircleMarkers(
|
||||
data = storm_track %>% filter(record_identifier == "L"),
|
||||
data = landfall_data,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = 5,
|
||||
weight = 0,
|
||||
color = "red",
|
||||
fillColor = "red",
|
||||
fillOpacity = 0.8
|
||||
fillOpacity = 1
|
||||
) %>%
|
||||
addCircles(
|
||||
data = storm_track %>% filter(record_identifier == "L"),
|
||||
data = landfall_data,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = ~rmw_meters,
|
||||
@@ -375,6 +434,9 @@ observe({
|
||||
fillColor = "red",
|
||||
fillOpacity = 0.3
|
||||
)
|
||||
}
|
||||
|
||||
return(map)
|
||||
})
|
||||
|
||||
leafletOutput("track_map", height = "100%")
|
||||
|
||||
Reference in New Issue
Block a user