diff --git a/README.md b/README.md index ae641bc..1dea28c 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,45 @@ -# copilot-workshop +# NWFSC Survey Grid – SST Shiny App -create a shiny app +An interactive R Shiny application that visualizes **Mean Sea Surface Temperature (SST)** on the NWFSC survey grid points along the US West Coast. + +## Features + +* Leaflet map centered on the WA/OR coast. +* Date picker populated with the valid date range from the NOAA ERDDAP server. +* Grid points coloured by SST using the **viridis** colour palette with a legend. +* Click any point to see its **Grid Cell ID**, coordinates, and SST value in a popup and sidebar panel. +* Data are fetched from ERDDAP only when the selected date changes (reactive). + +## Data Sources + +| Source | Details | +|--------|---------| +| **SST** | NOAA ERDDAP – dataset `ncdcOisst21Agg_LonPM180` via the `rerddap` package | +| **Grid** | `surveyjoin::nwfsc_grid` (filtered to `survey == "NWFSC.Combo"`) | + +## Prerequisites + +* R ≥ 4.1 +* System libraries (Ubuntu/Debian): `libcurl4-openssl-dev`, `libssl-dev`, `libxml2-dev`, `libgdal-dev`, `libgeos-dev`, `libproj-dev`, `libudunits2-dev` + +Install R packages: + +```r +install.packages("pak", repos = "https://r-lib.github.io/p/pak/dev/") +pak::pkg_install(c("shiny", "leaflet", "rerddap", "sf", "dplyr", "viridis")) +pak::pkg_install("DFO-NOAA-Pacific/surveyjoin") +``` + +## Running the App + +```r +shiny::runApp("app.R") +``` + +Or from the terminal: + +```bash +Rscript -e "shiny::runApp('app.R')" +``` + +The app will open in your browser. Use the **date picker** in the sidebar to choose a date; the map will update automatically with SST values for that day. diff --git a/app.R b/app.R new file mode 100644 index 0000000..7b84f99 --- /dev/null +++ b/app.R @@ -0,0 +1,213 @@ +library(shiny) +library(leaflet) +library(rerddap) +library(surveyjoin) +library(viridis) +library(dplyr) + +# ── Static data loaded once at startup ────────────────────────────────────── + +# Load NWFSC.Combo grid points +grid_pts <- surveyjoin::nwfsc_grid |> + dplyr::filter(survey == "NWFSC.Combo") |> + dplyr::mutate(cell_id = dplyr::row_number()) |> + dplyr::select(cell_id, lon, lat) + +# Fetch available date range from ERDDAP metadata +erddap_url <- "https://coastwatch.pfeg.noaa.gov/erddap/" +dataset_id <- "ncdcOisst21Agg_LonPM180" + +get_date_range <- function() { + tryCatch({ + meta <- rerddap::info(dataset_id, url = erddap_url) + time_row <- meta$alldata$time[ + meta$alldata$time$attribute_name == "actual_range", ] + if (nrow(time_row) == 0) stop("No time range found") + # actual_range is two doubles (seconds since 1970-01-01) + vals <- as.numeric(strsplit(time_row$value, ",\\s*")[[1]]) + list( + min = as.Date(as.POSIXct(vals[1], origin = "1970-01-01", tz = "UTC")), + max = as.Date(as.POSIXct(vals[2], origin = "1970-01-01", tz = "UTC")) + ) + }, error = function(e) { + list(min = as.Date("1981-09-01"), max = Sys.Date() - 2) + }) +} + +date_range <- get_date_range() + +# ── UI ─────────────────────────────────────────────────────────────────────── + +ui <- fluidPage( + titlePanel("NWFSC Survey Grid - Sea Surface Temperature"), + + sidebarLayout( + sidebarPanel( + width = 3, + dateInput( + inputId = "selected_date", + label = "Select Date", + value = date_range$max - 1, + min = date_range$min, + max = date_range$max, + format = "yyyy-mm-dd" + ), + hr(), + helpText("Click a grid point on the map to see its SST details."), + hr(), + verbatimTextOutput("click_info") + ), + + mainPanel( + width = 9, + leafletOutput("map", height = "600px") + ) + ) +) + +# ── Server ─────────────────────────────────────────────────────────────────── + +server <- function(input, output, session) { + + # Fetch SST from ERDDAP – only re-runs when the date changes + sst_data <- eventReactive(input$selected_date, { + date_str <- format(input$selected_date, "%Y-%m-%d") + + # Bounding box around the nwfsc_grid extent + lon_min <- floor(min(grid_pts$lon)) - 0.5 + lon_max <- ceiling(max(grid_pts$lon)) + 0.5 + lat_min <- floor(min(grid_pts$lat)) - 0.5 + lat_max <- ceiling(max(grid_pts$lat)) + 0.5 + + withProgress(message = "Fetching SST data…", value = 0.5, { + raw <- tryCatch( + rerddap::griddap( + datasetx = dataset_id, + url = erddap_url, + time = c(date_str, date_str), + longitude = c(lon_min, lon_max), + latitude = c(lat_min, lat_max), + fields = "sst", + fmt = "csv" + ), + error = function(e) NULL + ) + }) + + if (is.null(raw)) return(NULL) + + sst_df <- raw$data |> + dplyr::rename(lon = longitude, lat = latitude) |> + dplyr::filter(!is.na(sst)) |> + dplyr::select(lon, lat, sst) + + sst_df + }) + + # Spatially match each grid point to the nearest SST observation + joined_data <- reactive({ + sst_df <- sst_data() + if (is.null(sst_df) || nrow(sst_df) == 0) return(NULL) + + # Round to OISST grid resolution (0.25°) for fast join + res <- 0.25 + sst_df <- sst_df |> + dplyr::mutate( + lon_r = round(lon / res) * res, + lat_r = round(lat / res) * res + ) + + grid_pts |> + dplyr::mutate( + lon_r = round(lon / res) * res, + lat_r = round(lat / res) * res + ) |> + dplyr::left_join( + sst_df |> dplyr::select(lon_r, lat_r, sst), + by = c("lon_r", "lat_r") + ) |> + dplyr::select(cell_id, lon, lat, sst) |> + dplyr::filter(!is.na(sst)) + }) + + # ── Base map (rendered once) ────────────────────────────────────────────── + output$map <- renderLeaflet({ + leaflet() |> + addProviderTiles(providers$CartoDB.Positron) |> + setView(lng = -124.5, lat = 46.0, zoom = 5) + }) + + # ── Update coloured points whenever joined_data changes ────────────────── + observe({ + df <- joined_data() + + proxy <- leafletProxy("map") + proxy |> clearGroup("sst_points") |> removeControl("legend") + + if (is.null(df) || nrow(df) == 0) return() + + pal <- colorNumeric( + palette = viridis::viridis(256), + domain = df$sst, + na.color = "transparent" + ) + + proxy |> + addCircleMarkers( + data = df, + lng = ~lon, + lat = ~lat, + radius = 4, + color = ~pal(sst), + fillColor = ~pal(sst), + fillOpacity = 0.85, + stroke = FALSE, + group = "sst_points", + layerId = ~cell_id, + label = ~paste0("Cell ", cell_id, " | SST: ", round(sst, 2), " °C") + ) |> + addLegend( + position = "bottomright", + pal = pal, + values = df$sst, + title = "SST (°C)", + layerId = "legend" + ) + }) + + # ── Click popup ────────────────────────────────────────────────────────── + observeEvent(input$map_marker_click, { + click <- input$map_marker_click + df <- joined_data() + if (is.null(df) || is.null(click$id)) return() + + row <- df[df$cell_id == as.integer(click$id), ] + if (nrow(row) == 0) return() + + mean_sst <- round(row$sst, 2) + + output$click_info <- renderText({ + paste0( + "Grid Cell ID : ", row$cell_id, "\n", + "Longitude : ", round(row$lon, 4), "\n", + "Latitude : ", round(row$lat, 4), "\n", + "SST : ", mean_sst, " °C\n", + "Date : ", format(input$selected_date, "%Y-%m-%d") + ) + }) + + leafletProxy("map") |> + addPopups( + lng = click$lng, + lat = click$lat, + popup = paste0( + "Cell ID: ", row$cell_id, "
", + "SST: ", mean_sst, " °C
", + "Date: ", format(input$selected_date, "%Y-%m-%d") + ) + ) + }) +} + +# ── Launch ─────────────────────────────────────────────────────────────────── +shinyApp(ui = ui, server = server)