Merge pull request #253 from rmaia/replace-sp

Use sf rather than sp in polymask()

DESCRIPTION

@@ -49,7 +49,7 @@ Imports:
     farver,
     plot3D,
     progressr,
-    sp,
+    sf,
     viridisLite
 Suggests:
     alphashape3d,

NAMESPACE

@@ -122,7 +122,6 @@ importFrom(magick,image_rotate)
 importFrom(plot3D,perspbox)
 importFrom(progressr,progressor)
 importFrom(progressr,with_progress)
-importFrom(sp,point.in.polygon)
 importFrom(stats,aggregate)
 importFrom(stats,approx)
 importFrom(stats,cor)

R/adjacent.R

@@ -643,26 +643,31 @@ adjacent_main <- function(classimg_i, xpts_i = NULL, xscale_i = NULL, bkgID_i =
 
 
 # Internal function for masking color-classified image data that fall inside/outside a polygon
-#' @importFrom sp point.in.polygon
 polymask <- function(imagedat,
                      polygon,
                      alter_which = c("outside", "inside"),
                      replacement_value = NA) {
   imglong <- data.frame(expand.grid(seq_len(ncol(imagedat)), seq_len(nrow(imagedat))), z = c(imagedat))
   names(imglong) <- c("x", "y", "z")
 
-  inpoly <- point.in.polygon(imglong$x, imglong$y, polygon$x, polygon$y, mode.checked = FALSE) # todo: replace with base
+  pts <- do.call(
+    sf::st_sfc,
+    apply(imglong[, c("x", "y")], 1, sf::st_point, simplify = FALSE)
+  )
+  poly <- sf::st_polygon(list(as.matrix(polygon)))
+
+  # It's safe to extract just the first column since at the moment, we can only
+  # have a single polygon
+  inpoly <- sf::st_intersects(pts, poly, sparse = FALSE)[, 1]
 
   maskmat <- matrix(data = inpoly, ncol(imagedat), nrow(imagedat))
   maskmat <- apply(as.matrix(maskmat), 1, rev)
   maskmat <- rev(t(apply(as.matrix(maskmat), 1, rev))) # mirror (DOUBLECHECK)
   if (alter_which == "inside") {
-    imagedat[which(maskmat == 1)] <- replacement_value
-    imagedat[which(maskmat == 2)] <- replacement_value
-    imagedat[which(maskmat == 3)] <- replacement_value
+    imagedat[maskmat] <- replacement_value
   }
   if (alter_which == "outside") {
-    imagedat[which(maskmat == 0)] <- replacement_value
+    imagedat[!maskmat] <- replacement_value
   }
   imagedat
 }

tests/testthat/test-polymask.R

@@ -0,0 +1,28 @@
+set.seed(1234)
+imgfake <- as.rimg(matrix(
+  sample(c(0, 1), 100, replace = TRUE), nrow = 10, ncol = 10)
+)
+polyfake <- data.frame(
+  x = c(3, 5, 7, 7, 3),
+  y = c(3, 3, 5, 7, 3)
+)
+
+test_that("polymask() outside and inside reproduce original image", {
+
+  o <- polymask(
+    imgfake,
+    polyfake,
+    "outside",
+    replacement_value = 0
+  )
+
+  i <- polymask(
+    imgfake,
+    polyfake,
+    "inside",
+    replacement_value = 0
+  )
+
+  expect_identical(o + i, imgfake)
+
+})