Add AOI resolver and frs_params() for habitat model pipeline

NAMESPACE

@@ -11,6 +11,7 @@ export(frs_network_downstream)
 export(frs_network_prune)
 export(frs_network_upstream)
 export(frs_order_filter)
+export(frs_params)
 export(frs_point_locate)
 export(frs_point_snap)
 export(frs_stream_fetch)

R/frs_params.R

@@ -0,0 +1,137 @@
+#' Load Habitat Model Parameter Sets
+#'
+#' Load species-specific habitat thresholds from a PostgreSQL table or a local
+#' CSV file. Returns a list of parameter sets, one per species, ready for
+#' iteration with [lapply()] or `purrr::walk()` over the `frs_break()` /
+#' `frs_classify()` pipeline.
+#'
+#' @param conn A [DBI::DBIConnection-class] object. Required when reading
+#'   from a database table. Ignored when `csv` is provided.
+#' @param table Character. Schema-qualified table name to read parameters from.
+#'   Default `"bcfishpass.parameters_habitat_thresholds"`.
+#' @param csv Character or `NULL`. Path to a local CSV file. When provided,
+#'   `conn` and `table` are ignored.
+#'
+#' @return A named list of parameter sets, keyed by species code. Each element
+#'   is a list with threshold values and a `ranges` sub-list suitable for
+#'   passing to `frs_classify()`.
+#'
+#' @family parameters
+#'
+#' @export
+#'
+#' @examples
+#' # Load species thresholds from bundled test data
+#' params <- frs_params(csv = system.file("testdata", "test_params.csv",
+#'   package = "fresh"))
+#' names(params)
+#'
+#' # Coho spawning: gradient 0-5.5%, channel width 2m+, MAD 0.16-9999 m3/s
+#' params$CO$ranges$spawn
+#'
+#' # Bull trout rearing: no gradient or MAD constraint, just channel width 1.5m+
+#' params$BT$ranges$rear
+#'
+#' \dontrun{
+#' conn <- frs_db_conn()
+#'
+#' # Default: bcfishpass parameter tables (11 species)
+#' params <- frs_params(conn)
+#'
+#' # Drive the pipeline — one iteration per species
+#' lapply(params, function(p) {
+#'   message(p$species_code, ": gradient max = ", p$spawn_gradient_max)
+#'   # frs_break(conn, ..., threshold = p$spawn_gradient_max)
+#'   # frs_classify(conn, ..., ranges = p$ranges$spawn)
+#' })
+#'
+#' DBI::dbDisconnect(conn)
+#' }
+frs_params <- function(conn = NULL,
+                       table = "bcfishpass.parameters_habitat_thresholds",
+                       csv = NULL) {
+  if (!is.null(csv)) {
+    raw <- utils::read.csv(csv, stringsAsFactors = FALSE)
+  } else {
+    if (is.null(conn)) {
+      stop("conn is required when csv is not provided", call. = FALSE)
+    }
+    .frs_validate_identifier(table, "table")
+    raw <- DBI::dbGetQuery(conn, sprintf("SELECT * FROM %s", table))
+  }
+
+  if (nrow(raw) == 0) {
+    stop("No parameter rows found", call. = FALSE)
+  }
+  if (!"species_code" %in% names(raw)) {
+    stop("Table must have a 'species_code' column", call. = FALSE)
+  }
+
+  # Build a list keyed by species_code
+  species_list <- split(raw, raw$species_code)
+  params <- lapply(species_list, function(row) {
+    row <- as.list(row)
+
+    # Convert numeric fields
+    num_fields <- setdiff(names(row), "species_code")
+    for (f in num_fields) {
+      row[[f]] <- as.numeric(row[[f]])
+    }
+
+    # Build ranges sub-list for frs_classify()
+    row$ranges <- .frs_build_ranges(row)
+
+    row
+  })
+
+  params
+}
+
+
+#' Build ranges list from a parameter row
+#'
+#' Extracts spawn and rear threshold ranges from a flat parameter list into
+#' the `list(column = c(min, max))` format expected by `frs_classify()`.
+#'
+#' @param row A list with threshold fields (e.g. `spawn_gradient_max`,
+#'   `spawn_channel_width_min`, etc.).
+#' @return A list with `spawn` and `rear` elements, each a named list of
+#'   `c(min, max)` ranges. NULL thresholds are excluded.
+#' @noRd
+.frs_build_ranges <- function(row) {
+  build_range <- function(prefix) {
+    ranges <- list()
+
+    gradient_max <- row[[paste0(prefix, "_gradient_max")]]
+    if (!is.null(gradient_max) && !is.na(gradient_max)) {
+      ranges$gradient <- c(0, gradient_max)
+    }
+
+    cw_min <- row[[paste0(prefix, "_channel_width_min")]]
+    cw_max <- row[[paste0(prefix, "_channel_width_max")]]
+    if (!is.null(cw_min) && !is.na(cw_min)) {
+      max_val <- if (!is.null(cw_max) && !is.na(cw_max)) cw_max else Inf
+      ranges$channel_width <- c(cw_min, max_val)
+    }
+
+    mad_min <- row[[paste0(prefix, "_mad_min")]]
+    mad_max <- row[[paste0(prefix, "_mad_max")]]
+    if (!is.null(mad_min) && !is.na(mad_min)) {
+      max_val <- if (!is.null(mad_max) && !is.na(mad_max)) mad_max else Inf
+      ranges$mad_m3s <- c(mad_min, max_val)
+    }
+
+    lake_min <- row[[paste0(prefix, "_lake_ha_min")]]
+    if (!is.null(lake_min) && !is.na(lake_min)) {
+      ranges$lake_ha <- c(lake_min, Inf)
+    }
+
+    if (length(ranges) == 0) return(NULL)
+    ranges
+  }
+
+  list(
+    spawn = build_range("spawn"),
+    rear = build_range("rear")
+  )
+}

R/utils.R

@@ -139,6 +139,123 @@
 }
 
 
+#' Check if a DB connection to fwapg is available
+#'
+#' Attempts to connect and run a trivial query. Returns `TRUE` on success,
+#' `FALSE` on any failure. Used by integration tests to skip gracefully
+#' when no tunnel/DB is available.
+#'
+#' @return Logical scalar.
+#' @noRd
+.frs_db_available <- function() {
+  tryCatch({
+    conn <- frs_db_conn()
+    on.exit(DBI::dbDisconnect(conn))
+    DBI::dbGetQuery(conn, "SELECT 1")
+    TRUE
+  }, error = function(e) FALSE)
+}
+
+
+#' Resolve an AOI specification to a SQL WHERE predicate
+#'
+#' Normalizes any AOI input into a SQL predicate string that can be appended
+#' to a WHERE clause. Handles sf polygons, table+id lookups, character
+#' shortcuts (via partition options), blk+measure watershed delineation,
+#' and NULL (no filter).
+#'
+#' @param aoi AOI specification. One of:
+#'   - `NULL` — no spatial filter
+#'   - Character vector — shortcut for partition table lookup using
+#'     `getOption("fresh.partition_table")` and
+#'     `getOption("fresh.partition_col")`
+#'   - `sf`/`sfc` polygon — spatial intersection
+#'   - Named list with `table` and `id` (and optionally `id_col`) — lookup
+#'     polygon from a pg table
+#'   - Named list with `blk` and `measure` — delineate watershed via
+#'     `fwa_watershedatmeasure()`
+#' @param conn A [DBI::DBIConnection-class] object. Required for sf upload,
+#'   table lookup, and blk+measure delineation. Not needed for character
+#'   or NULL inputs.
+#' @param geom_col Character. Name of the geometry column in the target
+#'   table. Default `"geom"`.
+#' @param alias Character. Table alias prefix for the predicate. Default
+#'   `""` (no prefix).
+#'
+#' @return Character scalar. A SQL predicate (without leading WHERE/AND),
+#'   or empty string `""` for NULL aoi.
+#' @noRd
+.frs_resolve_aoi <- function(aoi, conn = NULL, geom_col = "geom",
+                             alias = "") {
+  if (is.null(aoi)) return("")
+
+  prefix <- if (nzchar(alias)) paste0(alias, ".") else ""
+
+  # Character vector — partition table shortcut
+
+  if (is.character(aoi)) {
+    tbl <- getOption("fresh.partition_table",
+                     "whse_basemapping.fwa_watershed_groups_poly")
+    col <- getOption("fresh.partition_col", "watershed_group_code")
+    .frs_validate_identifier(tbl, "partition table")
+    .frs_validate_identifier(col, "partition column")
+    quoted <- paste(vapply(aoi, .frs_quote_string, character(1)),
+                    collapse = ", ")
+    return(sprintf(
+      "%s%s && (SELECT ST_Union(geom) FROM %s WHERE %s IN (%s))",
+      prefix, geom_col, tbl, col, quoted
+    ))
+  }
+
+  # sf/sfc polygon — spatial intersection
+  if (inherits(aoi, c("sf", "sfc"))) {
+    # Transform to BC Albers (3005) to match DB geometry
+    aoi_3005 <- sf::st_transform(aoi, 3005)
+    wkt <- sf::st_as_text(sf::st_union(sf::st_geometry(aoi_3005)))
+    return(sprintf(
+      "ST_Intersects(%s%s, ST_GeomFromText('%s', 3005))",
+      prefix, geom_col, wkt
+    ))
+  }
+
+  # Named list — table+id lookup or blk+measure delineation
+  if (is.list(aoi)) {
+    # blk + measure → watershed delineation
+    if (!is.null(aoi$blk) && !is.null(aoi$measure)) {
+      blk <- as.integer(aoi$blk)
+      measure <- as.numeric(aoi$measure)
+      return(sprintf(
+        "ST_Intersects(%s%s, (SELECT ST_Union(geom) FROM whse_basemapping.fwa_watershedatmeasure(%d, %s)))",
+        prefix, geom_col, blk, measure
+      ))
+    }
+
+    # table + id → polygon lookup
+    if (!is.null(aoi$table) && !is.null(aoi$id)) {
+      .frs_validate_identifier(aoi$table, "AOI table")
+      id_col <- if (!is.null(aoi$id_col)) aoi$id_col else "id"
+      .frs_validate_identifier(id_col, "AOI id column")
+      id_val <- if (is.character(aoi$id)) {
+        .frs_quote_string(aoi$id)
+      } else {
+        as.character(aoi$id)
+      }
+      return(sprintf(
+        "ST_Intersects(%s%s, (SELECT ST_Union(geom) FROM %s WHERE %s = %s))",
+        prefix, geom_col, aoi$table, id_col, id_val
+      ))
+    }
+
+    stop("list aoi must have 'blk'+'measure' or 'table'+'id'", call. = FALSE)
+  }
+
+  stop(
+    sprintf("aoi must be NULL, character, sf, or list. Got: %s", class(aoi)[1]),
+    call. = FALSE
+  )
+}
+
+
 #' Transform sf result to a target CRS
 #'
 #' @param x An `sf` object.

inst/testdata/test_params.csv

@@ -0,0 +1,4 @@
+species_code,spawn_gradient_max,spawn_channel_width_min,spawn_channel_width_max,spawn_mad_min,spawn_mad_max,rear_gradient_max,rear_channel_width_min,rear_channel_width_max,rear_mad_min,rear_mad_max,rear_lake_ha_min
+CO,0.0549,2,9999,0.164,9999,0.0549,1.5,9999,0.03,40,
+CH,0.0449,4,9999,0.46,9999,0.0549,1.5,9999,0.28,100,
+BT,0.0549,2,9999,,,,1.5,9999,,,