diff --git a/CLAUDE.md b/CLAUDE.md index 95ff203..def5582 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -13,13 +13,11 @@ scale, compute coverage of areas of interest, and select minimum photo sets usin - One exported function per file: `R/fly_footprint.R` → `tests/testthat/test-fly_footprint.R` - `inst/testdata/` — Upper Bulkley River floodplain near Houston, BC (20 photos, dual scale) -- `data-raw/make_testdata.R` — generates test data from airbc cached data -- DB functions (`fly_query_habitat`, `fly_query_lakes`) require SSH tunnel; tests use `skip_if_no_db()` +- `data-raw/make_testdata.R` — generates test data from diggs cached data ## Key Decisions - **CRS 3005** (BC Albers) not 32609 (UTM Zone 9) — works province-wide -- **DBI/RPostgres in Suggests** — non-DB users don't need database drivers - **`fly_footprint()` uses vectorized `st_coordinates()` + `lapply()`** — do NOT use `dplyr::mutate(.data$geometry)` because the geometry column may be named `geom` not `geometry` - **Priority selection pattern:** all best-resolution photos first, then greedy backfill with coarser scales (see vignette) diff --git a/DESCRIPTION b/DESCRIPTION index ad9a576..0e6e10d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,8 +8,7 @@ Authors@R: c( ) Description: Estimate ground footprints from airphoto centroids and scale, compute coverage of areas of interest, and select minimum photo sets - using greedy set-cover. Includes optional helpers for querying fish - habitat streams from bcfishpass. + using greedy set-cover. License: MIT + file LICENSE URL: https://github.com/NewGraphEnvironment/fly, https://newgraphenvironment.github.io/fly/ @@ -22,14 +21,11 @@ Depends: Imports: sf, dplyr, - glue, purrr, rlang, stringr Suggests: bookdown, - DBI, - RPostgres, testthat (>= 3.0.0), knitr, rmarkdown diff --git a/NAMESPACE b/NAMESPACE index 932a493..3715e0a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,18 +5,14 @@ export(fly_fetch) export(fly_filter) export(fly_footprint) export(fly_overlap) -export(fly_query_habitat) -export(fly_query_lakes) export(fly_select) export(fly_summary) export(fly_thumb_georef) -export(fly_trim_habitat) importFrom(rlang,"!!") importFrom(rlang,":=") importFrom(rlang,.data) importFrom(sf,sf_use_s2) importFrom(sf,st_area) -importFrom(sf,st_as_sf) importFrom(sf,st_buffer) importFrom(sf,st_coordinates) importFrom(sf,st_crs) @@ -27,9 +23,7 @@ importFrom(sf,st_intersects) importFrom(sf,st_make_valid) importFrom(sf,st_polygon) importFrom(sf,st_read) -importFrom(sf,st_set_crs) importFrom(sf,st_sf) importFrom(sf,st_sfc) importFrom(sf,st_transform) importFrom(sf,st_union) -importFrom(sf,st_zm) diff --git a/R/fly-package.R b/R/fly-package.R index 5befdaf..c666ba1 100644 --- a/R/fly-package.R +++ b/R/fly-package.R @@ -1,8 +1,7 @@ #' @keywords internal #' @importFrom sf st_transform st_crs st_buffer st_union st_intersection -#' st_make_valid st_area st_geometry st_set_crs st_sfc st_polygon st_sf -#' st_drop_geometry st_read st_zm st_as_sf st_coordinates st_intersects -#' sf_use_s2 +#' st_make_valid st_area st_geometry st_sfc st_polygon st_sf +#' st_drop_geometry st_read st_coordinates st_intersects sf_use_s2 #' @importFrom rlang .data !! := "_PACKAGE" diff --git a/R/fly_query_habitat.R b/R/fly_query_habitat.R deleted file mode 100644 index 9e5c480..0000000 --- a/R/fly_query_habitat.R +++ /dev/null @@ -1,82 +0,0 @@ -#' Query bcfishpass for habitat streams -#' -#' Queries the `bcfishpass.streams_vw` table for stream segments with modelled -#' habitat (rearing or spawning) for a given species and watershed group. -#' -#' @param conn A DBI connection to a bcfishpass database. -#' @param wsgroup Watershed group code (e.g. `"BULK"`, `"LNIC"`). -#' @param habitat_type `"rearing"` or `"spawning"`. -#' @param species_code Species code: `"co"`, `"ch"`, `"sk"`, `"bt"`, `"st"`, -#' `"wct"`, `"cm"`, `"pk"`. -#' @param blue_line_keys Numeric vector of FWA blue_line_key values -#' (preferred — unique per stream). -#' @param stream_names Character vector of GNIS stream names -#' (convenience — scoped to wsgroup). -#' @param min_stream_order Minimum Strahler order (applied in addition to -#' blk/name filters). -#' @return An sf linestring object in WGS84 (EPSG:4326). -#' -#' @export -fly_query_habitat <- function( - conn, - wsgroup, - habitat_type = "rearing", - species_code = "co", - blue_line_keys = NULL, - stream_names = NULL, - min_stream_order = NULL -) { - if (!requireNamespace("DBI", quietly = TRUE)) { - stop("Package 'DBI' is required for fly_query_habitat().", call. = FALSE) - } - - habitat_col <- paste0(habitat_type, "_", species_code) - - valid_cols <- DBI::dbGetQuery(conn, - "SELECT column_name FROM information_schema.columns - WHERE table_schema = 'bcfishpass' AND table_name = 'streams_vw'")$column_name - if (!habitat_col %in% valid_cols) { - stop("Column '", habitat_col, "' not found in bcfishpass.streams_vw. ", - "Valid habitat columns: ", - paste(grep("^(rearing|spawning)_", valid_cols, value = TRUE), collapse = ", ")) - } - - clauses <- c( - glue::glue("watershed_group_code = '{wsgroup}'"), - glue::glue("{habitat_col} = 1") - ) - - if (!is.null(blue_line_keys)) { - blk_list <- paste(blue_line_keys, collapse = ", ") - clauses <- c(clauses, glue::glue("blue_line_key IN ({blk_list})")) - message("Querying ", habitat_col, " streams by blue_line_key (", - length(blue_line_keys), " streams)...") - } else if (!is.null(stream_names)) { - names_list <- paste0("'", stream_names, "'", collapse = ", ") - clauses <- c(clauses, glue::glue("gnis_name IN ({names_list})")) - message("Querying ", habitat_col, " streams by name: ", - paste(stream_names, collapse = ", "), "...") - } else { - message("Querying all ", habitat_col, " streams in ", wsgroup, "...") - } - - if (!is.null(min_stream_order)) { - clauses <- c(clauses, glue::glue("stream_order >= {min_stream_order}")) - } - - where <- paste(clauses, collapse = "\n AND ") - - sql <- glue::glue(" - SELECT segmented_stream_id, blue_line_key, waterbody_key, - downstream_route_measure, gnis_name, - stream_order, channel_width, {habitat_col}, access_{species_code}, - ST_Transform(geom, 4326) as geom - FROM bcfishpass.streams_vw - WHERE {where} - ") - - result <- sf::st_read(conn, query = sql) |> - sf::st_zm(drop = TRUE) - message(" ", nrow(result), " stream segments") - result -} diff --git a/R/fly_query_lakes.R b/R/fly_query_lakes.R deleted file mode 100644 index db22e32..0000000 --- a/R/fly_query_lakes.R +++ /dev/null @@ -1,38 +0,0 @@ -#' Query FWA lake polygons that intersect habitat streams -#' -#' Returns lake polygons from `whse_basemapping.fwa_lakes_poly` that share a -#' `waterbody_key` with the input streams. Use with [fly_trim_habitat()] to -#' fill gaps where lakes interrupt the stream network. -#' -#' @param conn A DBI connection to a bcfishpass database. -#' @param streams_sf An sf linestring — habitat streams (e.g. from -#' [fly_query_habitat()]). -#' @return An sf polygon object in WGS84 (EPSG:4326), or `NULL` if no -#' waterbody keys are found. -#' -#' @export -fly_query_lakes <- function(conn, streams_sf) { - if (!requireNamespace("DBI", quietly = TRUE)) { - stop("Package 'DBI' is required for fly_query_lakes().", call. = FALSE) - } - - wbkeys <- unique(streams_sf$waterbody_key) - wbkeys <- wbkeys[!is.na(wbkeys) & wbkeys != 0] - - if (length(wbkeys) == 0) { - message("No waterbody keys found in streams - no lakes to query") - return(NULL) - } - - wbkey_list <- paste(wbkeys, collapse = ", ") - sql <- glue::glue(" - SELECT waterbody_key, gnis_name_1, - ST_Transform(geom, 4326) as geom - FROM whse_basemapping.fwa_lakes_poly - WHERE waterbody_key IN ({wbkey_list}) - ") - - result <- sf::st_read(conn, query = sql, quiet = TRUE) - message(" ", nrow(result), " lake polygons") - result -} diff --git a/R/fly_trim_habitat.R b/R/fly_trim_habitat.R deleted file mode 100644 index b125581..0000000 --- a/R/fly_trim_habitat.R +++ /dev/null @@ -1,81 +0,0 @@ -#' Trim floodplain to areas alongside target streams -#' -#' Uses flat-cap buffer to extend perpendicular to streams without extending -#' past stream endpoints. Optionally includes lake polygons to fill gaps where -#' lakes interrupt the stream network. Optionally adds a photo capture buffer. -#' -#' @param floodplain_sf An sf polygon — the floodplain or lateral habitat boundary. -#' @param streams_sf An sf linestring — pre-filtered streams (from -#' [fly_query_habitat()] or any source). -#' @param lakes_sf An sf polygon — lake polygons to include (from -#' [fly_query_lakes()] or any source). Fills gaps where lakes interrupt -#' stream networks. `NULL` to skip. -#' @param floodplain_width Buffer distance (m) perpendicular to streams. -#' Should capture the full floodplain width. Uses flat end caps. -#' @param photo_buffer Buffer (m) around trimmed floodplain for photo centroid -#' capture. Set to 0 to return the trimmed floodplain only. -#' @return An sf polygon in WGS84 (EPSG:4326). -#' -#' @examples -#' streams <- sf::st_read(system.file("testdata/streams.gpkg", package = "fly")) -#' floodplain <- sf::st_read(system.file("testdata/floodplain.gpkg", package = "fly")) -#' trimmed <- fly_trim_habitat(floodplain, streams, photo_buffer = 0) -#' plot(sf::st_geometry(trimmed)) -#' -#' @export -fly_trim_habitat <- function( - floodplain_sf, - streams_sf, - lakes_sf = NULL, - floodplain_width = 2000, - photo_buffer = 1800 -) { - sf::sf_use_s2(FALSE) - on.exit(sf::sf_use_s2(TRUE)) - - streams_albers <- sf::st_transform(streams_sf, 3005) - floodplain_albers <- sf::st_transform(floodplain_sf, 3005) |> - sf::st_union() |> - sf::st_make_valid() - - message("Buffering streams by ", floodplain_width, "m (flat cap)...") - streams_buffered <- sf::st_buffer(streams_albers, dist = floodplain_width, - endCapStyle = "FLAT") |> - sf::st_union() |> - sf::st_make_valid() - - if (!is.null(lakes_sf) && nrow(lakes_sf) > 0) { - lakes_albers <- sf::st_transform(lakes_sf, 3005) |> - sf::st_union() |> - sf::st_make_valid() - message("Including ", nrow(lakes_sf), " lake polygons...") - streams_buffered <- sf::st_union(streams_buffered, lakes_albers) |> - sf::st_make_valid() - } - - message("Intersecting with floodplain...") - trimmed <- sf::st_intersection(streams_buffered, floodplain_albers) |> - sf::st_make_valid() - - if (photo_buffer > 0) { - message("Adding ", photo_buffer, "m photo capture buffer...") - result <- sf::st_buffer(trimmed, dist = photo_buffer) |> - sf::st_make_valid() - } else { - result <- trimmed - } - - result <- result |> sf::st_transform(4326) - - area_orig <- as.numeric(sf::st_area(floodplain_albers)) / 1e6 - area_trimmed <- as.numeric(sf::st_area(trimmed)) / 1e6 - area_final <- as.numeric(sum(sf::st_area(result))) / 1e6 - message("Original floodplain: ", round(area_orig, 1), " km2") - message("Trimmed floodplain: ", round(area_trimmed, 1), " km2 (", - round((1 - area_trimmed / area_orig) * 100), "% reduction)") - if (photo_buffer > 0) { - message("Photo capture zone: ", round(area_final, 1), " km2") - } - - sf::st_sf(geometry = sf::st_geometry(result)) -} diff --git a/man/fly-package.Rd b/man/fly-package.Rd index b0882e1..6ffc9ce 100644 --- a/man/fly-package.Rd +++ b/man/fly-package.Rd @@ -8,7 +8,7 @@ \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} -Estimate ground footprints from airphoto centroids and scale, compute coverage of areas of interest, and select minimum photo sets using greedy set-cover. Includes optional helpers for querying fish habitat streams from bcfishpass. +Estimate ground footprints from airphoto centroids and scale, compute coverage of areas of interest, and select minimum photo sets using greedy set-cover. } \seealso{ Useful links: diff --git a/man/fly_query_habitat.Rd b/man/fly_query_habitat.Rd deleted file mode 100644 index b829690..0000000 --- a/man/fly_query_habitat.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fly_query_habitat.R -\name{fly_query_habitat} -\alias{fly_query_habitat} -\title{Query bcfishpass for habitat streams} -\usage{ -fly_query_habitat( - conn, - wsgroup, - habitat_type = "rearing", - species_code = "co", - blue_line_keys = NULL, - stream_names = NULL, - min_stream_order = NULL -) -} -\arguments{ -\item{conn}{A DBI connection to a bcfishpass database.} - -\item{wsgroup}{Watershed group code (e.g. \code{"BULK"}, \code{"LNIC"}).} - -\item{habitat_type}{\code{"rearing"} or \code{"spawning"}.} - -\item{species_code}{Species code: \code{"co"}, \code{"ch"}, \code{"sk"}, \code{"bt"}, \code{"st"}, -\code{"wct"}, \code{"cm"}, \code{"pk"}.} - -\item{blue_line_keys}{Numeric vector of FWA blue_line_key values -(preferred — unique per stream).} - -\item{stream_names}{Character vector of GNIS stream names -(convenience — scoped to wsgroup).} - -\item{min_stream_order}{Minimum Strahler order (applied in addition to -blk/name filters).} -} -\value{ -An sf linestring object in WGS84 (EPSG:4326). -} -\description{ -Queries the \code{bcfishpass.streams_vw} table for stream segments with modelled -habitat (rearing or spawning) for a given species and watershed group. -} diff --git a/man/fly_query_lakes.Rd b/man/fly_query_lakes.Rd deleted file mode 100644 index 5ffc9b5..0000000 --- a/man/fly_query_lakes.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fly_query_lakes.R -\name{fly_query_lakes} -\alias{fly_query_lakes} -\title{Query FWA lake polygons that intersect habitat streams} -\usage{ -fly_query_lakes(conn, streams_sf) -} -\arguments{ -\item{conn}{A DBI connection to a bcfishpass database.} - -\item{streams_sf}{An sf linestring — habitat streams (e.g. from -\code{\link[=fly_query_habitat]{fly_query_habitat()}}).} -} -\value{ -An sf polygon object in WGS84 (EPSG:4326), or \code{NULL} if no -waterbody keys are found. -} -\description{ -Returns lake polygons from \code{whse_basemapping.fwa_lakes_poly} that share a -\code{waterbody_key} with the input streams. Use with \code{\link[=fly_trim_habitat]{fly_trim_habitat()}} to -fill gaps where lakes interrupt the stream network. -} diff --git a/man/fly_trim_habitat.Rd b/man/fly_trim_habitat.Rd deleted file mode 100644 index b5f4992..0000000 --- a/man/fly_trim_habitat.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fly_trim_habitat.R -\name{fly_trim_habitat} -\alias{fly_trim_habitat} -\title{Trim floodplain to areas alongside target streams} -\usage{ -fly_trim_habitat( - floodplain_sf, - streams_sf, - lakes_sf = NULL, - floodplain_width = 2000, - photo_buffer = 1800 -) -} -\arguments{ -\item{floodplain_sf}{An sf polygon — the floodplain or lateral habitat boundary.} - -\item{streams_sf}{An sf linestring — pre-filtered streams (from -\code{\link[=fly_query_habitat]{fly_query_habitat()}} or any source).} - -\item{lakes_sf}{An sf polygon — lake polygons to include (from -\code{\link[=fly_query_lakes]{fly_query_lakes()}} or any source). Fills gaps where lakes interrupt -stream networks. \code{NULL} to skip.} - -\item{floodplain_width}{Buffer distance (m) perpendicular to streams. -Should capture the full floodplain width. Uses flat end caps.} - -\item{photo_buffer}{Buffer (m) around trimmed floodplain for photo centroid -capture. Set to 0 to return the trimmed floodplain only.} -} -\value{ -An sf polygon in WGS84 (EPSG:4326). -} -\description{ -Uses flat-cap buffer to extend perpendicular to streams without extending -past stream endpoints. Optionally includes lake polygons to fill gaps where -lakes interrupt the stream network. Optionally adds a photo capture buffer. -} -\examples{ -streams <- sf::st_read(system.file("testdata/streams.gpkg", package = "fly")) -floodplain <- sf::st_read(system.file("testdata/floodplain.gpkg", package = "fly")) -trimmed <- fly_trim_habitat(floodplain, streams, photo_buffer = 0) -plot(sf::st_geometry(trimmed)) - -} diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index f95d8a0..dc3ee43 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -3,16 +3,3 @@ testdata_path <- function(...) { system.file("testdata", ..., package = "fly", mustWork = TRUE) } -# Skip helper for database-dependent tests -skip_if_no_db <- function() { - testthat::skip_if_not( - tryCatch({ - conn <- DBI::dbConnect(RPostgres::Postgres(), - host = "localhost", port = 63333, - dbname = "bcfishpass", user = "newgraph") - DBI::dbDisconnect(conn) - TRUE - }, error = function(e) FALSE), - "bcfishpass DB not available" - ) -} diff --git a/tests/testthat/test-fly_query_habitat.R b/tests/testthat/test-fly_query_habitat.R deleted file mode 100644 index 6a47ed2..0000000 --- a/tests/testthat/test-fly_query_habitat.R +++ /dev/null @@ -1,16 +0,0 @@ -test_that("fly_query_habitat requires DBI", { - skip_if_no_db() - - conn <- DBI::dbConnect(RPostgres::Postgres(), - host = "localhost", port = 63333, - dbname = "bcfishpass", user = "newgraph") - on.exit(DBI::dbDisconnect(conn)) - - result <- fly_query_habitat(conn, wsgroup = "BULK", - habitat_type = "rearing", species_code = "co", - min_stream_order = 6) - - expect_s3_class(result, "sf") - expect_true(nrow(result) > 0) - expect_true("blue_line_key" %in% names(result)) -}) diff --git a/tests/testthat/test-fly_query_lakes.R b/tests/testthat/test-fly_query_lakes.R deleted file mode 100644 index 3aaa417..0000000 --- a/tests/testthat/test-fly_query_lakes.R +++ /dev/null @@ -1,34 +0,0 @@ -test_that("fly_query_lakes returns NULL when no waterbody keys", { - # Synthetic sf with waterbody_key = 0 (no real lake) - streams <- sf::st_sf( - waterbody_key = c(0, 0), - geometry = sf::st_sfc( - sf::st_linestring(matrix(c(0, 0, 1, 1), ncol = 2)), - sf::st_linestring(matrix(c(1, 1, 2, 2), ncol = 2)), - crs = 4326 - ) - ) - - # This test doesn't need a DB — the NULL path triggers before any query - result <- fly_query_lakes(conn = NULL, streams_sf = streams) - expect_null(result) -}) - -test_that("fly_query_lakes queries DB when keys exist", { - skip_if_no_db() - - conn <- DBI::dbConnect(RPostgres::Postgres(), - host = "localhost", port = 63333, - dbname = "bcfishpass", user = "newgraph") - on.exit(DBI::dbDisconnect(conn)) - - streams <- fly_query_habitat(conn, wsgroup = "BULK", - habitat_type = "rearing", species_code = "co", - min_stream_order = 6) - - result <- fly_query_lakes(conn, streams) - # May return sf or NULL depending on data - if (!is.null(result)) { - expect_s3_class(result, "sf") - } -}) diff --git a/tests/testthat/test-fly_trim_habitat.R b/tests/testthat/test-fly_trim_habitat.R deleted file mode 100644 index e494a63..0000000 --- a/tests/testthat/test-fly_trim_habitat.R +++ /dev/null @@ -1,35 +0,0 @@ -test_that("fly_trim_habitat returns sf POLYGON", { - streams <- sf::st_read(testdata_path("streams.gpkg"), quiet = TRUE) - floodplain <- sf::st_read(testdata_path("floodplain.gpkg"), quiet = TRUE) - result <- fly_trim_habitat(floodplain, streams, photo_buffer = 0) - expect_s3_class(result, "sf") -}) - -test_that("fly_trim_habitat output is smaller than input floodplain", { - streams <- sf::st_read(testdata_path("streams.gpkg"), quiet = TRUE) - floodplain <- sf::st_read(testdata_path("floodplain.gpkg"), quiet = TRUE) - result <- fly_trim_habitat(floodplain, streams, photo_buffer = 0) - - area_orig <- as.numeric(sf::st_area(sf::st_transform(sf::st_union(floodplain), 3005))) - area_trimmed <- as.numeric(sum(sf::st_area(sf::st_transform(result, 3005)))) - expect_lt(area_trimmed, area_orig) -}) - -test_that("fly_trim_habitat photo buffer increases area", { - streams <- sf::st_read(testdata_path("streams.gpkg"), quiet = TRUE) - floodplain <- sf::st_read(testdata_path("floodplain.gpkg"), quiet = TRUE) - no_buf <- fly_trim_habitat(floodplain, streams, photo_buffer = 0) - with_buf <- fly_trim_habitat(floodplain, streams, photo_buffer = 1000) - - area_no <- as.numeric(sum(sf::st_area(sf::st_transform(no_buf, 3005)))) - area_with <- as.numeric(sum(sf::st_area(sf::st_transform(with_buf, 3005)))) - expect_gt(area_with, area_no) -}) - -test_that("fly_trim_habitat works with lakes", { - streams <- sf::st_read(testdata_path("streams.gpkg"), quiet = TRUE) - floodplain <- sf::st_read(testdata_path("floodplain.gpkg"), quiet = TRUE) - lakes <- sf::st_read(testdata_path("lakes.gpkg"), quiet = TRUE) - result <- fly_trim_habitat(floodplain, streams, lakes_sf = lakes, photo_buffer = 0) - expect_s3_class(result, "sf") -})