Add R Shiny app for NWFSC Survey Grid SST visualization

README.md

@@ -1,3 +1,92 @@
-# copilot-workshop
+# NWFSC Survey Grid SST Shiny App
 
-create a shiny app
+An R Shiny application that visualises **Sea Surface Temperature (SST)**
+on NWFSC trawl-survey grid points along the US West Coast.
+
+---
+
+## What it does
+
+* Loads the NWFSC Combo survey grid (lat/lon points) from the
+  [`surveyjoin`](https://github.com/DFO-NOAA-Pacific/surveyjoin) package.
+* Fetches daily SST from the NOAA CoastWatch ERDDAP server
+  (dataset `ncdcOisst21Agg_LonPM180`) for any date the user selects.
+* Displays an interactive **Leaflet** map centred on the WA/OR coast.
+* Colours each grid point by its SST value using the **viridis** palette and
+  shows a colour legend.
+* Clicking a point opens a popup with the **Grid Cell ID** and **SST (°C)**.
+* Gracefully handles unavailable dates with an informative message instead of
+  crashing.
+
+---
+
+## Required packages
+
+| Package | Source |
+|---------|--------|
+| `shiny` | CRAN |
+| `leaflet` | CRAN |
+| `rerddap` | CRAN |
+| `viridis` | CRAN |
+| `dplyr` | CRAN |
+| `surveyjoin` | GitHub – `DFO-NOAA-Pacific/surveyjoin` |
+
+---
+
+## Installation
+
+### 1 – Install system libraries (Linux / Ubuntu)
+
+```bash
+sudo apt-get update
+sudo apt-get install -y libcurl4-openssl-dev libssl-dev libxml2-dev \
+  libgdal-dev libgeos-dev libproj-dev libudunits2-dev
+```
+
+### 2 – Install R packages
+
+```r
+install.packages("pak", repos = "https://r-lib.github.io/p/pak/dev/")
+pak::pkg_install(c("shiny", "leaflet", "rerddap", "dplyr", "viridis"))
+pak::pkg_install("DFO-NOAA-Pacific/surveyjoin")
+```
+
+---
+
+## Running the app
+
+### From the R console
+
+```r
+shiny::runApp("app.R")
+```
+
+### From the command line
+
+```bash
+Rscript -e "shiny::runApp('app.R')"
+```
+
+The app will open in your default browser.  
+If it does not open automatically, navigate to the URL shown in the console
+(e.g. `http://127.0.0.1:XXXX`).
+
+---
+
+## Using the app
+
+1. The date picker is pre-populated with the full range of dates available on
+   the ERDDAP server.  Select a date and click **Fetch SST**.
+2. Grid points will appear on the map coloured by SST.
+3. Click any point to see its **Grid Cell ID** and **SST (°C)** in a popup.
+4. If the selected date has no data on the server a message is displayed in the
+   sidebar – simply choose another date.
+
+---
+
+## Data sources
+
+* **SST** – NOAA OISSTv2.1 daily composites via ERDDAP  
+  Dataset ID: `ncdcOisst21Agg_LonPM180`  
+  URL: <https://coastwatch.pfeg.noaa.gov/erddap/>
+* **Survey grid** – `surveyjoin::nwfsc_grid` (NWFSC.Combo survey)

app.R

@@ -0,0 +1,243 @@
+library(shiny)
+library(leaflet)
+library(rerddap)
+library(surveyjoin)
+library(viridis)
+library(dplyr)
+
+# ---------------------------------------------------------------------------
+# Helpers
+# ---------------------------------------------------------------------------
+
+#' Return available SST dates from the ERDDAP dataset metadata.
+#' Returns a character vector of "YYYY-MM-DD" strings, or NULL on failure.
+get_erddap_dates <- function() {
+  tryCatch({
+    info_obj <- info("ncdcOisst21Agg_LonPM180",
+                     url = "https://coastwatch.pfeg.noaa.gov/erddap/")
+    time_meta <- info_obj$alldata$time
+    # actual_range row contains "start, end" epoch seconds
+    range_row  <- time_meta[time_meta$attribute_name == "actual_range", "value"]
+    # Dimension rows have an empty attribute_name; the nValues row describes spacing
+    nval_row   <- time_meta[time_meta$attribute_name == "" &
+                              grepl("nValues", time_meta$value), "value"]
+
+    # Parse start / end from actual_range  (two doubles separated by ", ")
+    parts <- as.numeric(strsplit(trimws(range_row), ",\\s*")[[1]])
+    t_start <- as.Date(as.POSIXct(parts[1], origin = "1970-01-01", tz = "UTC"))
+    t_end   <- as.Date(as.POSIXct(parts[2], origin = "1970-01-01", tz = "UTC"))
+
+    seq(t_start, t_end, by = "day")
+  }, error = function(e) {
+    NULL
+  })
+}
+
+#' Fetch SST for a single date and match it to the nwfsc_grid points.
+#' @param grid   data.frame with columns lon, lat (NWFSC.Combo subset)
+#' @param date   Date object
+#' @return data.frame: grid with an added "sst" column, or NULL on failure
+fetch_sst <- function(grid, date) {
+  tryCatch({
+    lon_range <- range(grid$lon, na.rm = TRUE)
+    lat_range <- range(grid$lat, na.rm = TRUE)
+    date_str  <- format(date, "%Y-%m-%d")
+
+    raw <- griddap(
+      "ncdcOisst21Agg_LonPM180",
+      url       = "https://coastwatch.pfeg.noaa.gov/erddap/",
+      time      = c(date_str, date_str),
+      longitude = lon_range,
+      latitude  = lat_range,
+      fields    = "sst"
+    )
+
+    sst_df <- raw$data
+    if (is.null(sst_df) || nrow(sst_df) == 0) return(NULL)
+
+    # Rename to common column names
+    names(sst_df) <- tolower(names(sst_df))
+    sst_df <- sst_df[, c("longitude", "latitude", "sst")]
+    sst_df <- sst_df[!is.na(sst_df$sst), ]
+
+    # For each grid point find the nearest SST raster cell
+    # (vectorised nearest-neighbour via outer difference)
+    matched_sst <- vapply(seq_len(nrow(grid)), function(i) {
+      dx  <- (sst_df$longitude - grid$lon[i])^2
+      dy  <- (sst_df$latitude  - grid$lat[i])^2
+      idx <- which.min(dx + dy)
+      if (length(idx) == 0) NA_real_ else sst_df$sst[idx]
+    }, numeric(1))
+
+    grid$sst <- matched_sst
+    grid
+  }, error = function(e) {
+    message("fetch_sst error: ", conditionMessage(e))
+    NULL
+  })
+}
+
+# ---------------------------------------------------------------------------
+# Pre-load static data (runs once at startup)
+# ---------------------------------------------------------------------------
+
+nwfsc <- surveyjoin::nwfsc_grid
+nwfsc <- nwfsc[nwfsc$survey == "NWFSC.Combo", ]
+nwfsc$cell_id <- seq_len(nrow(nwfsc))
+
+# ---------------------------------------------------------------------------
+# UI
+# ---------------------------------------------------------------------------
+
+ui <- fluidPage(
+  titlePanel("NWFSC Survey Grid – Sea Surface Temperature"),
+
+  sidebarLayout(
+    sidebarPanel(
+      width = 3,
+      h4("Select a Date"),
+      uiOutput("date_ui"),
+      br(),
+      actionButton("fetch_btn", "Fetch SST", class = "btn-primary"),
+      br(), br(),
+      helpText(
+        "Points are colored by SST (°C) using the viridis palette.",
+        "Click a point to see its Mean SST and Grid Cell ID."
+      ),
+      br(),
+      verbatimTextOutput("status_msg")
+    ),
+
+    mainPanel(
+      width = 9,
+      leafletOutput("map", height = "80vh")
+    )
+  )
+)
+
+# ---------------------------------------------------------------------------
+# Server
+# ---------------------------------------------------------------------------
+
+server <- function(input, output, session) {
+
+  # -- Fetch available dates once per session --------------------------------
+  available_dates <- reactive({
+    withProgress(message = "Loading available dates…", value = 0.3, {
+      d <- get_erddap_dates()
+      if (is.null(d)) {
+        showNotification(
+          "Could not retrieve date range from ERDDAP. Using last 30 days as fallback.",
+          type = "warning", duration = 10
+        )
+        d <- seq(Sys.Date() - 30, Sys.Date(), by = "day")
+      }
+      d
+    })
+  })
+
+  # -- Render date picker ----------------------------------------------------
+  output$date_ui <- renderUI({
+    dates <- available_dates()
+    dateInput(
+      "sel_date",
+      label   = NULL,
+      value   = max(dates) - 1L,   # default: most-recent minus 1 (often available)
+      min     = min(dates),
+      max     = max(dates)
+    )
+  })
+
+  # -- Base leaflet map (rendered once) --------------------------------------
+  output$map <- renderLeaflet({
+    leaflet() %>%
+      addTiles() %>%
+      setView(lng = -125, lat = 46, zoom = 5)
+  })
+
+  # -- Status message --------------------------------------------------------
+  status <- reactiveVal("")
+  output$status_msg <- renderText(status())
+
+  # -- Fetch SST on button click ---------------------------------------------
+  sst_data <- eventReactive(input$fetch_btn, {
+    req(input$sel_date)
+
+    sel_date <- as.Date(input$sel_date)
+
+    # Validate against available dates
+    dates <- available_dates()
+    if (!is.null(dates) && !sel_date %in% dates) {
+      status(paste0(
+        "Date ", sel_date,
+        " is not available on the ERDDAP server. Please choose another date."
+      ))
+      return(NULL)
+    }
+
+    status("Fetching SST data…")
+
+    result <- withProgress(message = "Fetching SST from ERDDAP…", value = 0.5, {
+      fetch_sst(nwfsc, sel_date)
+    })
+
+    if (is.null(result)) {
+      status(paste0(
+        "No SST data found for ", sel_date,
+        ". Please choose another date."
+      ))
+      return(NULL)
+    }
+
+    status(paste0("SST loaded for ", sel_date,
+                  " (", sum(!is.na(result$sst)), " points)."))
+    result
+  })
+
+  # -- Update map whenever sst_data changes ----------------------------------
+  observe({
+    df <- sst_data()
+    req(!is.null(df), nrow(df) > 0)
+
+    df_valid <- df[!is.na(df$sst), ]
+    if (nrow(df_valid) == 0) return()
+
+    sst_vals <- df_valid$sst
+    pal <- colorNumeric(
+      palette = viridis(256),
+      domain  = sst_vals,
+      na.color = "transparent"
+    )
+
+    leafletProxy("map", data = df_valid) %>%
+      clearMarkers() %>%
+      clearControls() %>%
+      addCircleMarkers(
+        lng    = ~lon,
+        lat    = ~lat,
+        radius = 4,
+        color  = ~pal(sst),
+        stroke = FALSE,
+        fillOpacity = 0.85,
+        popup  = ~paste0(
+          "<b>Grid Cell ID:</b> ", cell_id, "<br>",
+          "<b>SST:</b> ", round(sst, 2), " °C<br>",
+          "<b>Lon:</b> ", round(lon, 3), "<br>",
+          "<b>Lat:</b> ", round(lat, 3)
+        )
+      ) %>%
+      addLegend(
+        position = "bottomright",
+        pal      = pal,
+        values   = sst_vals,
+        title    = "SST (°C)",
+        opacity  = 0.85
+      )
+  })
+}
+
+# ---------------------------------------------------------------------------
+# Launch
+# ---------------------------------------------------------------------------
+
+shinyApp(ui = ui, server = server)