Add make mask_from_presence

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tidysdm
 Title: Species Distribution Models with Tidymodels
-Version: 0.9.6.9001
+Version: 0.9.6.9002
 Authors@R: c(
     person("Michela", "Leonardi", role = "aut"),
     person("Margherita", "Colucci", role = "aut"),
@@ -22,7 +22,7 @@ URL: https://github.com/EvolEcolGroup/tidysdm,
     https://evolecolgroup.github.io/tidysdm/
 BugReports: https://github.com/EvolEcolGroup/tidysdm/issues
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Depends:
     tidymodels,
     spatialsample,

NAMESPACE

@@ -84,6 +84,7 @@ export(grid_offset)
 export(kap_max)
 export(kap_max_vec)
 export(km2m)
+export(make_mask_from_presence)
 export(maxent)
 export(maxnet_fit)
 export(maxnet_predict)

NEWS.md

@@ -1,3 +1,7 @@
+# `tidysdm` development version
+
+* implement `make_mask_from_presence` to define the area of interest
+
 # `tidysdm` 0.9.5
 
 * implement clamping and MESS to manage extrapolation
@@ -6,7 +10,7 @@
 
 # `tidysdm` 0.9.4
 
-* fix a but in the 'predict*' functions that prevented a fixed threshold to be used
+* fix a but in the `predict*` functions that prevented a fixed threshold to be used
   to assign classes
 * ensure compatibility with upcoming changes in `tune`
 

R/make_mask_from_presence.R

@@ -0,0 +1,62 @@
+#' Make a mask from presence data
+#' 
+#' This functions uses the presence column to create a mask to apply to the raster to
+#' define the area of interest. Two methods are available: one that uses a 
+#' buffer around each presence, and one that create a convex hull around all
+#' presences (with the possibility of further adding a buffer around the hull).
+#' 
+#' To use [terra::mask()] on a raster, use `return_sf = FALSE` to get a `terra::SpatVector` object
+#' that can be used for masking.
+#' 
+#' @param data An [`sf::sf`] data frame of presences..
+#' @param method the method to use to create the mask. Either 'buffer' or 'convex_hull'
+#' @param buffer the buffer to add around each presence (in the units of the crs of the data;
+#' for lat/lon, the buffer will be in meters),
+#' or around the convex hull (if method is 'convex_hull')
+#' @param return_sf whether to return the mask as an `sf` object (if TRUE) or as a `terra::SpatVector` object (if FALSE, default)
+#' @returns a `terra::SpatVector` or an `sf` object (depending on the value of `return_sf`) with the mask
+#' @export
+#' @examples
+#' lacerta_sf <- lacerta %>% sf::st_as_sf(coords = c("longitude", "latitude")) %>% sf::st_set_crs(4326)
+#' land_mask <- terra::readRDS(system.file("extdata/lacerta_land_mask.rds",
+#' package = "tidysdm"))
+#' mask_buffer <- make_mask_from_presence(lacerta_sf, method = "buffer", buffer = 60000)
+#' plot(terra::mask(land_mask, mask_buffer))
+#' mask_ch <- make_mask_from_presence(lacerta_sf, method = "convex_hull")
+#' plot(terra::mask(land_mask, mask_ch))
+
+make_mask_from_presence <- function(data, method = 'buffer', buffer = 0, return_sf = FALSE) {
+
+  # Check method
+  if (!method %in% c('buffer', 'convex_hull')) {
+    stop('method must be either "buffer" or "convex_hull"')
+  }
+
+  # Check buffer
+  if (!is.numeric(buffer) | length(buffer) != 1) {
+    stop('buffer must be a single numeric value')
+  }
+
+  # Check data
+  if (!inherits(data, 'sf')) {
+    stop('data must be an sf object')
+  }
+
+  # Create mask
+  if (method == 'buffer') {
+    if (buffer <=0) {
+      stop('buffer must be a positive value')
+    }
+    mask <- sf::st_buffer(sf::st_union(data), buffer)
+  } else {
+    mask <- sf::st_convex_hull(sf::st_union(data))
+    if (buffer>0){
+      mask <- sf::st_buffer(mask, buffer)
+    }
+  }
+  if (return_sf) {
+    return(mask)
+  } else {
+    return(terra::vect(mask))
+  }
+} 

_pkgdown.yml

@@ -15,6 +15,7 @@ reference:
       - thin_by_cell_time
       - thin_by_dist
       - thin_by_dist_time
+      - make_mask_from_presence
 
   - title: "Choice of predictor variables"
     desc: "Functions for removing collinearity and visualising the distribution of predictors."

inst/WORDLIST

@@ -39,6 +39,7 @@ Tidymodels
 Toxopeus
 Trang
 Turelli
+Vittorio
 WGS
 WorldClim
 YBP
@@ -74,7 +75,9 @@ kap
 kendall
 lacerta
 lacertidae
+lat
 lh
+lon
 lonlat
 lqpht
 lubridate

tests/testthat/test_make_mask_from_presence.R

@@ -0,0 +1,73 @@
+# set up a small world
+# small grid
+library(terra)
+grid_raster <- terra::rast(matrix(1:64, ncol = 8, byrow = TRUE),
+  extent = terra::ext(c(-2, 2, -2, 2)),
+  crs = "lonlat"
+)
+# crs="epsg:4326")
+grid_raster[c(1:5, 15, 16, 23, 24)] <- NA
+
+# locations (first isolated, two closer to each other)
+locations <- data.frame(
+  lon = c(0.8, 1.9, 0.7),
+  lat = c(1.3, -1.8, -0.9),
+  id = 1:3
+)
+
+# convert it to an sf object
+locations_sf <- sf::st_as_sf(locations, coords = c("lon", "lat")) %>% sf::st_set_crs(4326)
+
+#min_buffer <- terra::buffer(terra::vect(locations, crs = "lonlat"), 60000)
+#max_buffer <- terra::buffer(terra::vect(locations, crs = "lonlat"), 90000)
+
+
+# points in poygons function
+# (from https://stackoverflow.com/questions/72384038/point-in-polygon-using-terra-package-in-r)
+pts_in_polys <- function(pts, polys) {
+  e <- terra::extract(polys, pts)
+  e[!is.na(e[, 2]), 1]
+}
+
+test_that("make_mask_from_presence works correctly", {
+  set.seed(123)
+  # create a buffer
+  mask_buffer <- make_mask_from_presence(locations_sf,method = "buffer", buffer = 60000, return_sf = TRUE)
+  # expect points close to the presences to be included in the mask buffer
+  buffer_locations <- data.frame(
+    lon = c(0.5, 1, 2),
+    lat = c(-1, 1.6, -2),
+    id = 1:3
+  ) %>% sf::st_as_sf(coords = c("lon", "lat")) %>% sf::st_set_crs(4326)
+  expect_true(nrow(sf::st_filter(buffer_locations, mask_buffer))==3)
+  # create a minimum convex polygon
+  mask_ch <- make_mask_from_presence(locations_sf, method = "convex_hull", return_sf = TRUE)
+  # expect points close to the presences not to be included in the mask convex hull if they are off to the sides
+  expect_true(nrow(sf::st_filter(buffer_locations, mask_ch))==0)
+  ch_locations <- data.frame(
+    lon = c(1, 1.5, 1),
+    lat = c(-0.5, -1.3, -0),
+    id = 1:3
+  ) %>% sf::st_as_sf(coords = c("lon", "lat")) %>% sf::st_set_crs(4326)
+  expect_true(nrow(sf::st_filter(ch_locations, mask_ch))==3)
+  # only one of these locations is within the buffer
+  expect_true(nrow(sf::st_filter(ch_locations, mask_buffer))==1)
+  # create a convex hull with a buffer
+  mask_ch_buffer <- make_mask_from_presence(locations_sf, method = "convex_hull", buffer = 60000, return_sf = TRUE)
+  # all locations should be within this bigger ch
+  expect_true(nrow(sf::st_filter(ch_locations, mask_ch_buffer))==3)
+  expect_true(nrow(sf::st_filter(buffer_locations, mask_ch_buffer))==3)
+
+})
+
+# sample code to plot points in and buffers
+# plot(grid_raster,colNA="darkgray")
+# polys(terra::as.polygons(grid_raster))
+# points(vect(locations), col="red", cex=2)
+# points(vect(mask_locations), col="lightblue", cex=2)
+# points(vect(buffer_locations), col="green", cex=2)
+# polys (vect(mask_buffer))
+# polys(vect(mask_ch), col="blue", cex=2)
+# polys(vect(mask_ch_buffer), col="green", cex=2)
+# polys(min_buffer)
+# polys(max_buffer)