add pressure/windspeed chart with status shading

This commit is contained in:
2026-04-07 21:53:04 -04:00
parent d365036eb9
commit a5614049d7
2 changed files with 55 additions and 11 deletions
+34
View File
@@ -521,6 +521,40 @@ server <- function(input, output, session) {
) )
}) })
output$track_met_chart <- renderDygraph({
track_data <- storm_track()
ts_data <- track_data %>%
select(datetime, windspeed, pressure) %>%
rename(Windspeed = windspeed, Pressure = pressure)
track_xts <- xts(
ts_data %>% select(-datetime),
order.by = ts_data$datetime
)
g <- dygraph(track_xts) %>%
dyAxis("y", label = "Windspeed (kt)") %>%
dyAxis("y2", label = "Pressure (mb)", independentTicks = TRUE) %>%
dySeries("Windspeed", axis = "y", color = "#4dabf7") %>%
dySeries("Pressure", axis = "y2", color = "#f03e3e") %>%
dyOptions(drawGrid = FALSE) %>%
dyLegend(show = "always")
Reduce(function(g, i) {
g %>% dyShading(
from = track_data$datetime[i],
to = track_data$datetime[i + 1],
color = paste0(track_data$line_color[i], "33")
)
}, seq_len(nrow(track_data) - 1), init = g)
}) %>%
bindCache(
storm_selection$storm_year,
storm_selection$storm_name,
storm_selection$storm_basin
)
storm_yearly_normalization <- reactive({ storm_yearly_normalization <- reactive({
req( req(
storm_selection$storm_basin, storm_selection$storm_basin,
+21 -11
View File
@@ -122,17 +122,27 @@ ui <- page_navbar(
nav_item(strong(textOutput("selected_storm_name_year"))), nav_item(strong(textOutput("selected_storm_name_year"))),
nav_panel( nav_panel(
"Track", "Track",
layout_column_wrap( layout_columns(
card( col_widths = 12,
full_screen = TRUE, layout_column_wrap(
card_body( card(
class = "p-0", full_screen = TRUE,
leafletOutput("track_map", height = "100%") card_body(
) class = "p-0",
), leafletOutput("track_map", height = "100%")
card( )
card_body( ),
DTOutput("track_data", fill = TRUE) layout_column_wrap(
width = 1,
card(
card_body(
DTOutput("track_data", fill = TRUE)
)
),
card(
card_header("Meteorology"),
dygraphOutput("track_met_chart", height = "250px")
)
) )
) )
) )