Merge pull request #123 from r-spatialecology/main

v2.1.1
r-spatialecology · Oct 23, 2023 · 59f33e7 · 59f33e7
2 parents b3fedd0 + 670a942
commit 59f33e7
Show file tree

Hide file tree

Showing 34 changed files with 173 additions and 215 deletions.
diff --git a/.github/workflows/Deploy-pkgdown.yaml b/.github/workflows/Deploy-pkgdown.yaml
@@ -32,7 +32,7 @@ jobs:
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: any::pkgdown, any::ggplot2, any::future, any::future.apply,
-                          any::patchwork, any::rgbif, any::rgdal, any::rnaturalearth,
+                          any::patchwork, any::rgbif, any::rnaturalearth,
                           any::rnaturalearthdata, any::sf, local::.
           needs: website
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: shar
 Title: Species-Habitat Associations
-Version: 2.1
+Version: 2.1.1
 Authors@R: c(person("Maximilian H.K.", "Hesselbarth", email = "[email protected]",
              role = c("aut", "cre"), comment = c(ORCID = "0000-0003-1125-9918")),
              person("Marco", "Sciaini", email = "[email protected]",
@@ -47,3 +47,4 @@ RoxygenNote: 7.2.3
 VignetteBuilder: knitr
 Encoding: UTF-8
 LazyData: true
+Config/testthat/edition: 3
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,6 @@
+# shar 2.1.1
+* Bugfixes (thanks to @baddstats)
+
 # shar 2.1
 * Improvements
   * Remove `comp_fast` argument

diff --git a/R/fit_point_process.R b/R/fit_point_process.R
@@ -55,12 +55,8 @@ fit_point_process <- function(pattern,
 
     pattern <- spatstat.geom::unmark(pattern)
 
-    if (verbose) {
+    if (verbose) message("Unmarking provided input pattern.")
 
-      warning("Unmarked provided input pattern.",
-              call. = FALSE)
-
-    }
   }
 
   if (process == "poisson") {
@@ -158,7 +154,7 @@ fit_point_process <- function(pattern,
     if (simplify) {
 
       # not possible if more than one pattern is present
-      if (n_random > 1 && verbose) {
+      if (n_random > 1) {
 
         warning("'simplify = TRUE' not possible for 'n_random > 1'.",
                 call. = FALSE)
@@ -175,7 +171,7 @@ fit_point_process <- function(pattern,
   } else {
 
     # return warning if simply = TRUE because not possible if return_input = TRUE (only verbose = TRUE)
-    if (simplify && verbose) {
+    if (simplify) {
 
       warning("'simplify = TRUE' not possible for 'return_input = TRUE'.", call. = FALSE)
 

diff --git a/R/plot.rd_ras.R b/R/plot.rd_ras.R
@@ -51,14 +51,11 @@ plot.rd_ras <- function(x, n = NULL, col, verbose = TRUE, nrow, ncol, ...) {
   habitats <- sort(table(terra::values(x$observed), useNA = "no")) # get table of habitats
 
   # print warning if more than 10 classes are present
-  if (verbose) {
+  if (length(habitats) > 10) {
 
-    if (length(habitats) > 10) {
+    warning("The raster has more than 10 classes. Please make sure discrete classes are provided.",
+            call. = FALSE)
 
-      warning("The raster has more than 10 classes. Please make sure discrete classes are provided.",
-              call. = FALSE)
-
-    }
   }
 
   # get randomized pattern

diff --git a/R/print.rd_mar.R b/R/print.rd_mar.R
@@ -28,9 +28,7 @@
 #' @rdname print.rd_mar
 #'
 #' @export
-print.rd_mar <- function(x,
-                         digits = 4,
-                         ...) {
+print.rd_mar <- function(x, digits = 4, ...) {
 
   # set length observed pattern to 0 and
   # return warning that energy can't be calculated

diff --git a/R/randomize_raster.R b/R/randomize_raster.R
@@ -68,14 +68,10 @@ randomize_raster <- function(raster,
   habitats <- sort(table(terra::values(raster, mat = FALSE))) # get table of habitats
 
   # print warning if more than 10 classes are present
-  if (verbose) {
-
-    if (length(habitats) > 10) {
+  if (length(habitats) > 10) {
 
       warning("The raster has more than 10 classes. Please make sure discrete classes are provided.",
               call. = FALSE)
-
-    }
   }
 
   n_cells <- sum(habitats) # number of cells
@@ -206,7 +202,7 @@ randomize_raster <- function(raster,
     if (simplify) {
 
       # not possible if more than one raster is present
-      if (n_random > 1 && verbose) {
+      if (n_random > 1) {
 
         warning("'simplify = TRUE' not possible for 'n_random > 1'.",
                 call. = FALSE)
@@ -223,7 +219,7 @@ randomize_raster <- function(raster,
   } else {
 
     # return warning if simply = TRUE because not possible if return_input = TRUE (only verbose = TRUE)
-    if (simplify && verbose) {
+    if (simplify) {
 
       warning("'simplify = TRUE' not possible for 'return_input = TRUE'.", call. = FALSE)
 

diff --git a/R/reconstruct_algorithm.R b/R/reconstruct_algorithm.R
@@ -43,27 +43,27 @@ reconstruct_algorithm <- function(pattern,
 
   # check if n_random is >= 1
   if (n_random < 1) {
-
     stop("n_random must be >= 1.", call. = FALSE)
-
   }
 
   # unmark pattern
   if (spatstat.geom::is.marked(pattern)) {
 
     pattern <- spatstat.geom::unmark(pattern)
 
-    if (verbose) {
-      warning("Unmarked provided input pattern. For marked pattern, see reconstruct_pattern_marks().",
-              call. = FALSE)
+    if (verbose) message("Unmarking provided input pattern. For marked pattern, see reconstruct_pattern_marks().")
 
-    }
   }
 
   # grab window and number of points
   n_points <- pattern$n
   window <- pattern$window
 
+  # check if pattern is emtpy
+  if (n_points == 0){
+    stop("The observed pattern contains no points.", call. = FALSE)
+  }
+
   # calculate intensity
   lambda <- n_points / spatstat.geom::area(window)
   lambda2area <- (n_points * (n_points - 1)) / spatstat.geom::area(window)
@@ -169,6 +169,9 @@ reconstruct_algorithm <- function(pattern,
       }
     }
 
+    # check if simulated is empty
+    if (simulated$n == 0) stop("The simulated pattern contains no points.", call. = FALSE)
+
     # energy before reconstruction
     energy <- Inf
 

diff --git a/R/reconstruct_pattern.R b/R/reconstruct_pattern.R
@@ -122,7 +122,7 @@ reconstruct_pattern <- function(pattern, method = "homo",
     if (simplify) {
 
       # not possible if more than one pattern is present
-      if (n_random > 1 && verbose) {
+      if (n_random > 1) {
 
         warning("'simplify = TRUE' not possible for 'n_random > 1'.",
                 call. = FALSE)
@@ -139,7 +139,7 @@ reconstruct_pattern <- function(pattern, method = "homo",
   } else {
 
     # return warning if simply = TRUE because not possible if return_input = TRUE (only verbose = TRUE)
-    if (simplify && verbose) {
+    if (simplify) {
 
       warning("'simplify = TRUE' not possible for 'return_input = TRUE'.", call. = FALSE)
 

diff --git a/R/reconstruct_pattern_marks.R b/R/reconstruct_pattern_marks.R
@@ -80,23 +80,21 @@ reconstruct_pattern_marks <- function(pattern,
 
   # check if n_random is >= 1
   if (!n_random >= 1) {
-
     stop("n_random must be >= 1.", call. = FALSE)
-
   }
 
   # check if pattern is marked
   if (spatstat.geom::is.marked(pattern) || !spatstat.geom::is.marked(marked_pattern)) {
-
     stop("'pattern' must be unmarked and 'marked_pattern' marked", call. = FALSE)
-
   }
 
   # check if marks are numeric
   if (!inherits(x = marked_pattern$marks, what = "numeric")) {
-
     stop("marks must be 'numeric'", call. = FALSE)
+  }
 
+  if (pattern$n == 0 ||  marked_pattern$n == 0){
+    stop("At least one of the observed patterns contain no points.", call. = FALSE)
   }
 
   # calculate r from data
@@ -297,7 +295,7 @@ reconstruct_pattern_marks <- function(pattern,
     if (simplify) {
 
       # not possible if more than one pattern is present
-      if (n_random > 1 && verbose) {
+      if (n_random > 1) {
 
         warning("'simplify = TRUE' not possible for 'n_random > 1'.",
                 call. = FALSE)
@@ -316,7 +314,7 @@ reconstruct_pattern_marks <- function(pattern,
   } else {
 
     # return warning if simply = TRUE because not possible if return_input = TRUE (only verbose = TRUE)
-    if (simplify && verbose) {
+    if (simplify) {
 
       warning("'simplify = TRUE' not possible for 'return_input = TRUE'.", call. = FALSE)
 

diff --git a/R/results_habitat_association.R b/R/results_habitat_association.R
@@ -67,7 +67,7 @@ results_habitat_association <- function(pattern, raster, significance_level = 0.
 
   }
 
-  if (significance_level < 0.01 || significance_level > 0.1 && verbose) {
+  if (significance_level < 0.01 || significance_level > 0.1) {
 
     warning("Make sure 'signifcance_level' is meaningful (e.g. 'significance_level = 0.05').",
             call. = FALSE)
@@ -100,24 +100,14 @@ results_habitat_association <- function(pattern, raster, significance_level = 0.
     same_extent <- terra::ext(raster$observed) == terra::ext(pattern$window$xrange,
                                                              pattern$window$yrange)
 
-    # error if extent is not identical
-    if (!same_extent) {
-
-      warning("Extent of 'pattern' and 'raster' are not identical.", call. = FALSE)
-
-    }
-
     habitats <- table(terra::values(raster$observed, mat = FALSE), useNA = "no") # get table of habitats
 
     # print warning if more than 25 classes are present
-    if (verbose) {
+    if (length(habitats) > 25) {
 
-      if (length(habitats) > 25) {
+      warning("The raster has more than 25 classes. You can ignore this warning if your raster data is discrete.",
+              call. = FALSE)
 
-        warning("The raster has more than 25 classes. You can ignore this warning if your raster data is discrete.",
-                call. = FALSE)
-
-      }
     }
 
     # print quantiles
@@ -166,13 +156,6 @@ results_habitat_association <- function(pattern, raster, significance_level = 0.
     same_extent <- terra::ext(raster) == terra::ext(pattern$observed$window$xrange,
                                                     pattern$observed$window$yrange)
 
-    # error if extent is not identical
-    if (!same_extent) {
-
-      warning("Extent of 'pattern' and 'raster' are not identical.", call. = FALSE)
-
-    }
-
     # warning if NA are present
     if (anyNA(terra::values(raster, mat = FALSE))) {
 
@@ -183,14 +166,10 @@ results_habitat_association <- function(pattern, raster, significance_level = 0.
     habitats <- table(terra::values(raster, mat = FALSE), useNA = "no") # get table of habitats
 
     # print warning if more than 25 classes are present
-    if (verbose) {
-
-      if (length(habitats) > 25) {
-
-        warning("The raster has more than 25 classes. You can ignore this warning if your raster data is discrete.",
-                call. = FALSE)
+    if (length(habitats) > 25) {
 
-      }
+      warning("The raster has more than 25 classes. You can ignore this warning if your raster data is discrete.",
+              call. = FALSE)
     }
 
     # print quantiles
@@ -216,6 +195,13 @@ results_habitat_association <- function(pattern, raster, significance_level = 0.
     })
   }
 
+  # error if extent is not identical
+  if (!same_extent) {
+
+    warning("Extent of 'pattern' and 'raster' are not identical.", call. = FALSE)
+
+  }
+
   # repeat each name as often as number of habitats
   names_obj <- rep(x = names(habitats_count), each = length(habitats))
 

diff --git a/R/sample_randomized.R b/R/sample_randomized.R
@@ -52,14 +52,9 @@ sample_randomized <- function(randomized, n = NULL, verbose = TRUE) {
       # check if less than 3 randomized elements are present
       n <- ifelse(test = n_randomized < 4, yes = n_randomized, no = 3)
 
-      # print message
-      if (verbose) {
-
-        # return warning
-        warning("n larger than number of randomize eleements. Setting n = ", n, ".",
-                call. = FALSE)
-
-        }
+      # return warning
+      warning("n larger than number of randomize eleements. Setting n = ", n, ".",
+              call. = FALSE)
     }
 
     # sample elements
@@ -82,11 +77,8 @@ sample_randomized <- function(randomized, n = NULL, verbose = TRUE) {
       }
 
       # return warning that some ids were removed
-      if (verbose) {
+      warning("Using only IDs that are present in randomized data.", call. = FALSE)
 
-        warning("Using only IDs that are present in randomized data.", call. = FALSE)
-
-      }
     }
 
     # sample elements

diff --git a/R/translate_raster.R b/R/translate_raster.R
@@ -55,14 +55,11 @@ translate_raster <- function(raster, steps_x = NULL, steps_y = NULL,
   habitats <- sort(table(terra::values(raster, mat = FALSE))) # get table of habitats
 
   # print warning if more than 10 classes are present
-  if (verbose) {
-
-    if (length(habitats) > 10) {
+  if (length(habitats) > 10) {
 
-      warning("The raster has more than 10 classes. Please make sure discrete classes are provided.",
-              call. = FALSE)
+    warning("The raster has more than 10 classes. Please make sure discrete classes are provided.",
+            call. = FALSE)
 
-    }
   }
 
   # use all possible combinations
@@ -171,7 +168,7 @@ translate_raster <- function(raster, steps_x = NULL, steps_y = NULL,
     if (simplify) {
 
       # not possible if more than one raster is present
-      if (n_random > 1 && verbose) {
+      if (n_random > 1) {
 
         warning("'simplify = TRUE' not possible for 'n_random > 1'.",
                 call. = FALSE)
@@ -189,7 +186,7 @@ translate_raster <- function(raster, steps_x = NULL, steps_y = NULL,
   else {
 
     # return warning if simply = TRUE because not possible if return_input = TRUE (only verbose = TRUE)
-    if (simplify && verbose) {
+    if (simplify) {
 
       warning("'simplify = TRUE' not possible for 'return_input = TRUE'.", call. = FALSE)