CST-564 client support

.Rbuildignore

@@ -10,3 +10,4 @@
 ^pkgdown$
 ^tmp$
 ^notes\.md$
+^\.vscode$

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

@@ -16,14 +16,11 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          # - {os: macOS-latest, r: 'devel'}
-          # - {os: macOS-latest, r: 'release'}
-          # - {os: windows-latest, r: 'devel'}
-          # - {os: windows-latest, r: 'release'}
-          # - {os: windows-latest, r: 'oldrel'}
-          # - {os: ubuntu-22.04, r: 'devel'}
-          - {os: ubuntu-22.04, r: 'release'}
-          # - {os: ubuntu-22.04, r: 'oldrel'}
+          #- {os: macOS-latest, r: 'release'}
+          - {os: windows-latest, r: 'release'}
+          - {os: ubuntu-latest, r: 'devel'}
+          - {os: ubuntu-latest, r: 'release'}
+          - {os: ubuntu-latest, r: 'oldrel'}
 
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
@@ -41,13 +38,8 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::rcmdcheck, any::covr
+          extra-packages: any::rcmdcheck
           needs: check
 
       - uses: r-lib/actions/check-r-package@v2
 
-      # - name: Test coverage
-      #   if: matrix.config.os == 'ubuntu-22.04' && matrix.config.r == 'release'
-      #   run: |
-      #     covr::codecov(token = "${{secrets.CODECOV_TOKEN}}")
-      #   shell: Rscript {0}

.github/workflows/pkgdown.yaml

@@ -0,0 +1,49 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+  release:
+    types: [published]
+  workflow_dispatch:
+
+name: pkgdown.yaml
+
+permissions: read-all
+
+jobs:
+  pkgdown:
+    runs-on: ubuntu-latest
+    # Only restrict concurrency for non-PR jobs
+    concurrency:
+      group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    permissions:
+      contents: write
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::pkgdown, local::.
+          needs: website
+
+      - name: Build site
+        run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
+        shell: Rscript {0}
+
+      - name: Deploy to GitHub pages 🚀
+        if: github.event_name != 'pull_request'
+        uses: JamesIves/[email protected]
+        with:
+          clean: false
+          branch: gh-pages
+          folder: docs

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SAVM
 Title: Submerged aquatic vegetation model
-Version: 0.0.1
-Date: 2025-03-21
+Version: 0.0.1.9004
+Date: 2025-07-15
 Authors@R: c(
     person(given = "Kevin",
            family = "Cazelles",
@@ -12,11 +12,17 @@ Authors@R: c(
            family  = "Beauchesne",
            role    = c("aut"),
            email   = "[email protected]",
-           comment = c(ORCID = "0000-0002-3590-8161"))
+           comment = c(ORCID = "0000-0002-3590-8161")),
+    person(
+        given   = "Paul",
+        family  = "Bozneck",
+        role    = c("aut"),
+        email = "[email protected]"
     )
-Description: Here is the description made of sentences.
-URL: https://github.com/inSileco/SAVM
-BugReports: https://github.com/inSileco/SAVM/issues
+    )
+Description: Submerged aquatic vegetation model developed by the Fish Ecology Science Lab at DFO.
+URL: https://github.com/FishEcologyScience/SAVM
+BugReports: https://github.com/FishEcologyScience/SAVM/issues
 License: GPL-3
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -1,11 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(preview_grid,sav_data)
 export(compute_fetch)
+export(invert_polygon)
 export(plot_sav_density)
 export(plot_sav_distribution)
 export(plot_sav_tmap)
+export(preview_grid)
 export(read_sav)
 export(read_sav_aoi)
 export(read_sav_csv)
 export(read_sav_pts)
 export(sav_model)
+import(randomForest)

NEWS.md

@@ -0,0 +1,10 @@
+# SAVM (devel)
+
+* Model and plot functions have been adjusted to handle `sf` objects (see #11).
+* The element `mean_fetch` returned by `compute_fetch()` is now a `sf` object (see #9).
+* `preview_grid()` allows to preview grid (see #8).
+* Add more guidance on reading shapefiles in the vignette (see #6). 
+* `invert_polygon()` has been added to invert polygon (see #6).
+* `compute_fetch()` has a new argument `n_bearings` that provides the number of bearings, it replaces `n_quad_seg` (see #4 and #5). 
+* `compute_fetch()` only compute the mean fetch for all bearings, columns with 
+suffix `_all` where therefore removed (see #4).

R/compute_fetch.R

@@ -6,9 +6,9 @@
 #' Polygon defining land boundaries used to compute fetch distances.
 #' @param max_dist {`numeric`}\cr{}
 #' Maximum fetch distance in kilometers. Fetch beyond this distance is capped.
-#' @param n_quad_seg {`integer`}\cr{}
-#' Number of segments per quadrant for fetch calculation.
-#' Ignored if `wind_weights` is provided.
+#' @param n_bearings {`integer`}\cr{}
+#' Total number of bearings for fetch calculation (minimal number required is
+#' 4, default is 167). Ignored if `wind_weights` is provided.
 #' @param wind_weights {`data.frame`}\cr{}
 #' A data frame specifying directional weights for wind exposure.
 #' Must contain two columns: `direction` (numeric, in degrees) and `weight`
@@ -17,12 +17,13 @@
 #' Coordinate reference system (CRS) passed to [sf::st_crs()], used to
 #' transform `points` and `polygon`.
 #'
-#' @details Wind fetch is the unobstructed distance over which wind travels
+#' @details
+#' Wind fetch is the unobstructed distance over which wind travels
 #' across a body of water before reaching a specific point. It plays a crucial
 #' role in wave generation, as longer fetch distances allow wind to transfer
 #' more energy to the water surface, leading to larger waves.
 #'
-#' For all points in `points`, 4 × `n_quad_seg` radial transects are generated
+#' For all points in `points`, `n_bearings` radial transects are generated
 #' by default. If `wind_weights` is specified, the column `direction`, which
 #' contains angles in degrees, is used instead to generate the transects. The
 #' transects are then clipped with the polygon using [`sf::st_intersection()`],
@@ -32,17 +33,16 @@
 #' element in the returned list and it used to generate the second element:
 #' `mean_fetch` that included wind fetch averages.
 #'
-#' Ensure that max_dist is specified in meters. An error will be thrown if the
+#' Ensure that `max_dist` is specified in meters. An error will be thrown if the
 #' spatial projection of points and polygon is not in a meter-based coordinate
 #' system.
 #'
-#' @return A list of two elements:
-#'  * `mean_fetch`: data frame with 5 columns:
+#' @return
+#' A list of two elements:
+#'  * `mean_fetch`: a `sf` object with 3 features:
 #'      * `id_point`: point identifier
-#'      * `fetch`: mean wind fetch based on the four highest values
-#'      * `weighted_fetch`: mean weighted wind fetch based on the four highest values
-#'      * `fetch_all`: mean wind fetch based on all values
-#'      * `weighted_fetch_all`: mean wind weighted fetch based on all values
+#'      * `fetch_km`: mean wind fetch based on all bearings.
+#'      * `weighted_fetch_km`: mean weighted wind fetch based on all bearings.
 #'  * `transect_lines`: a `sf` object containing all radial transect with the
 #'    same columns as `points` and the following additional columns:
 #'      * `id_point`: point identifier
@@ -63,36 +63,43 @@
 #'
 #' @examples
 #' \donttest{
-#'
 #' le_bound <- system.file("example", "lake_erie.gpkg", package = "SAVM") |>
 #'     sf::st_read()
 #' le_pt <- system.file("example", "le_points.geojson", package = "SAVM") |>
 #'     sf::st_read(quiet = TRUE)
 #' res <- compute_fetch(le_pt, le_bound, crs = 32617)
-#' # use wind-weight 
+#' # use wind-weight
 #' res2 <- compute_fetch(
-#'      le_pt, le_bound, max_dist = 20, 
-#'      wind_weights = data.frame(
-#'               direction = seq(0, 360, by = 360 / 16)[-1],
-#'               weight = rep(c(0, 1), each = 8)
-#'      ),
-#'      crs = 32617)
+#'     le_pt, le_bound,
+#'     max_dist = 20,
+#'     wind_weights = data.frame(
+#'         direction = seq(0, 360, by = 360 / 16)[-1],
+#'         weight = rep(c(0, 1), each = 8)
+#'     ),
+#'     crs = 32617
+#' )
 #'
-#' # resultat
+#' # results
 #' res$mean_fetch
 #' res2$mean_fetch
 #'
 #' # visualizing fetch lines
 #' plot(le_bound |> sf::st_transform(crs = 32617) |> sf::st_geometry())
 #' plot(res$transect_lines |> sf::st_geometry(), add = TRUE, col = 2, lwd = 0.5)
 #' }
-compute_fetch <- function(points, polygon, max_dist = 15, n_quad_seg = 9, wind_weights = NULL, crs = NULL) {
+compute_fetch <- function(
+    points, polygon, max_dist = 15, n_bearings = 16, wind_weights = NULL, crs = NULL) {
     valid_points(points)
     points$id_point <- seq_len(nrow(points))
     valid_polygon(polygon)
-    sav_stop_if_not(max_dist > 0)
+    sav_stop_if_not(max_dist > 0, "`max_dist` must be strictly positive.")
     max_dist <- 1e3 * max_dist
-    sav_stop_if_not(n_quad_seg > 0)
+    sav_stop_if_not(n_bearings >= 4, "`n_bearings` should be equal or greater than 4.")
+    if (n_bearings > 64) {
+        sav_msg_warning(
+            "Large number of bearings detected, computation may take a long time."
+        )
+    }
 
     if (!is.null(crs)) {
         if (!is_proj_unit_meter(crs)) {
@@ -127,11 +134,11 @@ compute_fetch <- function(points, polygon, max_dist = 15, n_quad_seg = 9, wind_w
 
     if (is.null(wind_weights)) {
         d_direction <- data.frame(
-            direction = utils::head(seq(0, 360, by = 360 / (n_quad_seg * 4)), -1),
+            direction = utils::head(seq(0, 360, by = 360 / n_bearings), -1),
             weight = 1
         )
     } else {
-        sav_msg_info("Using `wind_weights`, ignoring `n_quad_seg`")
+        sav_msg_info("Using `wind_weights`, ignoring `n_bearings`")
         if (all(c("direction", "weight") %in% names(wind_weights))) {
             d_direction <- wind_weights[c("direction", "weight")]
             valid_direction(d_direction$direction)
@@ -146,7 +153,7 @@ compute_fetch <- function(points, polygon, max_dist = 15, n_quad_seg = 9, wind_w
     sav_msg_info("Cropping fetch lines")
     fetch_crop <- suppressWarnings(fetch_lines |> sf::st_intersection(polygon))
     geom_type <- sf::st_geometry_type(fetch_crop)
-    # sf::st_intersection() generates multilinestring with extra lines if there
+    # sf::st_intersection() generates MULTILINESTRING with extra lines if there
     # are intersections within the fetch lines
     transect_lines <- rbind(
         fetch_crop |>
@@ -156,28 +163,33 @@ compute_fetch <- function(points, polygon, max_dist = 15, n_quad_seg = 9, wind_w
             remove_detached_ends(points)
     ) |>
         dplyr::arrange(id_point, direction)
-
     transect_lines <- transect_lines |>
         dplyr::mutate(transect_length = sf::st_length(transect_lines)) |>
         dplyr::group_by(id_point) |>
-        dplyr::mutate(rank = rank(transect_length, ties.method = "min"))
+        # using -transect so that the longest are ranked 1
+        dplyr::mutate(rank = rank(-transect_length, ties.method = "min"))
 
     list(
-        mean_fetch = transect_lines |>
-            sf::st_drop_geometry() |>
-            dplyr::group_by(id_point) |>
-            # dplyr::mutate(rank = rank(transect_length)) |>
-            dplyr::summarise(
-                fetch_km = mean(transect_length[rank < 5]),
-                weighted_fetch_km = mean(transect_length[rank < 5] * weight[rank < 5]),
-                fetch_km_all = mean(transect_length),
-                weighted_fetch_km_all = mean(transect_length * weight)
+        mean_fetch = points |>
+            dplyr::left_join(
+                transect_lines |>
+                    sf::st_drop_geometry() |>
+                    dplyr::group_by(id_point) |>
+                    # dplyr::mutate(rank = rank(transect_length)) |>
+                    dplyr::summarise(
+                        fetch_km = mean(transect_length),
+                        weighted_fetch_km = mean(transect_length * weight)
+                    ) |>
+                    dplyr::mutate(
+                        dplyr::across(
+                            !c(id_point),
+                            ~ as.numeric(units::set_units(.x, "km"))
+                        )
+                    ),
+                by = "id_point"
             )  |>
-            dplyr::mutate(
-                dplyr::across(
-                    !id_point, 
-                    ~ as.numeric(units::set_units(.x, "km"))
-                )
+            dplyr::select(
+                c("id_point", "fetch_km", "weighted_fetch_km")
             ),
         transect_lines = transect_lines
     )

R/invert_polygon.R

@@ -0,0 +1,38 @@
+#' Invert a Polygon
+#' 
+#' @param polygon {`sf`}\cr{}
+#' Polygon defining land boundaries that needs to be inverted.
+#' @param ratio {`numeric [0-1]`}\cr{}
+#' Fraction convex, see [sf::st_concave_hull()]. This may need to be tweaked 
+#' depending on the form of the polygon to be inverted.
+#' 
+#' @details 
+#' Utility function that inverts a polygon by drawing a concave hull around 
+#' `polygon` (see [sf::st_concave_hull()]) and then computes the differences
+#' between the polygon and the concave hull (see [sf::st_concave_hull()]).
+#'
+#' @export 
+#' 
+#' @examples 
+#' \donttest{
+#' erie_land <- system.file(
+#'  "example", "lake_erie_land", "LkErie_Land_fromGLAF_Water_WGS_Feb2020.shx",
+#'   package = "SAVM", mustWork = TRUE
+#' ) |> sf::st_read()
+#'
+#' erie_land |>
+#'    sf::st_geometry() |>
+#'    plot(col = 1)
+#'
+#' erie_land |>
+#'    sf::st_geometry() |>
+#'    invert_polygon() |>
+#'    plot(col = 1)
+#' }
+
+invert_polygon <- function(polygon, ratio = 0.5) {
+    os2 <- sf::sf_use_s2()
+    on.exit(suppressMessages(sf::sf_use_s2(os2)))
+    suppressMessages(os2 <- sf::sf_use_s2(FALSE))
+    sf::st_difference(polygon |> sf::st_concave_hull(ratio = ratio), polygon)
+}