Merge branch 'main' into snapmeasure

.Rbuildignore

@@ -5,3 +5,7 @@
 ^\.Rproj\.user$
 ^LICENSE\.md$
 ^data-raw$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^scripts$

.github/workflows/R-CMD-check.yaml

@@ -6,7 +6,9 @@ on:
   pull_request:
     branches: [main, master]
 
-name: R-CMD-check
+name: R-CMD-check.yaml
+
+permissions: read-all
 
 jobs:
   R-CMD-check:
@@ -30,7 +32,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -48,3 +50,4 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

.github/workflows/pkgdown.yaml

@@ -9,7 +9,9 @@ on:
     types: [published]
   workflow_dispatch:
 
-name: pkgdown
+name: pkgdown.yaml
+
+permissions: read-all
 
 jobs:
   pkgdown:
@@ -22,7 +24,7 @@ jobs:
     permissions:
       contents: write
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -41,7 +43,7 @@ jobs:
 
       - name: Deploy to GitHub pages 🚀
         if: github.event_name != 'pull_request'
-        uses: JamesIves/github-pages-deploy-action@v4.4.1
+        uses: JamesIves/github-pages-deploy-action@v4.5.0
         with:
           clean: false
           branch: gh-pages

.github/workflows/test-coverage.yaml

@@ -6,7 +6,9 @@ on:
   pull_request:
     branches: [main, master]
 
-name: test-coverage
+name: test-coverage.yaml
+
+permissions: read-all
 
 jobs:
   test-coverage:
@@ -16,36 +18,45 @@ jobs:
       GOOGLE_MAPS_ELEVATION_API_KEY: ${{ secrets.GOOGLE_MAPS_ELEVATION_API_KEY }}
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::covr
+          extra-packages: any::covr, any::xml2
           needs: coverage
 
       - name: Test coverage
         run: |
-          covr::codecov(
+          cov <- covr::package_coverage(
             quiet = FALSE,
             clean = FALSE,
             install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
           )
+          covr::to_cobertura(cov)
         shell: Rscript {0}
 
+      - uses: codecov/codecov-action@v4
+        with:
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
+          file: ./cobertura.xml
+          plugin: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
       - name: Show testthat output
         if: always()
         run: |
           ## --------------------------------------------------------------------
-          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
         shell: bash
 
       - name: Upload test results
         if: failure()
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: coverage-test-failures
           path: ${{ runner.temp }}/package

.gitignore

@@ -12,3 +12,4 @@
 
 docs/
 inst/docs/
+docs

DESCRIPTION

@@ -10,6 +10,7 @@ Authors@R: c(
   )
 Description: What the package does (one paragraph).
 License: MIT + file LICENSE
+URL: https://poissonconsulting.github.io/fwatlasbc/
 Depends: 
     R (>= 4.1)
 Imports: 
@@ -25,8 +26,8 @@ Imports:
     stats,
     stringr,
     tibble,
-    tidyselect,
-    tidyplus
+    tidyplus,
+    tidyselect
 Suggests: 
     covr,
     googleway,
@@ -43,4 +44,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

NAMESPACE

@@ -19,6 +19,7 @@ export(fwa_convert_stream_network_to_rms)
 export(fwa_convert_streams_to_rms)
 export(fwa_find_stream_names)
 export(fwa_get_section_from_rms)
+export(fwa_get_segment_from_rms)
 export(fwa_join_stream_segments)
 export(fwa_mapview)
 export(fwa_mapview_rms)

R/add-blk-to-lon-lat.R

@@ -1,16 +1,22 @@
 add_blk_to_lon_lat <- function(x, limit, tolerance, epsg, nocache) {
   check_dim(x, dim = nrow, values = 1L) # +chk
 
-  rm <- fwapgr::fwa_index_point(x = x$lon, y = x$lat,
-                                limit = limit, tolerance = tolerance,
-                                epsg = epsg, nocache = nocache)
-  if(!nrow(rm)) {
+  rm <- fwapgr::fwa_index_point(
+    x = x$lon, y = x$lat,
+    limit = limit, tolerance = tolerance,
+    epsg = epsg, nocache = nocache
+  )
+  if (!nrow(rm)) {
     rm <- rm |>
-      dplyr::mutate(blk = integer(0),
-                    rm = numeric(0),
-                    distance_to_lon_lat = numeric(0)) |>
-      dplyr::select("blk", "rm", "distance_to_lon_lat",
-                    "geometry")
+      dplyr::mutate(
+        blk = integer(0),
+        rm = numeric(0),
+        distance_to_lon_lat = numeric(0)
+      ) |>
+      dplyr::select(
+        "blk", "rm", "distance_to_lon_lat",
+        "geometry"
+      )
 
     x <- x |>
       dplyr::bind_cols(rm) |>
@@ -20,10 +26,12 @@ add_blk_to_lon_lat <- function(x, limit, tolerance, epsg, nocache) {
   }
 
   rm <- rm |>
-    dplyr::select(blk = "blue_line_key",
-                  rm = "downstream_route_measure",
-                  distance_to_lon_lat = "distance_to_stream",
-                  "geometry")
+    dplyr::select(
+      blk = "blue_line_key",
+      rm = "downstream_route_measure",
+      distance_to_lon_lat = "distance_to_stream",
+      "geometry"
+    )
 
   x |>
     dplyr::bind_cols(rm) |>
@@ -51,8 +59,8 @@ add_blk_to_lon_lat <- function(x, limit, tolerance, epsg, nocache) {
 #' fwa_add_blk_to_lon_lat(data.frame(lon = -132.26, lat = 53.36))
 #' }
 fwa_add_blk_to_lon_lat <- function(x, tolerance = 5000, limit = 1,
-                                  epsg = getOption("fwa.epsg", 3005), nocache = getOption("fwa.nocache", FALSE)) {
-  check_data(x, values = list(lon = c(-180,180,NA), lat = c(-90,90,NA)))
+                                   epsg = getOption("fwa.epsg", 3005), nocache = getOption("fwa.nocache", FALSE)) {
+  check_data(x, values = list(lon = c(-180, 180, NA), lat = c(-90, 90, NA)))
   check_dim(x, dim = nrow, values = TRUE)
   chk_not_subset(colnames(x), c("blk", "rm", "distance_to_lon_lat", "geometry"))
   chk_not_subset(colnames(x), "..fwa_id")
@@ -61,7 +69,7 @@ fwa_add_blk_to_lon_lat <- function(x, tolerance = 5000, limit = 1,
 
   x |>
     dplyr::as_tibble() |>
-    dplyr::mutate(..fwa_id = 1:dplyr::n()) |>
+    dplyr::mutate(..fwa_id = seq_len(dplyr::n())) |>
     group_split_sf(.data$..fwa_id) |>
     lapply(add_blk_to_lon_lat, tolerance = tolerance, limit = limit, epsg = epsg, nocache = nocache) |>
     dplyr::bind_rows() |>

R/add-blks-to-stream-name.R

@@ -24,7 +24,7 @@ fwa_add_blks_to_stream_name <- function(x, stream_name = fwatlasbc::fwa_stream_n
     dplyr::select("blk", "stream_name") |>
     dplyr::distinct()
 
-  if(!"sf" %in% class(x) && !"tbl" %in% class(x)) {
+  if (!"sf" %in% class(x) && !"tbl" %in% class(x)) {
     x <- x |> as_tibble()
   }
 

R/add-collection-to-polygon.R

@@ -2,7 +2,7 @@ rename_collection <- function(collection) {
   chk_string(collection) # +chk
 
   wch <- which(fwatlasbc::fwa_collection_name$collection_name == collection)
-  if(!length(wch)) return(collection)
+  if (!length(wch)) return(collection)
   fwatlasbc::fwa_collection_name$collection[wch]
 }
 
@@ -15,20 +15,21 @@ add_collection_to_polygon <- function(x, collection, filter, limit, offset,
   bbox <- bbox(polygon)
 
   coll <- fwapgr::fwa_query_collection(collection,
-                                       filter = filter,
-                                       limit = limit,
-                                       offset = offset,
-                                       bbox = bbox,
-                                       properties = properties,
-                                       transform = transform,
-                                       epsg = epsg,
-                                       nocache = nocache)
+    filter = filter,
+    limit = limit,
+    offset = offset,
+    bbox = bbox,
+    properties = properties,
+    transform = transform,
+    epsg = epsg,
+    nocache = nocache
+  )
 
   polygon <- sf::st_transform(polygon, epsg)
   polygon <- sf::st_make_valid(polygon)
-  suppressMessages(coll <- coll[sf::st_intersects(coll, polygon, sparse = FALSE)[,1],])
+  suppressMessages(coll <- coll[sf::st_intersects(coll, polygon, sparse = FALSE)[, 1], ])
   coll <- sf::st_make_valid(coll)
-  if(x$..fwa_intersect) {
+  if (x$..fwa_intersect) {
     suppressWarnings(coll <- sf::st_intersection(coll, polygon, validate = TRUE))
     coll <- sf::st_make_valid(coll)
   }
@@ -58,7 +59,7 @@ add_collection_to_polygon <- function(x, collection, filter, limit, offset,
 #' individual features with the polygon as opposed to just including
 #' the features that intersect it.
 #' @return An sf object
-#' @seealso \code{\link[fwapgr]{fwa_collection}}.
+#' @seealso [fwapgr::fwa_collection()].
 #' @export
 #' @examples
 #' \dontrun{
@@ -87,16 +88,20 @@ fwa_add_collection_to_polygon <- function(
   collection <- rename_collection(collection)
 
   x <- x |>
-    dplyr::mutate(..fwa_id = 1:dplyr::n(),
-                  ..fwa_intersect = intersect) |>
+    dplyr::mutate(
+      ..fwa_id = seq_len(dplyr::n()),
+      ..fwa_intersect = intersect
+    ) |>
     group_split_sf(.data$..fwa_id) |>
-    lapply(add_collection_to_polygon, collection = collection,
-           filter = filter, limit = limit,
-           offset = offset, properties = properties, transform = transform,
-           epsg = epsg, nocache = nocache) |>
+    lapply(add_collection_to_polygon,
+      collection = collection,
+      filter = filter, limit = limit,
+      offset = offset, properties = properties, transform = transform,
+      epsg = epsg, nocache = nocache
+    ) |>
     dplyr::bind_rows()
 
-  if("blue_line_key" %in% colnames(x)) {
+  if ("blue_line_key" %in% colnames(x)) {
     x <- x |> mutate(blk = .data$blue_line_key)
   }
 

R/add-collection-to-watershed.R

@@ -14,13 +14,16 @@ fwa_add_collection_to_watershed <- function(
     transform = NULL,
     epsg = getOption("fwa.epsg", 3005),
     nocache = getOption("fwa.nocache", FALSE)) {
+  lifecycle::deprecate_soft(
+    "0.0.2", "fwa_add_collection_to_watershed()",
+    "fwa_add_collection_to_polygon()"
+  )
 
-  lifecycle::deprecate_soft("0.0.2", "fwa_add_collection_to_watershed()",
-                            "fwa_add_collection_to_polygon()")
-
-  fwa_add_collection_to_polygon(x = x, collection = collection,
-                                intersect = intersect, filter = filter,
-                                limit = limit, offset = offset,
-                                properties = properties,
-                                transform = transform, epsg = epsg, nocache = nocache)
+  fwa_add_collection_to_polygon(
+    x = x, collection = collection,
+    intersect = intersect, filter = filter,
+    limit = limit, offset = offset,
+    properties = properties,
+    transform = transform, epsg = epsg, nocache = nocache
+  )
 }

R/add-cut-to-rms.R

@@ -39,7 +39,7 @@ fwa_add_cut_to_rms <- function(x, y, cut = "cut") {
   x <- x |>
     dplyr::as_tibble()
 
-  if(!nrow(x)) {
+  if (!nrow(x)) {
     x[[cut]] <- y[[cut]][0]
     return(x)
   }
@@ -49,16 +49,16 @@ fwa_add_cut_to_rms <- function(x, y, cut = "cut") {
     dplyr::filter(.data$blk %in% x$blk)
 
   x[[cut]] <- y[[cut]][0][1] # gets missing value
-  if(!nrow(y)) {
+  if (!nrow(y)) {
     return(x)
   }
 
-  for(i in seq_len(nrow(y))) {
+  for (i in seq_len(nrow(y))) {
     min_rm <- min(y$rm_start[i], y$rm_end[i])
     max_rm <- max(y$rm_start[i], y$rm_end[i])
-    x[[cut]][x$blk == y$blk[i] & x$rm >= min_rm & x$rm <= max_rm] <-  y[[cut]][i]
+    x[[cut]][x$blk == y$blk[i] & x$rm >= min_rm & x$rm <= max_rm] <- y[[cut]][i]
   }
-  if(!identical(sf_column_name, character(0))) {
+  if (!identical(sf_column_name, character(0))) {
     x <- x |>
       sf::st_sf(sf_column_name = sf_column_name)
   }

R/add-downstream-split-to-rms.R

@@ -1,6 +1,6 @@
 downstream_split_blk <- function(x, blk, rm) {
   x$..fwa_split[x$blk == blk & x$rm <= rm] <- TRUE
-  if(is.na(x$parent_blk[x$blk == blk][1])) return(x)
+  if (is.na(x$parent_blk[x$blk == blk][1])) return(x)
   downstream_split_blk(x, x$parent_blk[x$blk == blk][1], x$parent_rm[x$blk == blk][1])
 }
 
@@ -65,13 +65,13 @@ fwa_add_downstream_split_to_rms <- function(x, y) {
   chk_unique(y$name)
   chk_valid_name(y$name)
 
-  if(!nrow(y)) return(x)
+  if (!nrow(y)) return(x)
 
   splits <- lapply(y$name, get_downstream_split_to_rms, x = x, y = y)
   names(splits) <- y$name
   splits <- dplyr::as_tibble(splits)
 
-  if(!"tbl" %in% class(x)) {
+  if (!"tbl" %in% class(x)) {
     x <- dplyr::as_tibble(x)
   }