diff --git a/app/global.R b/app/global.R index 26bc07f..d6e5af8 100644 --- a/app/global.R +++ b/app/global.R @@ -115,6 +115,14 @@ sl_stations <- d_sl |> distinct(station_name, station_id) |> deframe() +sl_station_default <- sl_stations["St. Petersburg"] + +sl_yr_rng <- d_sl |> + filter(station_id == sl_station_default) |> + select(year) |> + range() +sl_yr_default <- 2000 + # map bounding box ---- b <- st_bbox(tbsegshed) |> as.numeric() diff --git a/app/server.R b/app/server.R index d5123ee..3c31385 100644 --- a/app/server.R +++ b/app/server.R @@ -422,14 +422,80 @@ function(input, output, session) { # * plot_sl ---- output$plot_sl <- renderPlotly({ - # input$map_sl$click - # TODO: update input$sel_l_stn based on map stn click - # update map highlighted marker based on ∆ input$sel_l_stn - - # input <- list(sel_l_stn = 8726724) - - plot_sl(input$sel_l_stn) + # Split data by year and calculate trends + d <- d_sl |> + filter(station_id == input$sel_l_stn) |> + mutate( + yr_grp = case_when( + year > input$sld_l_yr_split ~ "Now", + TRUE ~ "Then")) + # Calculate trends and stats for each period + trends <- d |> + group_by(yr_grp) |> + group_modify(~ { + m <- lm(msl ~ date, data = .) + rsq <- summary(m)$r.squared + cm_per_decade <- coef(m)[["date"]] * 100 * 365 * 10 # convert to cm/decade + + # Convert units if imperial + rate <- if (input$sw_imperial) { + cm_per_decade / 2.54 # convert to inches/decade + } else { + cm_per_decade + } + + unit <- if (input$sw_imperial) "in/decade" else "cm/decade" + + # Create annotation text + text <- sprintf( + "%s: %0.2f %s\n(R² = %0.2f)", + .$yr_grp[1], rate, unit, rsq) + + tibble( + date = range(.$date), + msl = predict(m, newdata = data.frame(date = range(.$date))), + text = text[1], + rate = rate, + rsq = rsq) + }) + + # Convert y-axis values if imperial + if (input$sw_imperial) { + d <- d |> mutate(msl = msl / 2.54) + trends <- trends |> mutate(msl = msl / 2.54) + } + + # Create plot + p <- d |> + ggplot(aes(date, msl, color = yr_grp)) + + geom_point(alpha = 0.3) + + geom_line(data = trends, size = 1) + + scale_color_manual( + values = c("Then" = "gray50", "Now" = "red"), + name = "Period") + + labs( + x = "Year", + y = if (input$sw_imperial) "Mean Sea Level (inches)" else "Mean Sea Level (cm)", + title = glue("Sea Level Rise at {sl_stations[input$sel_l_stn]}")) + + # Add annotations + annotations <- trends |> + group_by(yr_grp) |> + slice_tail() |> + mutate( + x = date, + y = msl, + text = text, + showarrow = TRUE, + arrowhead = 2, + ax = 40, + ay = if (yr_grp == "Then") 40 else -40) + + p <- ggplotly(p) |> + layout(annotations = annotations) + + p }) # Ocean Temperature [o] ---- diff --git a/app/ui.R b/app/ui.R index 454858c..d0c9936 100644 --- a/app/ui.R +++ b/app/ui.R @@ -6,7 +6,7 @@ page_navbar( # Overview [v] ---- nav_panel( title = tagList( - "Overview", bs_icon("compass-fill")), + bs_icon("compass-fill"), "Overview"), sliderInput( "sld_date_split", @@ -24,28 +24,28 @@ page_navbar( # * Air Temperature ---- vb( - title = span("Air Temperature", bs_icon("thermometer-half")), + title = span(bs_icon("thermometer-half"), "Air Temperature"), value = uiOutput("value_temp"), showcase = plotlyOutput("bar_temp"), uiOutput("caption_temp")), # * Rain ---- vb( - title = span("Rain", bs_icon("cloud-rain-fill")), + title = span(bs_icon("cloud-rain-fill"), "Rain"), value = uiOutput("value_rain"), showcase = plotlyOutput("bar_rain"), uiOutput("caption_rain")), # * Ocean Temperature ---- vb( - title = span("Ocean Temperature", bs_icon("thermometer-low")), + title = span(bs_icon("thermometer-low"), "Ocean Temperature"), value = uiOutput("value_sst"), showcase = plotlyOutput("bar_sst"), uiOutput("caption_sst")), # * Hurricanes ---- vb( - title = span("Hurricanes", bs_icon("tornado")), + title = span(bs_icon("tornado"), "Hurricanes", ), value = uiOutput("value_hurricanes"), showcase = plotlyOutput("bar_hurricanes"), uiOutput("caption_hurricanes")) @@ -55,13 +55,13 @@ page_navbar( # Air Temperature [t] ---- nav_panel( title = tagList( - "Air Temperature", bs_icon("thermometer-half")), + bs_icon("thermometer-half"), "Air Temperature"), navset_card_underline( # * Map ---- nav_panel( - tagList( - "Map ", bs_icon("map")), + span( + bs_icon("map"), " Map"), card( full_screen = T, card_header( @@ -121,8 +121,8 @@ page_navbar( # * Plot ---- nav_panel( - tagList( - "Plot ", bs_icon("graph-up-arrow")), + span( + bs_icon("graph-up-arrow"), " Plot"), card( full_screen = T, card_header( @@ -153,14 +153,14 @@ page_navbar( # Rain [r] ---- nav_panel( - title = tagList( - "Rain", bs_icon("cloud-rain-fill")), + title = span( + bs_icon("cloud-rain-fill"), " Rain"), navset_card_underline( # * Map ---- nav_panel( - tagList( - "Map ", bs_icon("map")), + span( + bs_icon("map"), " Map"), card( full_screen = T, @@ -213,8 +213,7 @@ page_navbar( # * Plot ---- nav_panel( - tagList( - "Plot ", bs_icon("graph-up-arrow")), + span(bs_icon("graph-up-arrow"), " Plot"), card( full_screen = T, card_header( @@ -245,15 +244,13 @@ page_navbar( # Sea Level [l] ---- nav_panel( - title = tagList( - "Sea Level", bs_icon("water")), + title = span(bs_icon("water"), " Sea Level"), # * map ---- card( full_screen = T, card_header( - tagList( - "Map of sea level stations ", bs_icon("map") ) ), + span( bs_icon("map"), " Map of sea level stations") ), # TODO: helpText("Click on a different station to see the data."), leafletOutput("map_sl") ), @@ -261,24 +258,40 @@ page_navbar( card( full_screen = T, card_header( - tagList( - "Plot of sea levels ", bs_icon("graph-up-arrow") ) ), + class = "d-flex", # r-align gear icon + span( + bs_icon("graph-up-arrow"), " Plot of sea levels", + class = "me-auto"), # r-align gear icon + popover( + title = "Settings", + bs_icon("gear"), + + sliderInput( + "sld_l_yr_split", + "Year Split", + min = sl_yr_rng[1], + value = sl_yr_default, + max = max(sl_yr_rng), + step = 1, + animate = TRUE, + sep = "") ) ), + selectInput( "sel_l_stn", "Sea level station", - sl_stations), + sl_stations, + sl_station_default), plotlyOutput("plot_sl") ) ), # Ocean Temperature [o] ---- nav_panel( title = tagList( - "Ocean Temperature", bs_icon("thermometer-low")), + bs_icon("thermometer-low"), " Ocean Temperature"), navset_card_underline( # * Map ---- nav_panel( - tagList( - "Map ", bs_icon("map")), + span(bs_icon("map"), " Map"), card( full_screen = T, card_header( @@ -332,7 +345,7 @@ page_navbar( # * Plot ---- nav_panel( tagList( - "Plot ", bs_icon("graph-up-arrow")), + bs_icon("graph-up-arrow"), " Plot"), card( full_screen = T, card_header( @@ -364,15 +377,14 @@ page_navbar( # Hurricanes [h] ---- nav_panel( - title = tagList( - "Hurricanes", bs_icon("tornado")), + title = span(bs_icon("tornado"), " Hurricanes"), # * map ---- card( full_screen = T, card_header( tagList( - "Map of hurricane tracks", bs_icon("map") ) ), + bs_icon("map"), " Map of hurricane tracks") ), # TODO: configure option to limit map of hurricane tracks by year leafletOutput("map_h"), @@ -401,7 +413,7 @@ page_navbar( card_header( class = "d-flex", # r-align gear icon span( - "Plot of hurricanes over time", bs_icon("graph-up-arrow"), + bs_icon("graph-up-arrow"), " Plot of hurricanes over time", class = "me-auto"), # r-align gear icon popover( title = "Settings",