From 7852a9539fda2b77235135cd5d05a55541847217 Mon Sep 17 00:00:00 2001 From: almac2022 Date: Sat, 7 Mar 2026 11:30:21 -0800 Subject: [PATCH] Add ensure_components for multi-polygon AOI coverage (#12) Guarantee at least one photo per disconnected AOI component before greedy selection. Includes 7 new tests, vignette section with bookdown figure cross-references, and spatial filtering table. Fixes #12 Co-Authored-By: Claude Opus 4.6 --- .Rbuildignore | 2 + DESCRIPTION | 3 +- NEWS.md | 6 +++ R/fly_select.R | 88 +++++++++++++++++++++++++++++-- man/fly_select.Rd | 18 ++++++- tests/testthat/test-fly_select.R | 90 ++++++++++++++++++++++++++++++++ vignettes/airphoto-selection.Rmd | 88 ++++++++++++++++++++++--------- 7 files changed, 265 insertions(+), 30 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index ff574a7..a7c9991 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,3 +10,5 @@ ^\.lintr$ ^doc$ ^Meta$ +^CLAUDE\.md$ +^\.claude$ diff --git a/DESCRIPTION b/DESCRIPTION index 5ff0ce8..c4b5cbd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: fly Title: Airphoto Footprint Estimation and Coverage Selection -Version: 0.1.0 +Version: 0.1.1 Authors@R: c( person("Allan", "Irvine", , "al@newgraphenvironment.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-3495-2128")), @@ -27,6 +27,7 @@ Imports: rlang, stringr Suggests: + bookdown, DBI, RPostgres, testthat (>= 3.0.0), diff --git a/NEWS.md b/NEWS.md index 242e640..13ecea5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # fly (development version) +## 0.1.1 (2026-03-07) + +- Add `ensure_components` parameter to `fly_select()` for multi-polygon AOIs — guarantees at least one photo per disconnected component before greedy selection ([#12](https://github.com/NewGraphEnvironment/fly/issues/12)) +- Vignette uses bookdown with numbered sections and figure cross-references +- Add `bookdown` to Suggests + ## 0.1.0 (2026-03-04) Initial release. Airphoto footprint estimation and coverage selection, diff --git a/R/fly_select.R b/R/fly_select.R index f32e47c..03940f0 100644 --- a/R/fly_select.R +++ b/R/fly_select.R @@ -11,6 +11,11 @@ #' (every photo touching the AOI). #' @param target_coverage Stop when this fraction is reached (default 0.95). #' Only used when `mode = "minimal"`. +#' @param ensure_components If `TRUE` (default `FALSE`), guarantee that every +#' polygon component of `aoi_sf` is covered by at least one photo before +#' running the greedy selection. Useful for multi-polygon AOIs (e.g. patchy +#' floodplain fragments) where small components might otherwise get zero +#' coverage. Only used when `mode = "minimal"`. #' @return An sf object (subset of `photos_sf`). For `mode = "minimal"`, #' includes `selection_order` and `cumulative_coverage_pct` columns. #' @@ -21,19 +26,24 @@ #' # Fewest photos to reach 80% coverage #' fly_select(centroids, aoi, mode = "minimal", target_coverage = 0.80) #' +#' # Ensure every AOI component gets at least one photo +#' fly_select(centroids, aoi, mode = "minimal", target_coverage = 0.80, +#' ensure_components = TRUE) +#' #' # All photos touching the AOI #' fly_select(centroids, aoi, mode = "all") #' #' @export fly_select <- function(photos_sf, aoi_sf, mode = "minimal", - target_coverage = 0.95) { + target_coverage = 0.95, + ensure_components = FALSE) { mode <- match.arg(mode, c("minimal", "all")) if (mode == "all") { return(fly_select_all(photos_sf, aoi_sf)) } - fly_select_minimal(photos_sf, aoi_sf, target_coverage) + fly_select_minimal(photos_sf, aoi_sf, target_coverage, ensure_components) } #' @noRd @@ -53,8 +63,43 @@ fly_select_all <- function(photos_sf, aoi_sf) { result } +#' Pick one photo per uncovered AOI component +#' +#' For each polygon component that has no coverage yet, find the photo whose +#' footprint covers the most area of that component. #' @noRd -fly_select_minimal <- function(photos_sf, aoi_sf, target_coverage) { +ensure_component_coverage <- function(footprints, aoi_albers) { + components <- sf::st_cast(aoi_albers, "POLYGON") + must_keep <- integer(0) + + for (k in seq_along(components)) { + comp <- components[k] + hits <- sf::st_intersects(footprints, comp, sparse = FALSE)[, 1] + if (!any(hits)) next + + candidates <- footprints[hits, ] + areas <- vapply(seq_len(nrow(candidates)), function(i) { + tryCatch({ + isect <- sf::st_intersection( + sf::st_geometry(candidates[i, ]), comp + ) |> sf::st_make_valid() + if (length(isect) == 0) return(0) + as.numeric(sf::st_area(isect)) + }, error = function(e) 0) + }, numeric(1)) + + if (max(areas) > 0) { + best <- candidates$photo_idx[which.max(areas)] + must_keep <- c(must_keep, best) + } + } + + unique(must_keep) +} + +#' @noRd +fly_select_minimal <- function(photos_sf, aoi_sf, target_coverage, + ensure_components) { sf::sf_use_s2(FALSE) on.exit(sf::sf_use_s2(TRUE)) @@ -71,9 +116,46 @@ fly_select_minimal <- function(photos_sf, aoi_sf, target_coverage) { coverage_pcts <- numeric(0) covered_so_far <- sf::st_sfc(sf::st_polygon(), crs = 3005) + # Seed with must-keep photos for component coverage + if (ensure_components) { + seed_idx <- ensure_component_coverage(footprints, aoi_albers) + if (length(seed_idx) > 0) { + message("Seeding ", length(seed_idx), + " photos for component coverage...") + for (idx in seed_idx) { + selected_idx <- c(selected_idx, idx) + fp <- sf::st_geometry(footprints[footprints$photo_idx == idx, ]) + covered_so_far <- sf::st_union(covered_so_far, fp) |> + sf::st_make_valid() + covered_in_aoi <- tryCatch( + sf::st_intersection(covered_so_far, aoi_albers) |> + sf::st_make_valid(), + error = function(e) covered_so_far + ) + uncovered <- tryCatch( + sf::st_difference(aoi_albers, covered_so_far) |> + sf::st_make_valid(), + error = function(e) aoi_albers + ) + pct <- sum(as.numeric(sf::st_area(covered_in_aoi))) / aoi_area + coverage_pcts <- c(coverage_pcts, pct) + } + message(" ", length(selected_idx), " seed photos -> ", + round(coverage_pcts[length(coverage_pcts)] * 100, 1), + "% coverage") + } + } + message("Selecting photos (target: ", target_coverage * 100, "% coverage)...") while (TRUE) { + cur_pct <- if (length(coverage_pcts) > 0) { + coverage_pcts[length(coverage_pcts)] + } else { + 0 + } + if (cur_pct >= target_coverage) break + remaining <- footprints[!footprints$photo_idx %in% selected_idx, ] if (nrow(remaining) == 0) break diff --git a/man/fly_select.Rd b/man/fly_select.Rd index 3aa718a..de818a8 100644 --- a/man/fly_select.Rd +++ b/man/fly_select.Rd @@ -4,7 +4,13 @@ \alias{fly_select} \title{Select photos covering an AOI} \usage{ -fly_select(photos_sf, aoi_sf, mode = "minimal", target_coverage = 0.95) +fly_select( + photos_sf, + aoi_sf, + mode = "minimal", + target_coverage = 0.95, + ensure_components = FALSE +) } \arguments{ \item{photos_sf}{An sf point object with a \code{scale} column @@ -17,6 +23,12 @@ fly_select(photos_sf, aoi_sf, mode = "minimal", target_coverage = 0.95) \item{target_coverage}{Stop when this fraction is reached (default 0.95). Only used when \code{mode = "minimal"}.} + +\item{ensure_components}{If \code{TRUE} (default \code{FALSE}), guarantee that every +polygon component of \code{aoi_sf} is covered by at least one photo before +running the greedy selection. Useful for multi-polygon AOIs (e.g. patchy +floodplain fragments) where small components might otherwise get zero +coverage. Only used when \code{mode = "minimal"}.} } \value{ An sf object (subset of \code{photos_sf}). For \code{mode = "minimal"}, @@ -34,6 +46,10 @@ aoi <- sf::st_read(system.file("testdata/aoi.gpkg", package = "fly")) # Fewest photos to reach 80\% coverage fly_select(centroids, aoi, mode = "minimal", target_coverage = 0.80) +# Ensure every AOI component gets at least one photo +fly_select(centroids, aoi, mode = "minimal", target_coverage = 0.80, + ensure_components = TRUE) + # All photos touching the AOI fly_select(centroids, aoi, mode = "all") diff --git a/tests/testthat/test-fly_select.R b/tests/testthat/test-fly_select.R index f2a14e3..1842d8d 100644 --- a/tests/testthat/test-fly_select.R +++ b/tests/testthat/test-fly_select.R @@ -88,3 +88,93 @@ test_that("fly_select minimal handles full coverage without error", { # coverage should be scalar, not length 0 expect_length(result$cumulative_coverage_pct, nrow(result)) }) + +# --- ensure_components tests --- + +test_that("ensure_components selects at least as many photos as without", { + centroids <- sf::st_read(testdata_path("photo_centroids.gpkg"), quiet = TRUE) + aoi <- sf::st_read(testdata_path("aoi.gpkg"), quiet = TRUE) + result_plain <- fly_select(centroids, aoi, mode = "minimal", + target_coverage = 0.80) + result_ec <- fly_select(centroids, aoi, mode = "minimal", + target_coverage = 0.80, ensure_components = TRUE) + expect_gte(nrow(result_ec), nrow(result_plain)) +}) + +test_that("ensure_components covers more AOI components", { + centroids <- sf::st_read(testdata_path("photo_centroids.gpkg"), quiet = TRUE) + aoi <- sf::st_read(testdata_path("aoi.gpkg"), quiet = TRUE) + + sf::sf_use_s2(FALSE) + components <- sf::st_cast( + sf::st_transform(aoi, 3005) |> sf::st_union() |> sf::st_make_valid(), + "POLYGON" + ) + + count_covered <- function(selected) { + fp <- fly_footprint(selected) |> sf::st_transform(3005) + fp_union <- sf::st_union(fp) |> sf::st_make_valid() + sum(vapply(seq_along(components), function(k) { + any(sf::st_intersects(fp_union, components[k], sparse = FALSE)) + }, logical(1))) + } + + result_plain <- fly_select(centroids, aoi, mode = "minimal", + target_coverage = 0.80) + result_ec <- fly_select(centroids, aoi, mode = "minimal", + target_coverage = 0.80, ensure_components = TRUE) + + covered_plain <- count_covered(result_plain) + covered_ec <- count_covered(result_ec) + + expect_gte(covered_ec, covered_plain) +}) + +test_that("ensure_components returns valid selection columns", { + centroids <- sf::st_read(testdata_path("photo_centroids.gpkg"), quiet = TRUE) + aoi <- sf::st_read(testdata_path("aoi.gpkg"), quiet = TRUE) + result <- fly_select(centroids, aoi, mode = "minimal", + target_coverage = 0.80, ensure_components = TRUE) + expect_s3_class(result, "sf") + expect_true("selection_order" %in% names(result)) + expect_true("cumulative_coverage_pct" %in% names(result)) + # selection_order should be sequential + expect_equal(result$selection_order, seq_len(nrow(result))) + # coverage should increase monotonically + if (nrow(result) > 1) { + diffs <- diff(result$cumulative_coverage_pct) + expect_true(all(diffs >= 0)) + } +}) + +test_that("ensure_components FALSE is the default", { + centroids <- sf::st_read(testdata_path("photo_centroids.gpkg"), quiet = TRUE) + aoi <- sf::st_read(testdata_path("aoi.gpkg"), quiet = TRUE) + result_default <- fly_select(centroids, aoi, mode = "minimal", + target_coverage = 0.80) + result_false <- fly_select(centroids, aoi, mode = "minimal", + target_coverage = 0.80, + ensure_components = FALSE) + expect_equal(nrow(result_default), nrow(result_false)) +}) + +test_that("ensure_components works on single-polygon AOI", { + centroids <- sf::st_read(testdata_path("photo_centroids.gpkg"), quiet = TRUE) + aoi <- sf::st_read(testdata_path("aoi.gpkg"), quiet = TRUE) + # Create single polygon from convex hull of AOI + single_aoi <- sf::st_convex_hull(sf::st_union(aoi)) + single_aoi <- sf::st_sf(geometry = single_aoi, crs = sf::st_crs(aoi)) + result <- fly_select(centroids, single_aoi, mode = "minimal", + target_coverage = 0.80, ensure_components = TRUE) + expect_s3_class(result, "sf") + expect_gt(nrow(result), 0) +}) + +test_that("ensure_components is ignored in all mode", { + centroids <- sf::st_read(testdata_path("photo_centroids.gpkg"), quiet = TRUE) + aoi <- sf::st_read(testdata_path("aoi.gpkg"), quiet = TRUE) + result_plain <- fly_select(centroids, aoi, mode = "all") + result_ec <- fly_select(centroids, aoi, mode = "all", + ensure_components = TRUE) + expect_equal(nrow(result_plain), nrow(result_ec)) +}) diff --git a/vignettes/airphoto-selection.Rmd b/vignettes/airphoto-selection.Rmd index baab93e..155f388 100644 --- a/vignettes/airphoto-selection.Rmd +++ b/vignettes/airphoto-selection.Rmd @@ -1,6 +1,9 @@ --- title: "Airphoto Selection Pipeline" -output: rmarkdown::html_vignette +output: + bookdown::html_document2: + number_sections: true + base_format: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Airphoto Selection Pipeline} %\VignetteEngine{knitr::rmarkdown} @@ -28,7 +31,7 @@ centroids <- st_read(system.file("testdata/photo_centroids.gpkg", package = "fly aoi <- st_read(system.file("testdata/aoi.gpkg", package = "fly"), quiet = TRUE) ``` -## Footprint estimation +# Footprint estimation `fly_footprint()` converts point centroids into rectangular polygons representing estimated ground coverage. The standard 9" x 9" (228 mm) negative @@ -43,28 +46,29 @@ Note that footprints assume flat terrain beneath the aircraft. On slopes the true ground coverage differs — downhill slopes produce a larger actual footprint, uphill slopes a smaller one. All coverage and overlap numbers downstream inherit this approximation. +Figure \@ref(fig:fig-footprint) shows the estimated footprints for all 20 +photos. Notice that some centroids fall outside the AOI while their footprints +still overlap it — `fly_filter()` with `method = "footprint"` catches these +edge cases that a simple centroid-in-polygon filter would miss. -```{r footprint} +```{r fig-footprint, fig.cap = "Estimated photo footprints (blue rectangles) and centroids (red dots) overlaid on the Upper Bulkley River floodplain AOI."} footprints <- fly_footprint(centroids) -plot(st_geometry(aoi), col = "lightyellow", border = "grey40", main = "Photo footprints") +plot(st_geometry(aoi), col = "lightyellow", border = "grey40") plot(st_geometry(footprints), border = "steelblue", add = TRUE) plot(st_geometry(centroids), pch = 20, cex = 0.5, col = "red", add = TRUE) ``` -## Spatial filtering - -`fly_filter()` with `method = "footprint"` catches photos whose centroid -falls outside the AOI but whose footprint overlaps it — a common situation -with large-scale photos at the edge of the study area. - ```{r filter} fp_result <- fly_filter(centroids, aoi, method = "footprint") ct_result <- fly_filter(centroids, aoi, method = "centroid") -cat("Footprint method:", nrow(fp_result), "photos\n") -cat("Centroid method: ", nrow(ct_result), "photos\n") +knitr::kable(data.frame( + Method = c("footprint", "centroid"), + Photos = c(nrow(fp_result), nrow(ct_result)), + Description = c("Footprint overlaps AOI", "Centroid inside AOI") +), caption = "Comparison of spatial filtering methods.") ``` -## Summary statistics +# Summary statistics `fly_summary()` reports footprint dimensions and date ranges by scale. @@ -72,7 +76,7 @@ cat("Centroid method: ", nrow(ct_result), "photos\n") fly_summary(centroids) ``` -## Coverage analysis +# Coverage analysis `fly_coverage()` computes what percentage of the AOI is covered by photo footprints, grouped by any column. @@ -81,36 +85,67 @@ footprints, grouped by any column. fly_coverage(centroids, aoi, by = "scale") ``` -## Photo selection +# Photo selection `fly_select()` has two modes: - `mode = "minimal"` — fewest photos to reach target coverage - `mode = "all"` — every photo whose footprint touches the AOI -### Minimal selection +## Minimal selection ```{r select-minimal} selected <- fly_select(centroids, aoi, mode = "minimal", target_coverage = 0.80) selected[, c("airp_id", "scale", "selection_order", "cumulative_coverage_pct")] ``` -```{r plot-minimal} +Figure \@ref(fig:fig-minimal) shows the greedy minimal selection result. + +```{r fig-minimal, fig.cap = "Minimal greedy selection — fewest photos to reach 80% AOI coverage."} sel_fp <- fly_footprint(selected) -plot(st_geometry(aoi), col = "lightyellow", border = "grey40", - main = paste(nrow(selected), "photos (minimal selection)")) +plot(st_geometry(aoi), col = "lightyellow", border = "grey40") plot(st_geometry(sel_fp), border = "steelblue", col = adjustcolor("steelblue", 0.15), add = TRUE) plot(st_geometry(selected), pch = 20, col = "red", add = TRUE) ``` -### All photos touching AOI +## Ensuring component coverage {#ensure-components} + +When the AOI has multiple disconnected polygons (e.g. patchy floodplain +fragments), minimal selection optimizes total area and can leave entire +components uncovered. Use `ensure_components = TRUE` to guarantee at least +one photo per component before running greedy selection: + +```{r select-components} +# How many polygon components in our AOI? +n_components <- length(sf::st_cast(st_union(aoi), "POLYGON")) +cat("AOI has", n_components, "polygon components\n") + +selected_ec <- fly_select(centroids, aoi, mode = "minimal", + target_coverage = 0.80, ensure_components = TRUE) +cat("Without ensure_components:", nrow(selected), "photos\n") +cat("With ensure_components: ", nrow(selected_ec), "photos\n") +``` + +Compare Figure \@ref(fig:fig-minimal) with Figure \@ref(fig:fig-components) — +the component-ensured selection covers more of the disconnected floodplain +fragments at the cost of a few extra photos. + +```{r fig-components, fig.cap = "Component-ensured selection — every disconnected AOI polygon gets at least one photo before greedy backfill."} +sel_fp_ec <- fly_footprint(selected_ec) +plot(st_geometry(aoi), col = "lightyellow", border = "grey40") +plot(st_geometry(sel_fp_ec), border = "steelblue", + col = adjustcolor("steelblue", 0.15), add = TRUE) +plot(st_geometry(selected_ec), pch = 20, col = "red", add = TRUE) +``` + +## All photos touching AOI ```{r select-all} all_in_aoi <- fly_select(centroids, aoi, mode = "all") cat(nrow(all_in_aoi), "photos intersect the AOI\n") ``` -## Overlap analysis +# Overlap analysis `fly_overlap()` reports pairwise overlap between photo footprints. Run it on same-scale subsets to understand coverage quality. @@ -137,7 +172,7 @@ if (nrow(overlap_31k) > 0) { } ``` -## Multi-scale workflow: best resolution first +# Multi-scale workflow: best resolution first In practice you want the finest-scale photos first, then fill gaps with coarser scales. Sort scales finest-first by parsing the numeric denominator: @@ -189,10 +224,13 @@ cat("\nTotal:", nrow(selected_all), "photos\n") as.data.frame(table(selected_all$priority_scale)) ``` -```{r plot-multi-scale} +Figure \@ref(fig:fig-multi-scale) shows the result — finest-scale photos +(blue) provide the primary coverage, with coarser-scale photos (orange) +filling remaining gaps. + +```{r fig-multi-scale, fig.cap = "Multi-scale priority selection — finest-scale photos first (blue), coarser scales backfill gaps (orange)."} sel_fp <- fly_footprint(selected_all) -plot(st_geometry(aoi), col = "lightyellow", border = "grey40", - main = paste(nrow(selected_all), "photos (best resolution first)")) +plot(st_geometry(aoi), col = "lightyellow", border = "grey40") scale_labels <- sort(unique(selected_all$priority_scale)) palette <- c("steelblue", "darkorange", "forestgreen", "firebrick") cols <- palette[match(selected_all$priority_scale, scale_labels)]