Merge pull request #13 from BiologicalRecordsCentre/dev

Dev

R/basic_functions.R

@@ -62,66 +62,6 @@ state_target_suitability_uniform <- function(simulation_object,value = 0.5,n_tar
   sim_state
 }
 
-#' Create Virtual Species Suitability SpatRaster for Target State
-#'
-#' @param simulation_object A SimulationObject containing the background and environmental layers.
-#' @param n_targets The number of target layers. Default is 1.
-#' @param params A list of parameters for generating virtual species. Default is NULL.
-#'
-#' @return A SimulationObject with updated target suitability layers.
-#' @examples
-#' \dontrun{
-#' sim_object <- state_target_suitability_virtsp(simulation_object, n_targets = 2)
-#' }
-#' @export
-state_target_suitability_virtsp <- function(simulation_object, n_targets = 1, params = NULL) {
-  simulation_object_original <- simulation_object
-  simulation_object <- read_sim_obj_rasters(simulation_object)
-
-  background <- simulation_object@background
-  environment <- simulation_object@state_env
-
-  #check if virtualspecies is installed and available
-  if ("virtualspecies" %in% installed.packages()[,"Package"]) {
-    pkg_data <- installed.packages()[installed.packages()[,"Package"]=="virtualspecies",]
-    message(paste0("virtualspecies version ", pkg_data["Version"], " is installed and will be loaded"))
-    library(virtualspecies)
-  } else {
-    stop("Attempting to use sim_state_target_suitability_virtualspecies() which requires that {virtualspecies} is installed, but virtualspecies isn't installed. Please install virtualspecies.")
-  }
-
-  if (is.null(params)) {
-    params <- rep(list(NA), n_targets)
-  }
-
-  layers <- list()
-
-  for (i in 1:n_targets) {
-    param <- as.list(params[[i]])
-    param$raster.stack <- raster::raster(environment)
-    param$plot <- FALSE
-    param <- param[!is.na(param)]
-
-    layer <- do.call("generateRandomSp", param)
-
-    layers[[i]] <- layer$suitab.raster
-  }
-
-  # Convert to spatraster
-  layers <- terra::rast(layers)
-
-  # Set the CRS
-  terra::crs(layers) <- terra::crs(background)
-  names(layers) <- paste0("target_", 1:n_targets)
-
-  # Unload the package
-  detach("package:virtualspecies", unload = TRUE)
-
-  simulation_object_original@state_target_suitability <- layers
-
-  # Return the updated simulation_object
-  return(simulation_object_original)
-}
 
 #' Realize Target Suitability Using Binomial Distribution
 #'

R/sim_detect.R

@@ -9,16 +9,11 @@
 #' sim_effort_fun(simulation_object, fun, ...)
 #' }
 sim_detect <- function(simulation_object, fun, ...) {
+  check_fun(fun)
+
   simulation_object_original <- simulation_object
   simulation_object <- read_sim_obj_rasters(simulation_object)
 
-  if(is.character(fun)){
-    if(!(fun %in% c("equal"))){
-      stop("Provided function must be 'equal'")
-    }
-    fun <- get(paste0("detect_",fun))
-  }
-
   # apply the function
   detections <- fun(simulation_object, ...)
 

R/sim_effort.R

@@ -12,18 +12,13 @@
 #' sim_effort(simulation_object, fun, ...)
 #' }
 #' @export
-sim_effort <- function(simulation_object, fun, sf=NULL, ...) {
+sim_effort <- function(simulation_object, fun=NULL, sf=NULL, ...) {
+
   simulation_object_original <- simulation_object
   simulation_object <- read_sim_obj_rasters(simulation_object)
 
   if (is.null(sf)){
-    if(is.character(fun)){
-      if(!(fun %in% c("basic"))){
-        stop("Provided function must be 'basic'")
-      }
-      fun <- get(paste0("effort_",fun))
-    }
-    # apply the function
+    check_fun(fun)
     effort_sf <- fun(simulation_object, ...)
   } else {
     effort_sf <- sf

R/sim_report.R

@@ -9,16 +9,10 @@
 #' sim_report_fun(simulation_object, fun, ...)
 #' }
 sim_report <- function(simulation_object, fun, ...) {
+  check_fun(fun)
   simulation_object_original <- simulation_object
   simulation_object <- read_sim_obj_rasters(simulation_object)
 
-  if(is.character(fun)){
-    if(!(fun %in% c("equal"))){
-      stop("Provided function must be 'equal'")
-    }
-    fun <- get(paste0("report_",fun))
-  }
-
   # apply the function
   report <- fun(simulation_object, ...)
 

R/sim_state_env.R

@@ -7,7 +7,7 @@
 #'
 #' @param simulation_object An object representing the simulation. The object should contain
 #'                          a `background` slot and a `state_env` slot.
-#' @param fun A character string specifying the name of a predefined function            (`"gradient"` or `"uniform"`) or a user-defined function.
+#' @param fun a user-defined function.
 #' @param filename A character string specifying the filename to save the resultant SpatRaster. If `NULL`, the SpatRaster is not saved to a file.
 #' @param spatraster A `SpatRaster` object to be used directly as the state environment. If provided, it overrides the `fun` parameter.
 #' @param ... Additional arguments to be passed to the function specified in `fun`.
@@ -17,22 +17,22 @@
 #' @details
 #' - If a `spatraster` is provided, the function checks that its dimensions match
 #'   those of the simulation object's background.
-#' - If `fun` is provided as a character string, it must be either `"gradient"` or `"uniform"`.
 #' - If `fun` is provided as a user-defined function, it will be applied to the simulation object.
 #' - If `filename` is provided, the resultant SpatRaster is saved, and the filename is returned.
 #'
 #' @examples
 #' \dontrun{
-#' sim_obj <- sim_state_env(sim_obj, fun = "uniform", value = 0.5)
-#' sim_obj <- sim_state_env(sim_obj, fun = "gradient", from = 0, to = 1)
+#' sim_obj <- sim_state_env(sim_obj, fun = state_env_uniform, value = 0.5)
+#' sim_obj <- sim_state_env(sim_obj, fun = state_env_gradient, from = 0, to = 1)
 #' sim_obj <- sim_state_env(sim_obj, spatraster = my_spatraster)
 #' sim_obj <- sim_state_env(sim_obj, fun = my_custom_function)
-#' sim_obj <- sim_state_env(sim_obj, fun = "uniform", filename = "output.tif")
+#' sim_obj <- sim_state_env(sim_obj, fun = state_env_uniform, filename = "output.tif")
 #' }
 #'
 #' @export
 sim_state_env <- function(simulation_object, fun= NULL, filename = NULL, spatraster=NULL, ...) {
 
+
   #load in rasters but create a copy with the original version
   simulation_object_original <- simulation_object
   simulation_object <- read_sim_obj_rasters(simulation_object)
@@ -54,16 +54,8 @@ sim_state_env <- function(simulation_object, fun= NULL, filename = NULL, spatras
     }
 
   # OR if a function has been defined
-  } else if (is.character(fun)){
-    if(!(fun %in% c("gradient","uniform"))){
-      stop("Provided function must either be 'gradient' or 'uniform'")
-    }
-
-    fun_got <- get(paste0("state_env_",fun))
-    spatraster <- fun_got(simulation_object,...)
-
-  # or finally if user has provided a function
   } else {
+    check_fun(fun)
     spatraster <- fun(simulation_object,...)
   }
 

R/sim_state_target_realise.R

@@ -5,36 +5,32 @@
 #' The updated simulation object with the new state target realization and metadata is returned.
 #'
 #' @param simulation_object A SimulationObject containing the state environment.
-#' @param fun Either 'binomial' or 'threshold' to use the included functions, or a custom function that takes a SimulationObject with an environment slot and outputs a target suitability SpatRaster indicating either presence/absence or abundance.
+#' @param fun A custom function that takes a SimulationObject with an environment slot and outputs a target suitability SpatRaster indicating either presence/absence or abundance.
 #' @param filename A character string specifying the filename to save the resultant SpatRaster. If `NULL`, the SpatRaster is not saved to a file. Default is `NULL`.
 #' @param ... Additional arguments to be passed to the function specified in `fun`.
 #'
 #' @return The updated simulation object with the new state target realization.
 #'
 #' @details
-#' - If `fun` is provided as 'binomial' or 'threshold', the corresponding included function is used.
 #' - If `fun` is a custom function, it will be applied to the simulation object.
 #' - If `filename` is provided, the resultant SpatRaster is saved, and the filename is returned.
 #'
 #' @examples
 #' \dontrun{
-#' sim_obj <- sim_state_target_realise(sim_obj, fun = "binomial")
-#' sim_obj <- sim_state_target_realise(sim_obj, fun = "threshold", threshold = 0.5)
+#' sim_obj <- sim_state_target_realise(sim_obj, fun = state_target_realise_binomial)
+#' sim_obj <- sim_state_target_realise(sim_obj, fun = state_target_realise_threshold, threshold = 0.5)
 #' sim_obj <- sim_state_target_realise(sim_obj, fun = my_custom_function)
 #' sim_obj <- sim_state_target_realise(sim_obj, fun = my_custom_function, filename = "output.tif")
 #' }
 #'
 #' @export
 sim_state_target_realise <- function(simulation_object,fun, filename=NULL, ...) {
+  check_fun(fun)
+
   simulation_object_original <- simulation_object
   simulation_object <- read_sim_obj_rasters(simulation_object)
 
-  if(is.character(fun)){
-    if(!(fun %in% c("binomial","threshold"))){
-      stop("Provided function must be 'binomial' or 'threshold'")
-    }
-    fun <- get(paste0("state_target_realise_",fun))
-  }
+
 
   # apply the function
   realised <- fun(simulation_object, ...)

R/sim_state_target_suitability.R

@@ -19,25 +19,17 @@
 #'
 #' @examples
 #' \dontrun{
-#' sim_obj <- sim_state_target_suitability(sim_obj, fun = "uniform", value = 0.5)
+#' sim_obj <- sim_state_target_suitability(sim_obj, fun = state_target_suitability_uniform, value = 0.5)
 #' sim_obj <- sim_state_target_suitability(sim_obj, fun = my_custom_function)
 #' sim_obj <- sim_state_target_suitability(sim_obj, fun = my_custom_function, filename = "output.tif")
 #' }
 #'
 #' @export
 sim_state_target_suitability <- function(simulation_object,fun,filename = NULL, ...) {
+  check_fun(fun)
   simulation_object_original <- simulation_object
   simulation_object <- read_sim_obj_rasters(simulation_object)
 
-  if(is.character(fun)){
-    if(exists(fun)){
-      fun <- get(fun)
-    } else if((fun %in% c("uniform"))) {
-      fun <- get(paste0("state_target_suitability_",fun))
-    } else {
-      stop("Function not found")
-    }
-  }
 
   # apply the function
   suitability <- fun(simulation_object, ...)

R/util.R

@@ -100,3 +100,10 @@ hash_sim_obj <- function(sim_obj){
 export_df <- function(sim_obj){
   sim_obj@report
 }
+
+
+check_fun <- function(fun){
+  if(!is.function(fun)){
+    stop("Argument fun must be a function")
+  }
+}

README.Rmd

@@ -120,7 +120,7 @@ The output of this stage is a SpatRaster with layers for each environmental vari
 
 The function for simulating environmental state is `sim_state_env`
 
-The minimal version of this function is `sim_state_env(fun="uniform")` which produces a simulation object with a single layer which is uniform in value in space. 
+The minimal version of this function is `sim_state_env(fun=state_env_uniform)` which produces a simulation object with a single layer which is uniform in value in space. 
 
 The BYOD (Bring Your Own Data) function is `sim_state_env(spatraster = [your_raster])` where you can provide a SpatRaster with custom environmental state that meets you needs and it will be added to the correct slot.
 
@@ -138,17 +138,17 @@ state_target_suitability_example <- function(sim_obj){
 
 
 sim_obj <- sim_state_target_suitability(sim_obj,state_target_suitability_example)
-sim_obj <- sim_state_target_realise(sim_obj,fun = "binomial")
+sim_obj <- sim_state_target_realise(sim_obj,fun = state_target_realise_binomial)
 plot(sim_obj)
 ```
 
 Both of these representations of state are represented in the simulation object as SpatRaster with layers for each target. Again, if you want the target to change over time then create a list of rasters where each list item represents the target state at each time step, but this will need some wrangling.
 
 The function for simulating target state is `sim_state_target_suitability`
 
-The minimal version of this function is `sim_state_target_suitability(fun="uniform")` which produces a uniform abundance across space.
+The minimal version of this function is `sim_state_target_suitability(fun=state_target_suitability_uniform)` which produces a uniform abundance across space.
 
-The BYOD function is `sim_state_target(fun=[your custom functio])` meaning you could also use other packages to generate a target state (eg.rangeshiftR, virtualspecies) then convert the output to a `SpatRaster`.
+The BYOD function is `sim_state_target(fun=[your custom function])` meaning you could also use other packages to generate a target state (eg.rangeshiftR, virtualspecies) then convert the output to a `SpatRaster`.
 
 ## Simulating effort
 
@@ -180,7 +180,7 @@ Here's a very basic example where we generate effort comprising of two samplers,
 
 ```{r sampling data}
 # Simulate the sampling effort
-sim_obj <- sim_effort(sim_obj,fun = "basic", n_samplers=2, n_visits = 1, n_sample_units = 2)
+sim_obj <- sim_effort(sim_obj,fun = effort_basic, n_samplers=2, n_visits = 1, n_sample_units = 2)
 sim_obj@effort
 ```
 
@@ -198,7 +198,7 @@ In STRIDER, "detection" refers to the process of whether the applied effort iden
 
 Given detection, "identification" refers to the accurate recognition and categorization of a species during the data collection process. This step involves correctly identifying the observed organism to the appropriate taxonomic group or species. Samplers may not always identify a target correctly and these functions may take confusion matrices. 
 
-The minimal function for this process is `sim_detect(fun="equal")` in which all targets are detected at equal probability.
+The minimal function for this process is `sim_detect(fun=detect_equal)` in which all targets are detected at equal probability.
 
 ## Simulating the reporting
 
@@ -210,7 +210,7 @@ Data may not be reported exactly as the sampler experienced it, for example:
  * Aggregating to a coarser spatial resolution
  * Only interesting or novel species are reported (eg. as a result of life listing)
 
-The minimal function for this process is `sim_report(fun="equal")` in which all data is reported at equal probability.
+The minimal function for this process is `sim_report(fun=report_equal)` in which all data is reported at equal probability.
 
 ## Custom functions
 
@@ -262,16 +262,16 @@ state_target_suitability_example <- function(sim_obj){
 sim_obj <- sim_state_target_suitability(sim_obj,state_target_suitability_example)
 
 #realise the state
-sim_obj <- sim_state_target_realise(sim_obj,fun = "binomial")
+sim_obj <- sim_state_target_realise(sim_obj,fun = state_target_realise_binomial)
 
 # Simulate the sampling effort
-sim_obj <- sim_effort(sim_obj,fun = "basic", n_visits = 100, replace = FALSE)
+sim_obj <- sim_effort(sim_obj,fun = effort_basic, n_visits = 100, replace = FALSE)
 
 # Simulate the detection
-sim_obj <- sim_detect(sim_obj,fun = "equal", prob = 0.5)
+sim_obj <- sim_detect(sim_obj,fun = detect_equal, prob = 0.5)
 
 # Simulate the reporting
-sim_obj <- sim_report(sim_obj,fun = "equal", prob = 0.8, platform = "iRecord")
+sim_obj <- sim_report(sim_obj,fun = report_equal, prob = 0.8, platform = "iRecord")
 
 plot(sim_obj) 
 ```