update map tile provider and add hurricane cat colors

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",
+        # Tropical Depression - Green
-        storm_status == "HU" ~ "magenta",
+        storm_status == "TD" ~ "#2AFF00",
-        storm_status == "EX" ~ "black",
+        
-        storm_status == "SD" ~ "blue",
+        # Tropical Storm - Yellow
-        storm_status == "SS" ~ "lightblue",
+        storm_status == "TS" ~ "#FFED2C",
-        storm_status == "LO" ~ "green",
+        
-        storm_status == "WV" ~ "green",
+        # Hurricane Cat 1 - Red
-        storm_status == "DB" ~ "green",
+        windspeed >= 64 & windspeed <= 82 ~ "#FF4343",
-        TRUE ~ "gray"
+        
+        # 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") %>% 
+  return(result)
-    clearShapes() %>% 
+})
-    clearMarkers() %>%
+
+# 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,
+      lng = center$lon,
-      lat = map_center$lat,
+      lat = center$lat,
       zoom = 4
     )
   
-  if (nrow(storm_track) >= 2) {
+  if (nrow(track_data) >= 2) {
-    storm_track <- storm_track %>% arrange(datetime)
+    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],
+          color = track_data$line_color[i],
-          opacity = 0.8
+          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%")