mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
add pressure/windspeed chart with status shading
This commit is contained in:
@@ -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,
|
||||||
|
|||||||
@@ -122,6 +122,8 @@ 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_columns(
|
||||||
|
col_widths = 12,
|
||||||
layout_column_wrap(
|
layout_column_wrap(
|
||||||
card(
|
card(
|
||||||
full_screen = TRUE,
|
full_screen = TRUE,
|
||||||
@@ -130,10 +132,18 @@ ui <- page_navbar(
|
|||||||
leafletOutput("track_map", height = "100%")
|
leafletOutput("track_map", height = "100%")
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
|
layout_column_wrap(
|
||||||
|
width = 1,
|
||||||
card(
|
card(
|
||||||
card_body(
|
card_body(
|
||||||
DTOutput("track_data", fill = TRUE)
|
DTOutput("track_data", fill = TRUE)
|
||||||
)
|
)
|
||||||
|
),
|
||||||
|
card(
|
||||||
|
card_header("Meteorology"),
|
||||||
|
dygraphOutput("track_met_chart", height = "250px")
|
||||||
|
)
|
||||||
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
),
|
),
|
||||||
|
|||||||
Reference in New Issue
Block a user