diff --git a/dashboard.Rmd b/dashboard.Rmd index ffc8bfb..9383b1a 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() @@ -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() %>% - addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) -}) - -observe({ - req(storm_selection) + track_data <- storm_track() - storm_track <- storm_track() - - first_lf <- storm_track %>% - filter( - record_identifier == "L" - ) %>% - arrange( - desc(datetime) + map <- leaflet() %>% + addProviderTiles("Stadia.AlidadeSmooth") %>% + fitBounds( + lng1 = min(track_data$lon), + lng2 = max(track_data$lon), + lat1 = min(track_data$lat), + lat2 = max(track_data$lat) ) - if(nrow(first_lf) > 0) { - map_center <- first_lf %>% - head(1) - }else{ - map_center <- data.frame( - lon = c(-76), - lat = c(35) + 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" ) - } - 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 - ) + + if (nrow(track_data) >= 2) { + for (i in 1:(nrow(track_data) - 1)) { + segment_data <- track_data[i:(i+1), ] + + map <- map %>% + addPolylines( + data = segment_data, + lng = ~lon, + lat = ~lat, + weight = 2, + color = track_data$line_color[i], + opacity = 1 + ) + } + } + + map <- map %>% + addCircleMarkers( + data = track_data, + lng = ~lon, + lat = ~lat, + radius = 2, + color = ~line_color, + fillOpacity = 1, + popup = ~paste0("DATE", "
", + datetime, "
", + "CATEGORY", "
", + popup_category, "
", + "WINDSPEED", "
", + windspeed, "kt", "
", + "PRESSURE", "
", + pressure, "mb") + ) + + 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("LANDFALL", "
", + "DATE", "
", + datetime, "
", + "CATEGORY", "
", + popup_category, "
", + "WINDSPEED", "
", + windspeed, "kt", "
", + "PRESSURE", "
", + pressure, "mb", "
", + "RMW", "
", + 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("LANDFALL", "
", + "DATE", "
", + datetime, "
", + "CATEGORY", "
", + popup_category, "
", + "WINDSPEED", "
", + windspeed, "kt", "
", + "PRESSURE", "
", + pressure, "mb", "
", + "RMW", "
", + rmw, "nm" + ) + ) + } + + return(map) }) 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) @@ -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") ``` 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) }