Minor fixes and nicheplot visualization function

iiasa · Oct 8, 2024 · f7e2cdf · f7e2cdf
1 parent 94c8ba2
commit f7e2cdf
Show file tree

Hide file tree

Showing 27 changed files with 316 additions and 58 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -125,6 +125,7 @@ export(mask.PredictorDataset)
 export(modal)
 export(new_id)
 export(new_waiver)
+export(nicheplot)
 export(partial)
 export(partial.DistributionModel)
 export(partial_density)

diff --git a/NEWS.md b/NEWS.md
@@ -1,12 +1,14 @@
 # ibis.iSDM 0.1.5 (current dev branch)
 
 #### New features
+* New visualization function `nicheplot()` to visualize suitability across 2 axes
 * Support for 'modal' value calculations in `ensemble()`.
 * Support for 'superlearner' in `ensemble()`.
 * Support for 'kmeans' derived threshold calculation in `threshold()` and `predictor_derivate()`.
 * Support for future processing streamlined. See FAQ section for instructions #18.
 
 #### Minor improvements and bug fixes
+* Now overwriting temporary data by default in `predictor_transform()` and similar functions.
 * Minor :bug: fix related to misaligned thresholds and negative exponential kernels.
 * :fire: :bug: fix for scenario projections that use different grain sizes than for inference.
 

diff --git a/R/add_control_bias.R b/R/add_control_bias.R
@@ -77,7 +77,7 @@
 #' estimating spatial sampling effort and habitat suitability for multiple species
 #' from opportunistic presence‐only data. Methods in Ecology and Evolution, 12(5), 933-945.
 #'
-#' @seealso [add_control_extrapolation()]
+#' @seealso [add_limits_extrapolation()]
 #' @keywords bias offset control
 #' @concept The spatial bias weighting was inspired by code in the \code{enmSdmX} package.
 #'

diff --git a/R/add_predictors.R b/R/add_predictors.R
@@ -248,7 +248,7 @@ methods::setMethod(
 
     # Mask predictors with existing background layer
     if(bgmask){
-      env <- terra::mask(env, mask = x$background)
+      env <- terra::mask(env, mask = x$background, overwrite = TRUE)
       # Reratify, work somehow only on stacks
       if(has_factors && any(is.factor(env)) ){
         new_env <- env
@@ -350,7 +350,7 @@ methods::setMethod(
       # If it is a raster
       if(is.Raster(x$background)){
         # Check that background and range align, otherwise raise error
-        if(is_comparable_raster(layer, x$background)){
+        if(!is_comparable_raster(layer, x$background)){
           warning('Supplied range does not align with background! Aligning them now...')
           layer <- alignRasters(layer, x$background, method = 'bilinear', func = mean, cl = FALSE)
         }
@@ -372,12 +372,12 @@ methods::setMethod(
     if(terra::global(ras1, "min", na.rm = TRUE) == terra::global(ras1, "max", na.rm = TRUE)){
       o <- ras2
       # Ensure that all layers have a minimum and a maximum
-      o[is.na(o)] <- 0; o <- terra::mask(o, x$background)
+      o[is.na(o)] <- 0; o <- terra::mask(o, x$background, overwrite = TRUE)
       names(o) <- c('elev_high')
     } else {
       o <- c(ras1, ras2)
       # Ensure that all layers have a minimum and a maximum
-      o[is.na(o)] <- 0; o <- terra::mask(o, x$background)
+      o[is.na(o)] <- 0; o <- terra::mask(o, x$background, overwrite = TRUE)
       names(o) <- c('elev_low', 'elev_high')
     }
     rm(ras1,ras2)
@@ -553,7 +553,8 @@ methods::setMethod(
     #     ras_range <- raster::rasterize(layer, temp, field = 1, background = NA)
     #   }
     # } else {
-    ras_range <- terra::rasterize(layer, temp, field = 1, background = 0)
+    ras_range <- terra::rasterize(layer, temp, field = 1,
+                                  background = 0, overwrite = TRUE)
     # }
 
     # -------------- #
@@ -565,8 +566,8 @@ methods::setMethod(
       names(dis) <- 'binary_range'
     } else if(method == 'distance'){
       # Calculate the linear distance from the range
-      dis <- terra::gridDist(ras_range, target = 1)
-      dis <- terra::mask(dis, x$background)
+      dis <- terra::gridDist(ras_range, target = 1, overwrite = TRUE)
+      dis <- terra::mask(dis, x$background, overwrite = TRUE)
       # If max distance is specified
       if(!is.null(distance_max) && !is.infinite(distance_max)){
         dis[dis > distance_max] <- NA # Set values above threshold to NA
@@ -581,7 +582,7 @@ methods::setMethod(
 
       # Set NA to 0 and mask again
       dis[is.na(dis)] <- 0
-      dis <- terra::mask(dis, x$background)
+      dis <- terra::mask(dis, x$background, overwrite = TRUE)
       names(dis) <- 'distance_range'
     }
 

diff --git a/R/class-biodiversitydistribution.R b/R/class-biodiversitydistribution.R
@@ -142,7 +142,7 @@ BiodiversityDistribution <- R6::R6Class(
     #' @description
     #' Specify new limits to the background
     #' @param x A [`list`] object with method and limit type.
-    #' @seealso [add_control_extrapolation()]
+    #' @seealso [add_limits_extrapolation()]
     #' @return This object.
     set_limits = function(x){
       # Specify list

diff --git a/R/engine_stan.R b/R/engine_stan.R
@@ -581,7 +581,7 @@ engine_stan <- function(x,
                                        newdata = full@data,
                                        offset = (full$w),
                                        family = fam, # Family
-                                       mode = self$stan_param$type # Type
+                                       type = self$stan_param$type # Type
       )
 
       # Convert full to raster
@@ -660,7 +660,7 @@ engine_stan <- function(x,
                                              newdata = full@data,
                                              offset = (full$w),
                                              family = fam,
-                                             mode = type # Linear predictor
+                                             type = type # Linear predictor
       )
 
       # Fill output with summaries of the posterior
@@ -766,7 +766,7 @@ engine_stan <- function(x,
                                                newdata = df_temp,
                                                offset = df_temp$w,
                                                family = fam,
-                                               mode = type) # Linear predictor
+                                               type = type) # Linear predictor
 
         # FIXME: Something wrong here I guess
         # Also attach the partial variable
@@ -848,7 +848,7 @@ engine_stan <- function(x,
                                              newdata = df_partial@data,
                                              offset = df_partial$w,
                                              family = fam,
-                                             mode = type # Linear predictor
+                                             type = type # Linear predictor
       )
 
       # Get container

diff --git a/R/ensemble.R b/R/ensemble.R
@@ -253,16 +253,16 @@ methods::setMethod(
           names(ras) <- paste0('model', 1:terra::nlyr(ras))
           ex <- terra::extract(ras, point, ID = FALSE)
           ex <- cbind(point[,field_occurrence], ex)
-          fit <- glm(
-            formula = paste(field_occurrence, "~", paste0(names(ras), collapse = ' + ')) |> as.formula(),
-            family = binomial(),data = ex
+          fit <- stats::glm(
+            formula = paste(field_occurrence, "~", paste0(names(ras), collapse = ' + ')) |> stats::as.formula(),
+            family = stats::binomial(),data = ex
           )
           # Now predict output with the meta-learner
           new <- emptyraster(ras)
           new[which(!is.na(ras[[1]])[])] <- terra::predict(
             fit, ras, na.rm = FALSE, type = "response",
             cores = getOption('ibis.nthread'))
-          attr(new, "superlearner.coefficients") <- coef(fit)
+          attr(new, "superlearner.coefficients") <- stats::coef(fit)
           try({ rm(ex,fit) },silent = TRUE)
         }
 
@@ -409,16 +409,16 @@ methods::setMethod(
           names(ras) <- paste0('model', 1:terra::nlyr(ras))
           ex <- terra::extract(ras, point, ID = FALSE)
           ex <- cbind(point[,field_occurrence], ex)
-          fit <- glm(
-            formula = paste(field_occurrence, "~", paste0(names(ras), collapse = ' + ')) |> as.formula(),
-            family = binomial(),data = ex
+          fit <- stats::glm(
+            formula = paste(field_occurrence, "~", paste0(names(ras), collapse = ' + ')) |> stats::as.formula(),
+            family = stats::binomial(),data = ex
           )
           # Now predict output with the meta-learner
           new <- emptyraster(ras)
           new[which(!is.na(ras[[1]])[])] <- terra::predict(
             fit, ras, na.rm = FALSE, type = "response",
             cores = getOption('ibis.nthread'))
-          attr(new, "superlearner.coefficients") <- coef(fit)
+          attr(new, "superlearner.coefficients") <- stats::coef(fit)
           try({ rm(ex,fit) },silent = TRUE)
         }
         # Rename

diff --git a/R/ibis.iSDM-package.R b/R/ibis.iSDM-package.R
@@ -31,6 +31,7 @@ globalVariables(c("background", "band", "bi_class", "bias",
                   "self",
                   # Cores for parallel processing
                   "cores",
+                  "%dofuture%",
                   # Global prediction function
                   "predict_boom",
                   "id", "included", "i",

diff --git a/R/misc.R b/R/misc.R
@@ -173,7 +173,7 @@ ibis_enable_parallel <- function(){
 #' * \code{"slurm"} = To be implemented: Slurm linkage via batchtools.
 #' @param strategy A [`character`] with the strategy.
 #' @return Invisible
-#' @seealso [future], [ibis_future_run]
+#' @seealso [future], [ibis_future]
 #' @keywords misc
 #' @export
 ibis_set_strategy <- function(strategy = "sequential"){
@@ -222,6 +222,7 @@ ibis_set_threads <- function(threads = 2){
 #' Make sure not to parallize predictions within existing clusters to avoid out-of-memory
 #' issues.
 #'
+#' @param plan_exists A [`logical`] check on whether an existing [`future`] plan exists (Default: \code{FALSE}).
 #' @param cores A [`numeric`] number stating the number of cores to use.
 #' @param strategy A [`character`] denoting the strategy to be used for future.
 #' See help of [`future`] for options. (Default: \code{"multisession"}).
@@ -367,8 +368,9 @@ chunk_data <- function(X, N = NULL, cores = parallel::detectCores(), index_only
 #' @param cores A [numeric] of the number of cores to use (Default: \code{1}).
 #' @param approach [`character`] for the parallelization approach taken (Options:
 #' \code{"parallel"} or \code{"future"}).
-#' @param export_package A [`vector`] with packages to export for use on parallel
+#' @param export_packages A [`vector`] with packages to export for use on parallel
 #' nodes (Default: \code{NULL}).
+#' @param ... Any other parameter passed on.
 #'
 #' @details By default, the [parallel] package is used for parallel computation,
 #' however an option exists to use the [future] package instead.