Merge branch 'storm_details'

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()
 
@@ -235,120 +238,280 @@ observe({
 })
 ```
 
-Col {data-width=500 .tabset}
+Col {data-width=500}
 ------------------------------------
 
 ### Track Map {.no-padding}
 ```{r}
 # Overview - Track Map
+# 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)
   
+  # HURDAT storm status
+  # TD – Tropical cyclone of tropical depression intensity (< 34 knots)
+  # TS – Tropical cyclone of tropical storm intensity (34-63 knots)
+  # HU – Tropical cyclone of hurricane intensity (> 64 knots)
+  # EX – Extratropical cyclone (of any intensity)
+  # SD – Subtropical cyclone of subtropical depression intensity (< 34 knots)
+  # SS – Subtropical cyclone of subtropical storm intensity (> 34 knots)
+  # LO – A low that is neither a tropical cyclone, a subtropical cyclone, nor an extratropical cyclone (of any intensity)
+  # WV – Tropical Wave (of any intensity)
+  # DB – Disturbance (of any intensity) 
+  
+  # Line Color          Storm Type                Status    Pressure (mb) Wind (mph)  Wind (knots)
+  # Blue	              Subtropical Depression	  SD        --	          <=38 	      <=33 
+  # Light Blue	        Subtropical Storm	        SS        --	          39-73	      34-63
+  # Green	              Tropical Depression (TD)	TD        --	          <=38	      <=33
+  # Yellow	            Tropical Storm (TS)	      TS        980+	        39-73	      34-63
+  # Red	                Hurricane (Cat 1)	        HU        <=980	        74-95	      64-82
+  # Pink	              Hurricane (Cat 2)	        HU        965-980	      96-110	    83-95
+  # Magenta	            Major Hurricane (Cat 3)	  HU        945-965	      111-129	    96-112
+  # Purple	            Major Hurricane (Cat 4)	  HU        920-945	      130-156	    113-136
+  # White	              Major Hurricane (Cat 5)	  HU        <=920	        157+	      137+
+  # Green dashed (- -)  Wave/Low/Disturbance	    WV/LO/DB  --	          --	        --
+  # Black hatched (++)  Extratropical Cyclone	    EX        --	          --	        --
+  
+  # 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(
+      hurricane_category = case_when(
+        
+        # Hurricane Cat 1
+        storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1,
+        
+        # Hurricane Cat 2
+        storm_status == "HU" & windspeed >= 83 & windspeed <= 95 ~ 2,
+        
+        # Hurricane Cat 3
+        storm_status == "HU" & windspeed >= 96 & windspeed <= 112 ~ 3,
+        
+        # Hurricane Cat 4
+        storm_status == "HU" & windspeed >= 113 & windspeed <= 136 ~ 4,
+        
+        # Hurricane Cate 5
+        storm_status == "HU" & windspeed >= 137 ~ 5,
+      ),
+      line_color = case_when(
+        
+        # Tropical Depression - Green
+        storm_status == "TD" ~ "#2AFF00",
+        
+        # Tropical Storm - Yellow
+        storm_status == "TS" ~ "#FFD020",
+        
+        # Hurricane Cat 1 - Red
+        hurricane_category == 1 ~ "#FF4343",
+        
+        # Hurricane Cat 2 - Pink
+        hurricane_category == 2 ~ "#FF6FFF",
+        
+        # Hurricane Cat 3 - Magenta
+        hurricane_category == 3 ~ "#FF23D3",
+        
+        # Hurricane Cat 4 - Purple
+        hurricane_category == 4 ~ "#C916FF",
+        
+        # Hurricane Cate 5 - White
+        hurricane_category == 5 ~ "#FFFFFF",
+        
+        # Extratropical Cyclone
+        storm_status == "EX" ~ "#202020",
+        
+        # Subtropical Depression
+        storm_status == "SD" ~ "#0055FF",
+        
+        # Subtropical Storm
+        storm_status == "SS" ~ "#6CE2FF",
+        
+        # Low
+        storm_status == "LO" ~ "#A1A1A1",
+        
+        # Wave
+        storm_status == "WV" ~ "#A1A1A1",
+        
+        # Disturbance
+        storm_status == "DB" ~ "#A1A1A1",
+        
+        # Missing
+        TRUE ~ "#FF5C00"
+      ),
+      popup_category = case_when(
+        storm_status == "TD" ~ "TD",
+        storm_status == "TS" ~ "TS",
+        hurricane_category == 1 ~ "H1",
+        hurricane_category == 2 ~ "H2",
+        hurricane_category == 3 ~ "H3",
+        hurricane_category == 4 ~ "H4",
+        hurricane_category == 5 ~ "H5",
+        storm_status == "EX" ~ "EX",
+        storm_status == "SD" ~ "SD",
+        storm_status == "SS" ~ "SS",
+        storm_status == "LO" ~ "LO",
+        storm_status == "WV" ~ "WV",
+        storm_status == "DB" ~ "DB",
+        TRUE ~ "NA"
+      )
+    ) %>%
+    arrange(datetime)
+  
   return(result)
 })
 
 output$track_map <- renderLeaflet({
-  leaflet() %>% 
+  track_data <- storm_track()
-    addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) 
-})
-
-observe({
-  req(storm_selection)
   
-  storm_track <- storm_track()
+  map <- leaflet() %>% 
-  
+    addProviderTiles("Stadia.AlidadeSmooth") %>% 
-  first_lf <- storm_track %>% 
+    fitBounds(
-    filter(
+      lng1 = min(track_data$lon),
-      record_identifier == "L"
+      lng2 = max(track_data$lon),
-    ) %>% 
+      lat1 = min(track_data$lat),
-    arrange(
+      lat2 = max(track_data$lat)
-      desc(datetime)
     ) 
   
-  if(nrow(first_lf) > 0) {
+  map <- map %>%
-    map_center <- first_lf %>% 
+    leaflet::addLegend(
-      head(1)
+      position = "bottomleft",
-  }else{
+      colors = c(
-    map_center <- data.frame(
+        "#2AFF00",    # TD
-      lon = c(-76),
+        "#FFD020",    # TS
-      lat = c(35)
+        "#FF4343",    # Cat 1
+        "#FF6FFF",    # Cat 2
+        "#FF23D3",    # Cat 3
+        "#C916FF",    # Cat 4
+        "#FFFFFF",    # Cat 5
+        "#202020",    # EX
+        "#0055FF",    # SD
+        "#6CE2FF",    # SS
+        "#A1A1A1",    # LO/WV/DB
+        "#FF5C00"     # Missing
+      ),
+      labels = c(
+        "Tropical Depression (TD)",
+        "Tropical Storm (TS)",
+        "Hurricane Category 1",
+        "Hurricane Category 2", 
+        "Hurricane Category 3",
+        "Hurricane Category 4",
+        "Hurricane Category 5",
+        "Extratropical Cyclone (EX)",
+        "Subtropical Depression (SD)",
+        "Subtropical Storm (SS)",
+        "Low/Wave/Disturbance (LO/WV/DB)",
+        "Missing Data"
+      ),
+      opacity = 1,
+      title = "Track Legend"
     )
-  }
     
-  leafletProxy("track_map", data = storm_track) %>% 
+  
-  clearShapes() %>% 
+  if (nrow(track_data) >= 2) {
-  clearMarkers() %>%
+    for (i in 1:(nrow(track_data) - 1)) {
-  setView(
+      segment_data <- track_data[i:(i+1), ]
-    lng = map_center$lon,
+      
-    lat = map_center$lat,
+      map <- map %>%
-    zoom = 4
+        addPolylines(
-  ) %>% 
+          data = segment_data,
-  addPolylines(
+          lng = ~lon,
-    data = storm_track,
+          lat = ~lat,
-    lng = ~lon,
+          weight = 2,
-    lat = ~lat,
+          color = track_data$line_color[i],
-    weight = 4,
+          opacity = 1
-    color = "blue"
+        )
-  ) %>% 
+    }
-  addCircleMarkers(
+  }
-    data = storm_track %>% filter(record_identifier == "L"),
+  
-    lng = ~lon,
+  map <- map %>%
-    lat = ~lat,
+    addCircleMarkers(
-    radius = 5,
+      data = track_data,
-    weight = 0,
+      lng = ~lon,
-    color = "red",
+      lat = ~lat,
-    fillColor = "red",
+      radius = 2,
-    fillOpacity = 0.8
+      color = ~line_color,
-  ) %>% 
+      fillOpacity = 1,
-  addCircles(
+      popup = ~paste0("<b>DATE</b>", "<br>",
-    data = storm_track %>% filter(record_identifier == "L"),
+                      datetime, "<br>",
-    lng = ~lon,
+                      "<b>CATEGORY</b>", "<br>",
-    lat = ~lat,
+                      popup_category, "<br>",
-    radius = ~rmw_meters,
+                      "<b>WINDSPEED</b>", "<br>",
-    weight = 2,
+                      windspeed, "kt", "<br>",
-    color = "red",
+                      "<b>PRESSURE</b>", "<br>",
-    fillColor = "red",
+                      pressure, "mb")
-    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 = ~line_color,
+        fillColor = ~line_color,
+        fillOpacity = 1,
+        popup = ~paste0("<b>LANDFALL</b>", "<br>",
+                        "<b>DATE</b>", "<br>",
+                        datetime, "<br>",
+                        "<b>CATEGORY</b>", "<br>",
+                        popup_category, "<br>",
+                        "<b>WINDSPEED</b>", "<br>",
+                        windspeed, "kt", "<br>",
+                        "<b>PRESSURE</b>", "<br>",
+                        pressure, "mb", "<br>",
+                        "<b>RMW</b>", "<br>",
+                        rmw, "nm"
+                        )
+      ) %>%
+      addCircles(
+        data = landfall_data,
+        lng = ~lon,
+        lat = ~lat,
+        radius = ~rmw_meters,
+        weight = 2,
+        color = ~line_color,
+        fillColor = ~line_color,
+        fillOpacity = 0.3,
+        popup = ~paste0("<b>LANDFALL</b>", "<br>",
+                        "<b>DATE</b>", "<br>",
+                        datetime, "<br>",
+                        "<b>CATEGORY</b>", "<br>",
+                        popup_category, "<br>",
+                        "<b>WINDSPEED</b>", "<br>",
+                        windspeed, "kt", "<br>",
+                        "<b>PRESSURE</b>", "<br>",
+                        pressure, "mb", "<br>",
+                        "<b>RMW</b>", "<br>",
+                        rmw, "nm"
+                        )
+      )
+  }
+  
+  return(map)
 })
 
 leafletOutput("track_map", height = "100%")
 ```
 
-### Track Data {.no-padding}
+Col {data-width=500 .tabset}
-```{r}
-# Overview - Track Data
-
-output$track_data <- renderDT({
-  datatable(
-    storm_track() %>% select(datetime, storm_status, lon, lat, rmw, pressure, windspeed, record_identifier),
-    rownames = F,
-    colnames = c("Date", "Status", "Lon", "Lat", "RMW", "Pressure", "Windpseed", "Identifier"),
-    selection = "none",
-    options = list(
-      pageLength = 1000,
-      order = list(0, 'desc'),
-      searching = F,
-      paging = F,
-      info = F,
-      lengthChange = F,
-      server = T
-    )
-  )
-})
-
-DTOutput("track_data")
-```
-
-Col {data-width=500}
 ------------------------------------
 
-### Normalization Cost Index {data-height=700}
+### Normalization and Landfalls {}
 ```{r}
-# Overview - Normalization Chart
+# Overview - Normalization and Landfalls
 
 storm_yearly_normalization <- reactive({
   req(storm_selection$is_selected)
@@ -430,28 +593,6 @@ output$cost_index_chart <- renderDygraph({
     dyRangeSelector()
 })
 
-fluidRow(
-    style = "height: 100%",
-    column(3,
-           virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls", 
-                              choices = NULL,
-                              showValueAsTags = T,
-                              multiple = T,
-                              autoSelectFirstOption = T),
-           radioGroupButtons("storm_overview_cost_index_scale", label = "Value", choices = c("Index", "Loss"), status = "outline-primary rounded-0", justified = T),
-           checkboxGroupButtons("storm_overview_cost_index_mmh_mmp", label = "MMH/MMP", choices = c("MMH", "MMP"), selected = c("MMH", "MMP"), status = "outline-primary rounded-0", justified = T),
-           radioGroupButtons("storm_overview_cost_index_y_scale", label = "Y-Axis Scale", choices = c("Linear", "Log"), status = "outline-primary rounded-0", justified = T)
-    ),
-    column(9,
-           dygraphOutput("cost_index_chart")
-    )
-)
-```
-
-### Landfalls {data-height=300 .no-padding}
-```{r}
-# Overview - Landfalls Table
-
 output$landfalls_table <- renderDT({
   req(storm_selection$is_selected)
   
@@ -473,7 +614,56 @@ output$landfalls_table <- renderDT({
     formatDate(columns = "datetime", method = "toUTCString")
 })
 
-DTOutput("landfalls_table")
+fillCol(
+  flex = c(0.7, 0.3),
+  div(
+    fluidRow(
+      style = "height: 100%",
+      column(3,
+             virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls", 
+                                choices = NULL,
+                                showValueAsTags = T,
+                                multiple = T,
+                                autoSelectFirstOption = T),
+             radioGroupButtons("storm_overview_cost_index_scale", label = "Value", choices = c("Index", "Loss"), status = "outline-primary rounded-0", justified = T),
+             checkboxGroupButtons("storm_overview_cost_index_mmh_mmp", label = "MMH/MMP", choices = c("MMH", "MMP"), selected = c("MMH", "MMP"), status = "outline-primary rounded-0", justified = T),
+             radioGroupButtons("storm_overview_cost_index_y_scale", label = "Y-Axis Scale", choices = c("Linear", "Log"), status = "outline-primary rounded-0", justified = T)
+      ),
+      column(9,
+             dygraphOutput("cost_index_chart")
+      )
+    )
+  ),
+  div(
+    DTOutput("landfalls_table")
+  )
+)
+
+```
+
+### Track Data {.no-padding}
+```{r}
+# Overview - Track Data
+
+output$track_data <- renderDT({
+  datatable(
+    storm_track() %>% select(formatted_datetime, storm_status, lon, lat, rmw, pressure, windspeed),
+    rownames = F,
+    colnames = c("Date", "Status", "Lon", "Lat", "RMW", "Pressure", "Windspeed"),
+    selection = "none",
+    options = list(
+      pageLength = 1000,
+      order = list(0, 'asc'),
+      searching = F,
+      paging = F,
+      info = F,
+      lengthChange = F,
+      server = T
+    )
+  )
+})
+
+DTOutput("track_data")
 ```
 
 

queries.R

@@ -295,7 +295,28 @@ get_hurdat_track <- function(storm) {
       rmw_meters
     )
   
-  result <- query %>% collect()
+  result <- query %>% 
+    collect() %>%
+    mutate(
+      formatted_datetime = paste0(
+        format(datetime, "%m/%d/%Y"),
+        " ",
+        format(datetime, "%H"),
+        "Z"
+      )
+    ) %>%
+    select(
+      formatted_datetime,
+      datetime,
+      storm_status,
+      lon,
+      lat,
+      rmw,
+      pressure, 
+      windspeed,
+      record_identifier,
+      rmw_meters
+    )
   
   return(result)
 }