diff --git a/dashboard.Rmd b/dashboard.Rmd index f0e1851..ea8ddd4 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -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,79 +274,169 @@ 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" + + # 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) - proxy <- leafletProxy("track_map") %>% - clearShapes() %>% - clearMarkers() %>% + 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) - - for (i in 1:(nrow(storm_track) - 1)) { - segment_data <- storm_track[i:(i+1), ] + if (nrow(track_data) >= 2) { + for (i in 1:(nrow(track_data) - 1)) { + segment_data <- track_data[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 - ) %>% - addCircleMarkers( - data = storm_track %>% filter(record_identifier == "L"), - lng = ~lon, - lat = ~lat, - radius = 5, - 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 ) + + landfall_data <- track_data %>% + filter(record_identifier == "L") + + if(nrow(landfall_data) > 0) { + map <- map %>% + addCircleMarkers( + data = landfall_data, + lng = ~lon, + lat = ~lat, + radius = 5, + weight = 0, + color = "red", + fillColor = "red", + fillOpacity = 1 + ) %>% + addCircles( + data = landfall_data, + lng = ~lon, + lat = ~lat, + radius = ~rmw_meters, + weight = 2, + color = "red", + fillColor = "red", + fillOpacity = 0.3 + ) + } + + return(map) }) leafletOutput("track_map", height = "100%")