From 61844c830ea7d33f612d615602dfd0e166f43d76 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 01:13:25 -0400 Subject: [PATCH 1/9] modify storm track to show status by color --- dashboard.Rmd | 134 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 98 insertions(+), 36 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 02e76c4..f0e1851 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -241,10 +241,10 @@ Col {data-width=500 .tabset} ### Track Map {.no-padding} ```{r} # Overview - Track Map +# TODO: implement hurricane category status storm_track <- reactive({ req(storm_selection$is_selected) - result <- get_hurdat_track(storm_selection) return(result) @@ -277,42 +277,104 @@ observe({ 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) + # 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 -- -- -- + + storm_track <- storm_track %>% + 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() %>% + setView( + lng = map_center$lon, + lat = map_center$lat, + zoom = 4 + ) + + if (nrow(storm_track) >= 2) { + storm_track <- storm_track %>% arrange(datetime) - leafletProxy("track_map", data = storm_track) %>% - clearShapes() %>% - clearMarkers() %>% - setView( - lng = map_center$lon, - lat = map_center$lat, - zoom = 4 - ) %>% - addPolylines( - data = storm_track, - lng = ~lon, - lat = ~lat, - weight = 4, - color = "blue" - ) %>% - 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 - ) + for (i in 1:(nrow(storm_track) - 1)) { + segment_data <- storm_track[i:(i+1), ] + + proxy <- proxy %>% + addPolylines( + data = segment_data, + lng = ~lon, + lat = ~lat, + weight = 2, + color = storm_track$line_color[i], + opacity = 0.8 + ) + } + } + + proxy %>% + addCircleMarkers( + data = storm_track, + lng = ~lon, + lat = ~lat, + radius = 1, + color = ~line_color, + fillOpacity = 0.8, + 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 + ) }) leafletOutput("track_map", height = "100%") From 169119a739066eb327561dc79d887b0e8060e771 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 17:29:56 -0400 Subject: [PATCH 2/9] update map tile provider and add hurricane cat colors --- dashboard.Rmd | 224 ++++++++++++++++++++++++++++++++------------------ 1 file changed, 143 insertions(+), 81 deletions(-) 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%") From 118c110ad31fee283875590b6e6ed6b3ec26f773 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 17:47:56 -0400 Subject: [PATCH 3/9] add popup information at each point --- dashboard.Rmd | 88 ++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 77 insertions(+), 11 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index ea8ddd4..ff36684 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -284,6 +284,23 @@ storm_track <- reactive({ # Preprocess the track data with colors result <- result %>% mutate( + hurricane_category = case_when( + + # Hurricane Cat 1 + windspeed >= 64 & windspeed <= 82 ~ 1, + + # Hurricane Cat 2 + windspeed >= 83 & windspeed <= 95 ~ 2, + + # Hurricane Cat 3 + windspeed >= 96 & windspeed <= 112 ~ 3, + + # Hurricane Cat 4 + windspeed >= 113 & windspeed <= 136 ~ 4, + + # Hurricane Cate 5 + windspeed >= 137 ~ 5, + ), line_color = case_when( # Tropical Depression - Green @@ -293,19 +310,19 @@ storm_track <- reactive({ storm_status == "TS" ~ "#FFED2C", # Hurricane Cat 1 - Red - windspeed >= 64 & windspeed <= 82 ~ "#FF4343", + hurricane_category == 1 ~ "#FF4343", # Hurricane Cat 2 - Pink - windspeed >= 83 & windspeed <= 95 ~ "#FF6FFF", + hurricane_category == 2 ~ "#FF6FFF", # Hurricane Cat 3 - Magenta - windspeed >= 96 & windspeed <= 112 ~ "#FF23D3", + hurricane_category == 3 ~ "#FF23D3", # Hurricane Cat 4 - Purple - windspeed >= 113 & windspeed <= 136 ~ "#C916FF", + hurricane_category == 4 ~ "#C916FF", # Hurricane Cate 5 - White - windspeed >= 137 ~ "#FFFFFF", + hurricane_category == 5 ~ "#FFFFFF", # Extratropical Cyclone storm_status == "EX" ~ "#000000", @@ -329,16 +346,34 @@ storm_track <- reactive({ TRUE ~ "#CCCCCC" ), line_stroke = case_when( + + # Add dashed lines for certain storm_status 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", + storm_status == "LO" ~ "5,5", + storm_status == "WV" ~ "5,5", + storm_status == "DB" ~ "5,5", TRUE ~ "0" + ), + 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) @@ -406,7 +441,14 @@ output$track_map <- renderLeaflet({ radius = 2, color = ~line_color, fillOpacity = 1, - popup = ~storm_status + popup = ~paste0("DATE", "
", + datetime, "
", + "CATEGORY", "
", + popup_category, "
", + "WINDSPEED", "
", + windspeed, "kt", "
", + "PRESSURE", "
", + pressure, "mb") ) landfall_data <- track_data %>% @@ -422,7 +464,19 @@ output$track_map <- renderLeaflet({ weight = 0, color = "red", fillColor = "red", - fillOpacity = 1 + fillOpacity = 1, + popup = ~paste0("LANDFALL", "
", + "DATE", "
", + datetime, "
", + "CATEGORY", "
", + popup_category, "
", + "WINDSPEED", "
", + windspeed, "kt", "
", + "PRESSURE", "
", + pressure, "mb", "
", + "RMW", "
", + rmw, "nm" + ) ) %>% addCircles( data = landfall_data, @@ -432,7 +486,19 @@ output$track_map <- renderLeaflet({ weight = 2, color = "red", fillColor = "red", - fillOpacity = 0.3 + fillOpacity = 0.3, + popup = ~paste0("LANDFALL", "
", + "DATE", "
", + datetime, "
", + "CATEGORY", "
", + popup_category, "
", + "WINDSPEED", "
", + windspeed, "kt", "
", + "PRESSURE", "
", + pressure, "mb", "
", + "RMW", "
", + rmw, "nm" + ) ) } From 1a68906d16a374345676f7a8ee8f271a655ae1b7 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 17:55:13 -0400 Subject: [PATCH 4/9] modify landfall point to use storm status color --- dashboard.Rmd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index ff36684..ef7398b 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -462,8 +462,8 @@ output$track_map <- renderLeaflet({ lat = ~lat, radius = 5, weight = 0, - color = "red", - fillColor = "red", + color = ~line_color, + fillColor = ~line_color, fillOpacity = 1, popup = ~paste0("LANDFALL", "
", "DATE", "
", @@ -484,8 +484,8 @@ output$track_map <- renderLeaflet({ lat = ~lat, radius = ~rmw_meters, weight = 2, - color = "red", - fillColor = "red", + color = ~line_color, + fillColor = ~line_color, fillOpacity = 0.3, popup = ~paste0("LANDFALL", "
", "DATE", "
", From e268fe7892876a8329c22ad809d151a36189bc40 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 18:05:04 -0400 Subject: [PATCH 5/9] modify map bounds to center around entire storm track --- dashboard.Rmd | 34 ++++++---------------------------- 1 file changed, 6 insertions(+), 28 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index ef7398b..8f7d345 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -381,39 +381,17 @@ storm_track <- reactive({ 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 = center$lon, - lat = center$lat, - zoom = 4 + options = providerTileOptions(updateWhenIdle = T)) %>% + fitBounds( + lng1 = min(track_data$lon), + lng2 = max(track_data$lon), + lat1 = min(track_data$lat), + lat2 = max(track_data$lat), ) if (nrow(track_data) >= 2) { From 2f364651b1ae5f72e25102b2a4bd3f62b1600ad1 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 19:44:40 -0400 Subject: [PATCH 6/9] remove tabset for map and move map data to separate column --- dashboard.Rmd | 106 +++++++++++++++++++++++++------------------------- queries.R | 23 ++++++++++- 2 files changed, 76 insertions(+), 53 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 8f7d345..c32a6b6 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -238,7 +238,7 @@ observe({ }) ``` -Col {data-width=500 .tabset} +Col {data-width=500} ------------------------------------ ### Track Map {.no-padding} @@ -486,37 +486,12 @@ output$track_map <- renderLeaflet({ leafletOutput("track_map", height = "100%") ``` -### Track Data {.no-padding} -```{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} +Col {data-width=500 .tabset} ------------------------------------ -### 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) @@ -598,28 +573,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) @@ -641,7 +594,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") ``` diff --git a/queries.R b/queries.R index d8a1cdb..28a5af2 100644 --- a/queries.R +++ b/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) } From 7232368784457d3be09859983f82fb4b9a125d14 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 20:14:23 -0400 Subject: [PATCH 7/9] modify hurricane track colors to fix erroneous hurricane status --- dashboard.Rmd | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index c32a6b6..fb8c092 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -287,19 +287,19 @@ storm_track <- reactive({ hurricane_category = case_when( # Hurricane Cat 1 - windspeed >= 64 & windspeed <= 82 ~ 1, + storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1, # Hurricane Cat 2 - windspeed >= 83 & windspeed <= 95 ~ 2, + storm_status == "HU" & windspeed >= 83 & windspeed <= 95 ~ 2, # Hurricane Cat 3 - windspeed >= 96 & windspeed <= 112 ~ 3, + storm_status == "HU" & windspeed >= 96 & windspeed <= 112 ~ 3, # Hurricane Cat 4 - windspeed >= 113 & windspeed <= 136 ~ 4, + storm_status == "HU" & windspeed >= 113 & windspeed <= 136 ~ 4, # Hurricane Cate 5 - windspeed >= 137 ~ 5, + storm_status == "HU" & windspeed >= 137 ~ 5, ), line_color = case_when( @@ -307,7 +307,7 @@ storm_track <- reactive({ storm_status == "TD" ~ "#2AFF00", # Tropical Storm - Yellow - storm_status == "TS" ~ "#FFED2C", + storm_status == "TS" ~ "#FFD020", # Hurricane Cat 1 - Red hurricane_category == 1 ~ "#FF4343", From f8c2b1b194d80866fff98e447589e25450ddc6fa Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 20:43:29 -0400 Subject: [PATCH 8/9] modify storm track colors and add legend --- dashboard.Rmd | 63 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 42 insertions(+), 21 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index fb8c092..6949323 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -325,7 +325,7 @@ storm_track <- reactive({ hurricane_category == 5 ~ "#FFFFFF", # Extratropical Cyclone - storm_status == "EX" ~ "#000000", + storm_status == "EX" ~ "#202020", # Subtropical Depression storm_status == "SD" ~ "#0055FF", @@ -334,30 +334,16 @@ storm_track <- reactive({ storm_status == "SS" ~ "#6CE2FF", # Low - storm_status == "LO" ~ "#2AFF00", + storm_status == "LO" ~ "#A1A1A1", # Wave - storm_status == "WV" ~ "#2AFF00", + storm_status == "WV" ~ "#A1A1A1", # Disturbance - storm_status == "DB" ~ "#2AFF00", + storm_status == "DB" ~ "#A1A1A1", # Missing - TRUE ~ "#CCCCCC" - ), - line_stroke = case_when( - - # Add dashed lines for certain storm_status - 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,5", - storm_status == "WV" ~ "5,5", - storm_status == "DB" ~ "5,5", - TRUE ~ "0" + TRUE ~ "#FF5C00" ), popup_category = case_when( storm_status == "TD" ~ "TD", @@ -391,8 +377,44 @@ output$track_map <- renderLeaflet({ lng1 = min(track_data$lon), lng2 = max(track_data$lon), lat1 = min(track_data$lat), - lat2 = max(track_data$lat), + lat2 = max(track_data$lat) + ) + + map <- map %>% + leaflet::addLegend( + position = "bottomleft", + colors = c( + "#2AFF00", # TD + "#FFD020", # TS + "#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" ) + if (nrow(track_data) >= 2) { for (i in 1:(nrow(track_data) - 1)) { @@ -405,7 +427,6 @@ output$track_map <- renderLeaflet({ lat = ~lat, weight = 2, color = track_data$line_color[i], - dashArray = track_data$line_stroke[i], opacity = 1 ) } From 211703805d290741ec2b1b7b3ea6192eb6581471 Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Sun, 20 Jul 2025 20:44:27 -0400 Subject: [PATCH 9/9] modify map provider tiles --- dashboard.Rmd | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 6949323..6d42875 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -371,8 +371,7 @@ output$track_map <- renderLeaflet({ track_data <- storm_track() map <- leaflet() %>% - addProviderTiles("Stadia.AlidadeSmooth", - options = providerTileOptions(updateWhenIdle = T)) %>% + addProviderTiles("Stadia.AlidadeSmooth") %>% fitBounds( lng1 = min(track_data$lon), lng2 = max(track_data$lon),