Merge pull request #27 from r-spatialecology/master

Update 0.2

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: shar
 Title: Species-Habitat Associations
-Version: 0.1
+Version: 0.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]",
@@ -19,12 +19,15 @@ BugReports: https://github.com/r-spatialecology/shar/issues
 Depends: R (>= 3.1)
 Imports:
   classInt,
-  dplyr,
+  graphics,
   raster,
-  spatstat
+  spatstat, 
+  stats,
+  utils
 RoxygenNote: 6.1.1
 Suggests:
     covr,
+    dplyr,
     testthat,
     knitr,
     rmarkdown

NEWS.md

@@ -1,2 +1,14 @@
+# shar 0.2
+* Improvements
+  * Replaced `cat()` with `message()` for all printing to console
+  * All defaults set  to `n_random = 1`
+  * `comp_fast` argument equals TRUE if number of points exceed threshold
+  * `reconstruct_pattern()` stops if energy did not decrease for n iterations
+  * `reconstruct_marks()` stops if energy did not decrease for n iterations
+  * `plot_randomized_pattern()` can also plot point patterns
+* Bugfixes
+  * Bug in `fit_point_process()` that more points as present could be removed from simulated pattern
+  * Bug in `reconstruct_pattern()` that more points as present could be removed from simulated pattern
+
 # shar 0.1
 * First submission to CRAN

R/calculate_energy.R

@@ -4,7 +4,8 @@
 #'
 #' @param pattern List with reconstructed patterns.
 #' @param return_mean Return the mean energy
-#' @param comp_fast Should summary functions be estimated in an computational fast way.
+#' @param comp_fast If pattern contains more points than threshold, summary functions are estimated in a computational fast way.
+#' @param verbose Print progress report.
 #'
 #' @details
 #' The function calculates the mean energy (or deviation) between the observed
@@ -37,14 +38,23 @@
 #' in ecology. Boca Raton: Chapman and Hall/CRC Press.
 
 #' @export
-calculate_energy <- function(pattern, return_mean = FALSE, comp_fast = FALSE){
+calculate_energy <- function(pattern, return_mean = FALSE, comp_fast = 1000, verbose = TRUE){
 
   # check if randomized and observed is present
   if(!all(c(paste0("randomized_", seq_len(length(pattern) - 1)), "observed") == names(pattern)) || is.null(names(pattern))) {
     stop("Input must named 'randomized_1' to 'randomized_n' and includ 'observed' pattern.",
          call. = FALSE)
   }
 
+  # check if number of points exceed comp_fast limit
+  if(pattern$observed$n > comp_fast) {
+    comp_fast <- TRUE
+  }
+
+  else {
+    comp_fast <- FALSE
+  }
+
   pattern_observed <- pattern[names(pattern) == "observed"] # extract observed pattern
 
   pattern_reconstructed <- pattern[names(pattern) != "observed"] # extract randomized patterns
@@ -69,36 +79,50 @@ calculate_energy <- function(pattern, return_mean = FALSE, comp_fast = FALSE){
   }
 
   # loop through all reconstructed patterns
-  result <- vapply(pattern_reconstructed, function(current_pattern) {
+  result <- vapply(seq_along(pattern_reconstructed), function(x) {
 
+    # fast computation of summary stats
     if(comp_fast) {
 
-      gest_reconstruction <- spatstat::Gest(X = current_pattern, correction = "none")
+      gest_reconstruction <- spatstat::Gest(X = pattern_reconstructed[[x]], correction = "none")
 
-      pcf_reconstruction <- shar::estimate_pcf_fast(pattern = current_pattern,
+      pcf_reconstruction <- shar::estimate_pcf_fast(pattern = pattern_reconstructed[[x]],
                                                     correction = "none",
                                                     method = "c",
                                                     spar = 0.5)
     }
 
+    # normal computation of summary stats
     else{
 
-      gest_reconstruction <- spatstat::Gest(X = current_pattern, correction = "han")
+      gest_reconstruction <- spatstat::Gest(X = pattern_reconstructed[[x]], correction = "han")
 
-      pcf_reconstruction <- spatstat::pcf(X = current_pattern,
+      pcf_reconstruction <- spatstat::pcf(X = pattern_reconstructed[[x]],
                                           correction = "best", divisor = "d")
     }
 
     # difference between observed and reconstructed pattern
-    mean(abs(gest_observed[[3]] - gest_reconstruction[[3]]), na.rm = TRUE) +
+    energy <- mean(abs(gest_observed[[3]] - gest_reconstruction[[3]]), na.rm = TRUE) +
       mean(abs(pcf_observed[[3]] - pcf_reconstruction[[3]]), na.rm = TRUE)
-  },  FUN.VALUE = numeric(1))
+
+    # print progress
+    if(verbose) {
+      message("\r> Progress: ", x, "/", length(pattern_reconstructed), appendLF = FALSE)
+    }
+
+    return(energy)
+
+  }, FUN.VALUE = numeric(1))
 
   # return mean for all reconstructed patterns
   if(return_mean) {
     result <- mean(result)
   }
 
+  # write result in new line if progress was printed
+  if(verbose) {
+    message("\r")
+  }
+
   return(result)
 }
-

R/fit_point_process.R

@@ -28,7 +28,7 @@
 
 #' @export
 fit_point_process <- function(pattern,
-                              n_random = 19, process = 'poisson',
+                              n_random = 1, process = 'poisson',
                               return_input = TRUE,
                               simplify = FALSE,
                               verbose = TRUE){
@@ -49,7 +49,7 @@ fit_point_process <- function(pattern,
 
 
       if(verbose) {
-        cat(paste0("\rProgress: n_random: ", x, "/", n_random))
+        message("\r> Progress: n_random: ", x, "/", n_random, appendLF = FALSE)
       }
 
       return(simulated)
@@ -80,7 +80,7 @@ fit_point_process <- function(pattern,
         difference <- simulated$n - pattern$n
 
         # id of points to remove
-        remove_points <- sample(seq_len(pattern$n), size = difference)
+        remove_points <- sample(seq_len(simulated$n), size = difference)
 
         # remove points
         simulated <- simulated[-remove_points]
@@ -103,7 +103,7 @@ fit_point_process <- function(pattern,
       }
 
       if(verbose) {
-        cat(paste0("\rProgress: n_random: ", x, "/", n_random))
+        message("\r> Progress: n_random: ", x, "/", n_random, appendLF = FALSE)
       }
 
       return(simulated)
@@ -117,8 +117,8 @@ fit_point_process <- function(pattern,
   # add input pattern to randomizations
   if(return_input){
 
-    if(verbose & simplify){
-      cat("\n")
+    if(simplify){
+      message("\n")
       warning("'simplify = TRUE' not possible for 'return_input = TRUE'.", call. = FALSE)
     }
 
@@ -131,8 +131,8 @@ fit_point_process <- function(pattern,
 
     if(simplify) {
 
-      if(verbose & n_random > 1) {
-        cat("\n")
+      if(n_random > 1) {
+        message("\n")
         warning("'simplify = TRUE' not possible for 'n_random > 1'.", call. = FALSE)
       }
 
@@ -146,5 +146,10 @@ fit_point_process <- function(pattern,
     }
   }
 
+  # write result in new line if progress was printed
+  if(verbose) {
+    message("\r")
+  }
+
   return(result)
 }