Merge pull request #103 from r-spatialecology/main

Update CRAN v1.3.2

Author: mhesselbarth

.github/workflows/Deploy-pkgdown.yaml

@@ -23,9 +23,15 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v1
         with:
-          extra-packages: pkgdown, future, future.apply
+          extra-packages: pkgdown, future, future.apply, rgbif, rgdal, rnaturalearth, rnaturalearthdata, sf, terra, patchwork
           needs: website
 
+      - name: Install dependencies
+        run: |
+          install.packages(c("remotes"))
+          remotes::install_github(repo = "ropensci/getCRUCLdata")
+        shell: Rscript {0}
+
       - name: Deploy package
         run: |
           git config --local user.name "$GITHUB_ACTOR"

.gitignore

@@ -6,4 +6,4 @@
 inst/doc
 Rplots.pdf
 docs
-^CRAN-SUBMISSION$
+^CRAN-SUBMISSION

DESCRIPTION

@@ -1,11 +1,16 @@
 Type: Package
 Package: shar
 Title: Species-Habitat Associations
-Version: 1.3.1
+Version: 1.3.2
 Authors@R: c(person("Maximillian H.K.", "Hesselbarth", email = "[email protected]",
              role = c("aut", "cre"), comment = c(ORCID = "0000-0003-1125-9918")),
              person("Marco", "Sciaini", email = "[email protected]",
-             role = "aut", comment = c(ORCID = '0000-0002-3042-5435')))
+             role = "aut", comment = c(ORCID = "0000-0002-3042-5435")), 
+             person("Zeke", "Marshall", email = "[email protected]",
+             role = "ctb", comment = c(ORCID = "0000-0001-9260-7827")), 
+             person("Thomas", "Etherington", email = "[email protected]",
+             role = "ctb", comment = c(ORCID = "0000-0002-3187-075X"))
+             )
 Maintainer: Maximillian H.K. Hesselbarth <[email protected]>
 Description:
   Analyse species-habitat associations in R. Therefore, information about the location 
@@ -25,6 +30,7 @@ Imports:
     raster,
     spatstat.core,
     spatstat.geom,
+    spatstat.random,
     stats,
     utils
 RoxygenNote: 7.1.2
@@ -35,6 +41,7 @@ Suggests:
     future.apply,
     knitr, 
     rmarkdown,
+    spatstat (>= 2.0.0),
     testthat (>= 2.1.0)
 VignetteBuilder: knitr
 Encoding: UTF-8

NEWS.md

@@ -1,3 +1,10 @@
+# shar 1.3.2
+* Improvements
+  * Improvement of `classify_habitats()` to be more variable
+  * Adding breaks argument to `results_habitat_association()`
+  * Adding `classint_to_vector()` helper function
+  * Include new `spatstat` package structure
+
 # shar 1.3.1
 * Improvements
   * Bugfix in `plot.rd_pat()` and `plot.rd_mar()`

R/classify_habitats.R

@@ -3,23 +3,29 @@
 #' @description Classify habitats
 #'
 #' @param raster RasterLayer with continuous environmental values.
-#' @param classes Integer with number of classes.
-#' @param style Character with method of classification. See Details section for
-#' more information.
+#' @param return_breaks Logical if breaks should be returned as well.
+#' @param ... Arguments passed on to \code{classIntervals}.
 #'
 #' @details
 #' Classifies a RasterLayer from the \code{raster} packages with continuous
-#' values into n discrete classes. Consequently, classes are non-overlapping (and left-closed).
-#' For more information about the classification method, see \code{\link{classIntervals}} from
-#' the \code{classInt} package and/or the provided References.
+#' values into n discrete classes. The \code{cut} function used to classify the raster,
+#' uses \code{include.lowest = TRUE}.
+#'
+#' For more information about the classification methods, see \code{classIntervals} from
+#' the \code{classInt} package and/or the provided References. The help page of \code{classIntervals}
+#' also includes further possible arguments to find  breaks (e.g., different styles, number
+#' of classes, fixed breaks, etc.).
 #'
 #' @seealso
 #' \code{\link{classIntervals}}
 #'
 #' @return RasterLayer
 #'
 #' @examples
-#' landscape_classified <- classify_habitats(landscape, classes = 5)
+#' landscape_classified <- classify_habitats(landscape, n = 5, style = "fisher")
+#'
+#' landscape_classified <- classify_habitats(landscape, style = "fixed",
+#' fixedBreaks = c(0, 0.25, 0.75, 1.0), return_breaks = TRUE)
 #'
 #' @aliases classify_habitats
 #' @rdname classify_habitats
@@ -39,19 +45,35 @@
 #' reduction. Annals of the Association of American Geographers 61, 217–244.
 #' <https://doi.org/10.1111/j.1467-8306.1971.tb00779.x>
 #'
+#' Jiang, B., 2013. Head/tail breaks: A new classification scheme for data with a
+#' heavy-tailed distribution. The Professional Geographer 65, 482-494.
+#' <https://doi.org/10.1080/00330124.2012.700499>
+#'
 #' Slocum, T.A., McMaster, R.B., Kessler, F.C., Howard, H.H., 2009. Thematic cartography
 #' and geovisualization, 3rd ed. ed, Prentice Hall Series in Geographic Information Science.
 #' Pearson Prentice Hall, Upper Saddle River, USA. ISBN 978-0-13-229834-6
 #'
+#' Wand, M. P., 1995. Data-based choice of histogram binwidth. The American
+#' Statistician 51, 59-64. <https://doi.org/10.1080/00031305.1997.10473591>
+#'
 #' @export
-classify_habitats <- function(raster, classes = 5, style = "fisher"){
+classify_habitats <- function(raster, return_breaks = FALSE, ...){
 
   raster_values <- raster::values(raster) # get all values
 
-  breaks <- classInt::classIntervals(var = raster_values,
-                                     n = classes, style = style) # get class intervals
+  breaks <- classInt::classIntervals(var = raster_values, ...) # use classInt to find breaks
 
   result <- raster::cut(raster, breaks = breaks$brks, include.lowest = TRUE) # classify raster
 
-  return(result)
+  # return RasterLayer and breaks
+  if (return_breaks) {
+
+    return(list(raster = result, breaks = breaks))
+
+  # return only RasterLayer
+  } else {
+
+    return(result)
+
+  }
 }

R/classint_to_vector.R

@@ -0,0 +1,51 @@
+#' classint_to_vector
+#'
+#' @description Convert classIntervals to vector
+#'
+#' @param x classIntervals object
+#' @param digits Integer with digits used for rounding.
+#'
+#' @details
+#' Returns a character vector with breaks of a \code{classIntervals} object. If
+#' \code{digits = NULL}, results will not be rounded
+#'
+#' @return vector
+#'
+#' @examples
+#' \dontrun{
+#' classint_to_vector(x = landscape_classified$breaks, digits = 4)
+#' }
+#'
+#' @aliases classint_to_vector
+#' @rdname classint_to_vector
+#'
+#' @keywords internal
+classint_to_vector <- function(x, digits = NULL) {
+
+  # get interval closures
+  if (methods::slot(x, "intervalClosure") == "left") {
+
+    brackets <- c("[", ")")
+
+  } else {
+
+    brackets <- c("(", "]")
+
+  }
+
+  # round if digits is present
+  if (!is.null(digits)) {
+
+    x$brks <- round(x = x$brks, digits = digits)
+
+  }
+
+  # create vector of breaks
+  breaks <- paste(x$brks[1:length(x$brks) - 1], x$brks[2:length(x$brks)], sep = ",")
+
+  # add intervall closures
+  breaks <- paste0(brackets[1], breaks, brackets[2])
+
+  return(breaks)
+
+}

R/extract_points.R

@@ -15,7 +15,7 @@
 #'
 #' @examples
 #' \dontrun{
-#' landscape_classified <- classify_habitats(landscape, classes = 5)
+#' landscape_classified <- classify_habitats(landscape, n = 5, style = "fisher")
 #' extract_points(raster = landscape_classified, pattern = species_b)
 #' }
 #'
@@ -30,7 +30,7 @@ extract_points <- function(raster, pattern){
   pattern <- spatstat.geom::coords(pattern) # extract only coords of points
 
   # get habitat points are located within
-  pattern_extracted <- factor(raster::extract(x = raster,  y = pattern, factor = TRUE),
+  pattern_extracted <- factor(raster::extract(x = raster, y = pattern, factor = TRUE),
                               levels = habitat_levels)
 
   result <- utils::stack(table(pattern_extracted)) # count number of points within each habitat

R/fit_point_process.R

@@ -67,7 +67,7 @@ fit_point_process <- function(pattern,
 
     result <- lapply(seq_len(n_random), function(x) {
 
-      simulated <- spatstat.core::runifpoint(n = pattern$n, win = pattern$window) # simulate poisson process
+      simulated <- spatstat.random::runifpoint(n = pattern$n, win = pattern$window) # simulate poisson process
 
       if (verbose) {
 
@@ -113,7 +113,7 @@ fit_point_process <- function(pattern,
         difference <- pattern$n - simulated$n
 
         # create missing points
-        missing_points <- spatstat.core::runifpoint(n = difference, win = pattern$window,
+        missing_points <- spatstat.random::runifpoint(n = difference, win = pattern$window,
                                                     nsim = 1, drop = TRUE)
 
         # add missing points to simulated

R/plot.rd_ras.R

@@ -23,7 +23,7 @@
 #'
 #' @examples
 #' \dontrun{
-#' landscape_classified <- classify_habitats(landscape, classes = 5)
+#' landscape_classified <- classify_habitats(landscape, n = 5, style = "fisher")
 #' landscape_random <- randomize_raster(landscape_classified, n_random = 19)
 #' plot(landscape_random)
 #' }

R/print.rd_ras.R

@@ -17,7 +17,7 @@
 #'
 #' @examples
 #' \dontrun{
-#' landscape_classified <- classify_habitats(landscape, classes = 5)
+#' landscape_classified <- classify_habitats(landscape, n = 5, style = "fisher")
 #' landscape_random <- randomize_raster(landscape_classified, n_random = 19)
 #'
 #' print(landscape_random)

R/randomize_raster.R

@@ -28,7 +28,7 @@
 #'
 #' @examples
 #' \dontrun{
-#' landscape_classified <- classify_habitats(landscape, classes = 5)
+#' landscape_classified <- classify_habitats(landscape, n = 5, style = "fisher")
 #' landscape_random <- randomize_raster(landscape_classified, n_random = 19)
 #' }
 #'

R/reconstruct_pattern_cluster.R

@@ -155,7 +155,7 @@ reconstruct_pattern_cluster <- function(pattern,
     # difference between patterns
     difference <- pattern$n - simulated$n
     # create missing points
-    missing_points <- spatstat.core::runifpoint(n = difference, nsim = 1, drop = TRUE,
+    missing_points <- spatstat.random::runifpoint(n = difference, nsim = 1, drop = TRUE,
                                                 win = pattern$window,
                                                 warn = FALSE)
     # add missing points to simulated
@@ -216,7 +216,7 @@ reconstruct_pattern_cluster <- function(pattern,
     rp_id <- sample(x = seq_len(simulated_current$n), size = max_runs, replace = TRUE)
 
     # create random new points
-    rp_coords <- spatstat.core::runifpoint(n = max_runs, nsim = 1, drop = TRUE,
+    rp_coords <- spatstat.random::runifpoint(n = max_runs, nsim = 1, drop = TRUE,
                                            win = simulated_current$window, warn = FALSE)
 
     # create random number for annealing prob

R/reconstruct_pattern_hetero.R

@@ -27,7 +27,7 @@
 #'
 #' @examples
 #' \dontrun{
-#' input_pattern <- spatstat.core::rpoispp(lambda = function(x, y) {100 * exp(-3 * x)},
+#' input_pattern <- spatstat.random::rpoispp(lambda = function(x, y) {100 * exp(-3 * x)},
 #' nsim = 1)
 #' pattern_recon <- reconstruct_pattern_hetero(input_pattern, n_random = 19, max_runs = 1000)
 #' }
@@ -131,7 +131,7 @@ reconstruct_pattern_hetero <- function(pattern,
   lambda <- spatstat.core::density.ppp(pattern)
 
   # create starting pattern
-  simulated <- spatstat.core::rpoint(n = pattern$n, f = lambda, win = pattern$window)
+  simulated <- spatstat.random::rpoint(n = pattern$n, f = lambda, win = pattern$window)
 
 
   # fast computation of summary functions
@@ -186,7 +186,7 @@ reconstruct_pattern_hetero <- function(pattern,
     rp_id <- sample(x = seq_len(simulated_current$n), size = max_runs, replace = TRUE)
 
     # create random new points
-    rp_coords <- spatstat.core::rpoint(n = max_runs, f = lambda, win = pattern$window)
+    rp_coords <- spatstat.random::rpoint(n = max_runs, f = lambda, win = pattern$window)
 
     # create random number for annealing prob
     if (annealing != 0) {

R/reconstruct_pattern_homo.R

@@ -153,7 +153,7 @@ reconstruct_pattern_homo <- function(pattern,
            length.out = r_length)
 
   # create Poisson simulation data
-  simulated <- spatstat.core::runifpoint(n = n_points, nsim = 1, drop = TRUE,
+  simulated <- spatstat.random::runifpoint(n = n_points, nsim = 1, drop = TRUE,
                                          win = window, warn = FALSE)
 
   # fast computation of summary functions
@@ -208,7 +208,7 @@ reconstruct_pattern_homo <- function(pattern,
     rp_id <- sample(x = seq_len(simulated_current$n), size = max_runs, replace = TRUE)
 
     # create random new points
-    rp_coords <- spatstat.core::runifpoint(n = max_runs, nsim = 1, drop = TRUE,
+    rp_coords <- spatstat.random::runifpoint(n = max_runs, nsim = 1, drop = TRUE,
                                            win = simulated_current$window,
                                            warn = FALSE)