From 53bebaf57fe20b792c670591121d67848a65c42a Mon Sep 17 00:00:00 2001 From: Simon Rolph Date: Wed, 8 Nov 2023 10:01:00 +0000 Subject: [PATCH] Refactor to use s4 class 'simulation object' for all functions --- R/SimulationObjectClass.R | 23 ++++++++ R/sim_detect_equal.R | 24 +++++---- R/sim_effort_uniform.R | 23 ++++---- R/sim_report_equal.R | 20 +++---- R/sim_state_env_NLMR.R | 41 ++++++++------- R/sim_state_env_gradient.R | 19 ++++--- R/sim_state_env_uniform.R | 17 +++--- R/sim_state_target_NLMR.R | 17 +++--- R/sim_state_target_uniform.R | 18 ++++--- R/sim_state_target_virtualspecies.R | 40 +++++++------- README.Rmd | 62 +++++++++++++++------- man/sim_detect_equal.Rd | 10 +--- man/sim_effort_uniform.Rd | 18 ++----- man/sim_report_equal.Rd | 24 ++------- man/sim_state_env_NLMR.Rd | 8 +-- man/sim_state_env_gradient.Rd | 8 +-- man/sim_state_env_uniform.Rd | 8 +-- man/sim_state_state_NLMR.Rd | 14 ++--- man/sim_state_target_uniform.Rd | 10 ++-- man/sim_state_target_virtualspecies.Rd | 11 ++-- tests/testthat/test-simulation_basic.R | 64 ++++++++++++----------- vignettes/example_NLMR_virtualspecies.Rmd | 49 ++++++++--------- vignettes/example_minimal.Rmd | 54 +++++++++---------- 23 files changed, 312 insertions(+), 270 deletions(-) create mode 100644 R/SimulationObjectClass.R diff --git a/R/SimulationObjectClass.R b/R/SimulationObjectClass.R new file mode 100644 index 0000000..5dd8560 --- /dev/null +++ b/R/SimulationObjectClass.R @@ -0,0 +1,23 @@ +# Define a custom class for the SimulationObject +setClass("SimulationObject", + slots = list( + background = "ANY", + state_env = "ANY", + state_target = "ANY", + effort = "ANY", + detect = "ANY", + report = "ANY" + ) +) + +# Create a constructor for the SimulationObject class +SimulationObject <- function(background, state_env = NULL, state_target = NULL, effort = NULL, detect = NULL, report = NULL) { + new("SimulationObject", + background = background, + state_env = state_env, + state_target = state_target, + effort = effort, + detect = detect, + report = report + ) +} diff --git a/R/sim_detect_equal.R b/R/sim_detect_equal.R index 307c5b2..4e62a49 100644 --- a/R/sim_detect_equal.R +++ b/R/sim_detect_equal.R @@ -1,28 +1,34 @@ #' Simulates detection where all detections occur at an equal probability and identified correctly #' -#' @param background the background -#' @param state_env description -#' @param state_target a SpatRaster for the true state to be detected from,and from which the extent and resolution will be used -#' @param effort a sf of sampled points +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param prob a numeric probability of each target being detected #' @return A simple feature collection with geometry type POINTs #' @examples #' \dontrun{ #' sim_detect_equal() #' } -sim_detect_equal <- function(background, state_env, state_target, effort,prob=1){ +sim_detect_equal <- function(simulation_object, prob = 1) { + background <- simulation_object@background + state_env <- simulation_object@state_env + state_target <- simulation_object@state_target + effort <- simulation_object@effort + detections_all <- data.frame() - for (i in 1:dim(state_target)[3]){ + for (i in 1:dim(state_target)[3]) { detections <- effort - detections$state <- terra::extract(state_target[[i]],effort)$abundance + detections$state <- terra::extract(state_target[[i]], effort)$abundance detections$target <- i detections$detected <- runif(nrow(detections)) < prob detections$identified <- TRUE - detections_all <- rbind(detections_all,detections) + detections_all <- rbind(detections_all, detections) } - detections_all + # Update simulation_object with the new results + simulation_object@detect <- detections_all + + # Return the updated simulation_object + return(simulation_object) } diff --git a/R/sim_effort_uniform.R b/R/sim_effort_uniform.R index fd8870e..91159f6 100644 --- a/R/sim_effort_uniform.R +++ b/R/sim_effort_uniform.R @@ -1,21 +1,26 @@ #' Simulates a uniform effort #' -#' @param background the background -#' @param state_env description -#' @param state_target a SpatRaster from which the extent and resolution will be used +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param n_visits a number indicating the average number of visits #' @param replace a logical indicating whether to sample with replacement -#' @return A simple feature collection with geometry type POINTs +#' @return An updated simulation object with the newly calculated effort in the correct slot #' @examples #' \dontrun{ -#' sim_effort_uniform(state,100,T) +#' sim_effort_uniform(simulation_object, 100, FALSE) #' } -sim_effort_uniform <- function(background, state_env, state_target, n_visits=100,replace=F){ - visited_cells <- sample(terra::cells(state_target),size = n_visits,replace=replace) +sim_effort_uniform <- function(simulation_object, n_visits = 100, replace = FALSE) { + state_target <- simulation_object@state_target - sim_effort_points <- as.data.frame(terra::xyFromCell(state_target,visited_cells)) + visited_cells <- sample(terra::cells(state_target), size = n_visits, replace = replace) + + sim_effort_points <- as.data.frame(terra::xyFromCell(state_target, visited_cells)) sim_effort_points$sampler_id <- 1 sim_effort_points$cell_id <- visited_cells - sf::st_as_sf(sim_effort_points,coords= c("x","y"),crs=terra::crs(state_target)) + effort_sf <- sf::st_as_sf(sim_effort_points, coords = c("x", "y"), crs = terra::crs(state_target)) + + simulation_object@effort <- effort_sf + + # Return the updated simulation_object + return(simulation_object) } diff --git a/R/sim_report_equal.R b/R/sim_report_equal.R index 249137b..a5dd1e3 100644 --- a/R/sim_report_equal.R +++ b/R/sim_report_equal.R @@ -1,25 +1,25 @@ #' Simulates reporting where all reports occur at an equal probability and identified correctly #' -#' @param background the background -#' @param state_env description -#' @param state_target a SpatRaster for the true state to be detected from, and from which the extent and resolution will be used -#' @param effort effort -#' @param detect a sf of sampled points +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param prob a numeric probability of each target being reported #' @param platform name of the recording platform -#' @return A simple feature collection with geometry type POINTs +#' @return An updated simulation object with the newly calculated report in the correct slot #' @examples #' \dontrun{ -#' sim_report_equal(state,detections,0.5) +#' sim_report_equal(simulation_object, 0.5, "iRecord") #' } -sim_report_equal <- function(background, state_env, state_target, effort, detect,prob=1,platform="iRecord"){ +sim_report_equal <- function(simulation_object, prob = 1, platform = "iRecord") { + detect <- simulation_object@detect reports <- detect reports$reported <- runif(nrow(reports)) < prob - reports$reported[reports$detected == F] <- F + reports$reported[reports$detected == FALSE] <- FALSE reports$platform <- platform - reports + simulation_object@report <- reports + + # Return the updated simulation_object + return(simulation_object) } diff --git a/R/sim_state_env_NLMR.R b/R/sim_state_env_NLMR.R index 870988a..6dcb43d 100644 --- a/R/sim_state_env_NLMR.R +++ b/R/sim_state_env_NLMR.R @@ -1,30 +1,32 @@ #' Simulates a state of the environment using a wrapper around NLMR functions #' -#' @param background a SpatRaster from which the extent and resolution will be used +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param alg single or list of algorithms as character #' @param params list of vectors providing parameters to be passed to each NMLR function call -#' @return A SpatRaster with extent and resolution of background but values describing the environment +#' @return An updated simulation object with the newly calculated state of the environment in the correct slot #' @examples #' \dontrun{ -#' sim_state_env_NLMR(terra::rast(nrows=100,ncols=100),"random") +#' sim_state_env_NLMR(simulation_object, "random") #' } -sim_state_env_NLMR <- function(background,alg,params=NULL){ +sim_state_env_NLMR <- function(simulation_object, alg, params = NULL) { + + background <- simulation_object@background #check if NLMR is installed and available - if("NLMR" %in% installed.packages()[,"Package"]){ + if ("NLMR" %in% installed.packages()[,"Package"]) { pkg_data <- installed.packages()[installed.packages()[,"Package"]=="NLMR",] - message(paste0("NLMR version ",pkg_data["Version"]," is installed and will be loaded")) + message(paste0("NLMR version ", pkg_data["Version"], " is installed and will be loaded")) library(NLMR) } else { stop("Attempting to use sim_state_env_NLMR() which requires that {NLMR} is installed, but NLMR isn't installed. Please install NLMR.") } - if(sum(alg %in% c("curds"))>0){ + if (sum(alg %in% c("curds")) > 0) { stop(paste0("Curds algorithm not implemented correctly yet")) } - if (is.null(params)){ - params <- rep(list(NA),length(alg)) + if (is.null(params)) { + params <- rep(list(NA), length(alg)) } #get nrows and ncols from background @@ -34,17 +36,17 @@ sim_state_env_NLMR <- function(background,alg,params=NULL){ layers <- list() #loop through the layers - for (i in 1:length(alg)){ + for (i in 1:length(alg)) { a <- alg[i] - fnc_name <- paste0("nlm_",a) + fnc_name <- paste0("nlm_", a) param <- as.list(params[[i]]) #add ncol+nrow - if(!("ncol" %in% names(param))){ - param$ncol<-ncols + if (!("ncol" %in% names(param))) { + param$ncol <- ncols } - if(!("nrow" %in% names(param))){ - param$nrow<-nrows + if (!("nrow" %in% names(param))) { + param$nrow <- nrows } param <- param[!is.na(param)] @@ -52,18 +54,21 @@ sim_state_env_NLMR <- function(background,alg,params=NULL){ layer <- do.call(what = fnc_name, args = param) layer <- terra::rast(layer) # turn into spat raster - layer <- terra::resample(layer,background) #resize + layer <- terra::resample(layer, background) #resize names(layer) <- a layers[[i]] <- layer } layers <- terra::rast(layers) - names(layers) <- paste0(names(layers),"_",1:length(names(layers))) + names(layers) <- paste0(names(layers), "_", 1:length(names(layers))) terra::crs(layers) <- terra::crs(background) #unload package detach("package:NLMR", unload = TRUE) - layers + simulation_object@state_env <- layers + + # Return the updated simulation_object + return(simulation_object) } diff --git a/R/sim_state_env_gradient.R b/R/sim_state_env_gradient.R index e553e21..40cbdc5 100644 --- a/R/sim_state_env_gradient.R +++ b/R/sim_state_env_gradient.R @@ -1,17 +1,22 @@ #' Simulates a uniform state of the environment #' -#' @param background a SpatRaster from which the extent and resolution will be used +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param from lower value of gradient #' @param to upper value of gradient -#' @return A SpatRaster with extent and resolution of background but values from abundance +#' @return An updated simulation object with the newly calculated state of the environment in the correct slot #' @examples #' \dontrun{ -#' sim_state_env_gradient(terra::rast(nrows=100,ncols=100)) +#' sim_state_env_gradient(simulation_object, 0, 1) #' } -sim_state_env_gradient <- function(background,from=0,to=1){ +sim_state_env_gradient <- function(simulation_object, from = 0, to = 1) { + background <- simulation_object@background + sim_state <- background[[1]] - terra::values(sim_state) <- rep(seq(from=from,to=to,length.out=dim(background)[2]),dim(background)[1]) + terra::values(sim_state) <- rep(seq(from = from, to = to, length.out = dim(background)[2]), dim(background)[1]) names(sim_state) <- "env" - sim_state -} + simulation_object@state_env <- sim_state + + # Return the updated simulation_object + return(simulation_object) +} diff --git a/R/sim_state_env_uniform.R b/R/sim_state_env_uniform.R index e0e6913..552030e 100644 --- a/R/sim_state_env_uniform.R +++ b/R/sim_state_env_uniform.R @@ -1,16 +1,21 @@ #' Simulates a uniform state of the environment #' -#' @param background a SpatRaster from which the extent and resolution will be used +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param value the value for the SpatRaster -#' @return A SpatRaster with extent and resolution of background but values from abundance +#' @return An updated simulation object with the newly calculated state of the environment in the correct slot #' @examples #' \dontrun{ -#' sim_state_env_uniform(terra::rast(nrows=100,ncols=100)) +#' sim_state_env_uniform(simulation_object, 0) #' } -sim_state_env_uniform <- function(background,value=0){ +sim_state_env_uniform <- function(simulation_object, value = 0) { + background <- simulation_object@background + sim_state <- background[[1]] terra::values(sim_state) <- value names(sim_state) <- "env" - sim_state -} + simulation_object@state_env <- sim_state + + # Return the updated simulation_object + return(simulation_object) +} diff --git a/R/sim_state_target_NLMR.R b/R/sim_state_target_NLMR.R index 66d7001..137fc96 100644 --- a/R/sim_state_target_NLMR.R +++ b/R/sim_state_target_NLMR.R @@ -1,14 +1,19 @@ #' Simulates a state of the target using a wrapper around sim_state_env_NLMR #' -#' @param background a SpatRaster from which the extent and resolution will be used -#' @param state_env State of the environment +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param alg single or list of algorithms as character #' @param params list of vectors providing parameters to be passed to each NMLR function call #' @param abundance Abundance of species -#' @return A SpatRaster with extent and resolution of background but values describing the environment -sim_state_state_NLMR <- function(background,state_env=NULL,alg,params=NULL,abundance =1){ - sim_state <- sim_state_env_NLMR(background=background,alg=alg,params=params)*abundance +#' @return An updated simulation object with the newly calculated state of the target in the correct slot +sim_state_state_NLMR <- function(simulation_object, alg, params = NULL, abundance = 1) { + background <- simulation_object@background + state_env <- simulation_object@state_env + + sim_state <- sim_state_env_NLMR(background = background, alg = alg, params = params) * abundance names(sim_state) <- "abundance" - sim_state + simulation_object@state_target <- sim_state + + # Return the updated simulation_object + return(simulation_object) } diff --git a/R/sim_state_target_uniform.R b/R/sim_state_target_uniform.R index 67ff4c7..c8c32a5 100644 --- a/R/sim_state_target_uniform.R +++ b/R/sim_state_target_uniform.R @@ -1,17 +1,21 @@ #' Simulates a uniform state of the target #' -#' @param background a SpatRaster from which the extent and resolution will be used -#' @param state_env a SpatRaster for the environmental sate +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param abundance a number indicating the abundance of the target in each cell -#' @return A SpatRaster with extent and resolution of background but values from abundance +#' @return An updated simulation object with the newly calculated state of the target in the correct slot #' @examples #' \dontrun{ -#' sim_state_target_uniform(background = terra::rast(nrows=100,ncols=100),abundance = 42) +#' sim_state_target_uniform(simulation_object, 42) #' } -sim_state_target_uniform <- function(background,state_env=NULL,abundance =10){ +sim_state_target_uniform <- function(simulation_object, abundance = 10) { + background <- simulation_object@background + sim_state <- background[[1]] terra::values(sim_state) <- abundance names(sim_state) <- "abundance" - sim_state -} + simulation_object@state_target <- sim_state + + # Return the updated simulation_object + return(simulation_object) +} diff --git a/R/sim_state_target_virtualspecies.R b/R/sim_state_target_virtualspecies.R index 9f9ebad..dbbd43e 100644 --- a/R/sim_state_target_virtualspecies.R +++ b/R/sim_state_target_virtualspecies.R @@ -1,34 +1,33 @@ #' Simulates a state of the target using a wrapper around virtualspecies functions #' -#' @param background a SpatRaster from which the extent and resolution will be used -#' @param environment a SpatRaster from which the extent and resolution will be used +#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation #' @param n_targets numeric for the number of targets to generate -#' @param prop_env numeric between 0 and 1 for proportion of environmental variables to be randomly used for each virtual species +#' @param prop_env numeric between 0 and 1 for the proportion of environmental variables to be randomly used for each virtual species #' @param params list of vectors providing parameters to be passed to each NMLR function call -#' @return A SpatRaster with extent and resolution of background but values describing the environment -sim_state_target_virtualspecies <- function(background,environment,n_targets=1,prop_env=1,params=NULL){ +#' @return An updated simulation object with the newly calculated state of the target in the correct slot +sim_state_target_virtualspecies <- function(simulation_object, n_targets = 1, prop_env = 1, params = NULL) { + background <- simulation_object@background + environment <- simulation_object@state_env - #check if NLMR is installed and available - if("virtualspecies" %in% installed.packages()[,"Package"]){ + #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")) + message(paste0("virtualspecies version ", pkg_data["Version"], " is installed and will be loaded")) library(virtualspecies) } else { stop("Attempting to use sim_state_target_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) + if (is.null(params)) { + params <- rep(list(NA), n_targets) } layers <- list() - for (i in 1:n_targets){ - + for (i in 1:n_targets) { param <- as.list(params[[i]]) param$raster.stack <- raster::raster(environment) - param$plot<-F + param$plot <- FALSE param <- param[!is.na(param)] layer <- do.call("generateRandomSp", param) @@ -36,15 +35,18 @@ sim_state_target_virtualspecies <- function(background,environment,n_targets=1,p layers[[i]] <- terra::rast(layer$suitab.raster) } - #turn into spatraster + # Convert to spatraster layers <- terra::rast(layers) - #get crs + # Set the CRS terra::crs(layers) <- terra::crs(background) - names(layers) <- paste0("target_",1:n_targets) + names(layers) <- paste0("target_", 1:n_targets) - #unload package + # Unload the package detach("package:virtualspecies", unload = TRUE) - layers + simulation_object@state_target <- layers + + # Return the updated simulation_object + return(simulation_object) } diff --git a/README.Rmd b/README.Rmd index 712ce84..53aea07 100644 --- a/README.Rmd +++ b/README.Rmd @@ -37,20 +37,31 @@ remotes::install_github("BiologicalRecordsCentre/STRIDER") ## How to use the R package -For each of the 5 processes there are choices of functions to use depending on your need. For each the processes there is the most basic version for demonstration purposes. +For each of the 5 processes, there are choices of functions to use depending on your needs. For each process, there is the most basic version for demonstration purposes. -The functions all follow this basic schema whereby all the objects from the previous stage are arguments in the subsequent functions, whether or not they are actually used in the calculations within the function: +The functions all follow this basic schema whereby all the objects from the previous stage, along with the `background` object, are combined into a single `simulation_object`. This object is then used as an argument in the subsequent functions, whether or not they are actually used in the calculations within the function. - * `state_env <- sim_state_env_______(background)` - * `state_target <- sim_state_target____(background, state_env, ...)` - * `effort <- sim_effort__________(background, state_env, state_target, ...)` - * `detect <- sim_detect__________(background, state_env, state_target, effort, ...)` - * `report <- sim_detect__________(background, state_env, state_target, effort, detect, ...)` +The `simulation_object` includes the following components: -There are no species STRIDER R objects, this is intentional as to allow flexibility ad interoperability. The outputs at each step are `terra` SpatRasters or `sf` feature collections (POINT) see figure above, so if you can use custom R scripts to generate the outputs of any of the steps. +- `@background`: Background extent and resolution of the simulated reality +- `@state_env`: Simulated state of the environment +- `@state_target`: Simulated state of the target +- `@effort`: Simulated sampling effort +- `@detect`: Simulated detection information +- `@report`: Simulated reporting information + +You can access and manipulate the `simulation_object` at each step to generate the outputs of the corresponding processes. The outputs at each step are `terra` SpatRasters or `sf` feature collections (POINT), as shown in the figure above. You can use custom R scripts to generate the outputs of any of the steps, ensuring flexibility and interoperability. + +The functions used at each stage are as follows: + + * `sim_state_env_...(simulation_object, ...)` + * `sim_state_target_...(simulation_object, ...)` + * `sim_effort_...(simulation_object, ...)` + * `sim_detect_...(simulation_object, ...)` + * `sim_detect_...(simulation_object, ....)` You could use the `targets` R package to create reproducible workflows for simulating your data. - + ## Simulating state States are represented as rasters (`SpatRaster`) with any resolution, extent or CRS (or no CRS). We simulate the state of the environment and 'target' separately. The state simulation functions take a raster which is refereed to as the 'background', the resolution, extent and CRS is inherited from this when simulating the state. @@ -110,16 +121,29 @@ library(STRIDER) library(terra) library(sf) -background <- terra::rast(matrix(0,1000,600)) # create background -state_env <- sim_state_env_gradient(background) #environment -state_target <- sim_state_target_uniform(background,state_env,42) #target -effort <- sim_effort_uniform(background,state_env,state_target,n_visits=100,replace=F) #effort -detections <-sim_detect_equal(background,state_env,state_target,effort,prob=0.5) #detection -reports <- sim_report_equal(background,state_env,state_target,effort,detections,prob=0.8,platform="iRecord") #reports +# Create the background +background <- terra::rast(matrix(0,1000,600)) + +# Create the simulation object +sim_obj <- SimulationObject(background = background) + +# Simulate the environment state +sim_obj <- sim_state_env_gradient(sim_obj) + +# Simulate the target state +sim_obj <- sim_state_target_uniform(sim_obj, abundance = 42) + +# Simulate the sampling effort +sim_obj <- sim_effort_uniform(sim_obj, n_visits = 100, replace = FALSE) + +# Simulate the detection +sim_obj <- sim_detect_equal(sim_obj, prob = 0.5) -plot(state_target) #state of target -plot(effort$geometry,add=T) #effort -plot(detections$geometry[detections$detected==F],col="red",pch=4,add=T) #highlight the non-detections -plot(reports$geometry[reports$reported],col="yellow",add=T) # highlight reported records as yellow +# Simulate the reporting +sim_obj <- sim_report_equal(sim_obj, prob = 0.8, platform = "iRecord") +plot(sim_obj@state_target) # State of the target +plot(sim_obj@effort$geometry, add = TRUE) # Effort +plot(sim_obj@detect$geometry[sim_obj@detect$detected == FALSE], col = "red", pch = 4, add = TRUE) # Highlight the non-detections +plot(sim_obj@report$geometry[sim_obj@report$reported], col = "yellow", add = TRUE) # Highlight reported records as yellow ``` diff --git a/man/sim_detect_equal.Rd b/man/sim_detect_equal.Rd index 9f474a4..e233004 100644 --- a/man/sim_detect_equal.Rd +++ b/man/sim_detect_equal.Rd @@ -4,16 +4,10 @@ \alias{sim_detect_equal} \title{Simulates detection where all detections occur at an equal probability and identified correctly} \usage{ -sim_detect_equal(background, state_env, state_target, effort, prob = 1) +sim_detect_equal(simulation_object, prob = 1) } \arguments{ -\item{background}{the background} - -\item{state_env}{description} - -\item{state_target}{a SpatRaster for the true state to be detected from,and from which the extent and resolution will be used} - -\item{effort}{a sf of sampled points} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{prob}{a numeric probability of each target being detected} } diff --git a/man/sim_effort_uniform.Rd b/man/sim_effort_uniform.Rd index 0e8fcd2..fb16efa 100644 --- a/man/sim_effort_uniform.Rd +++ b/man/sim_effort_uniform.Rd @@ -4,33 +4,23 @@ \alias{sim_effort_uniform} \title{Simulates a uniform effort} \usage{ -sim_effort_uniform( - background, - state_env, - state_target, - n_visits = 100, - replace = F -) +sim_effort_uniform(simulation_object, n_visits = 100, replace = FALSE) } \arguments{ -\item{background}{the background} - -\item{state_env}{description} - -\item{state_target}{a SpatRaster from which the extent and resolution will be used} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{n_visits}{a number indicating the average number of visits} \item{replace}{a logical indicating whether to sample with replacement} } \value{ -A simple feature collection with geometry type POINTs +An updated simulation object with the newly calculated effort in the correct slot } \description{ Simulates a uniform effort } \examples{ \dontrun{ -sim_effort_uniform(state,100,T) +sim_effort_uniform(simulation_object, 100, FALSE) } } diff --git a/man/sim_report_equal.Rd b/man/sim_report_equal.Rd index 3dec832..43e3347 100644 --- a/man/sim_report_equal.Rd +++ b/man/sim_report_equal.Rd @@ -4,39 +4,23 @@ \alias{sim_report_equal} \title{Simulates reporting where all reports occur at an equal probability and identified correctly} \usage{ -sim_report_equal( - background, - state_env, - state_target, - effort, - detect, - prob = 1, - platform = "iRecord" -) +sim_report_equal(simulation_object, prob = 1, platform = "iRecord") } \arguments{ -\item{background}{the background} - -\item{state_env}{description} - -\item{state_target}{a SpatRaster for the true state to be detected from, and from which the extent and resolution will be used} - -\item{effort}{effort} - -\item{detect}{a sf of sampled points} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{prob}{a numeric probability of each target being reported} \item{platform}{name of the recording platform} } \value{ -A simple feature collection with geometry type POINTs +An updated simulation object with the newly calculated report in the correct slot } \description{ Simulates reporting where all reports occur at an equal probability and identified correctly } \examples{ \dontrun{ -sim_report_equal(state,detections,0.5) +sim_report_equal(simulation_object, 0.5, "iRecord") } } diff --git a/man/sim_state_env_NLMR.Rd b/man/sim_state_env_NLMR.Rd index 18dc368..f2dbd06 100644 --- a/man/sim_state_env_NLMR.Rd +++ b/man/sim_state_env_NLMR.Rd @@ -4,23 +4,23 @@ \alias{sim_state_env_NLMR} \title{Simulates a state of the environment using a wrapper around NLMR functions} \usage{ -sim_state_env_NLMR(background, alg, params = NULL) +sim_state_env_NLMR(simulation_object, alg, params = NULL) } \arguments{ -\item{background}{a SpatRaster from which the extent and resolution will be used} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{alg}{single or list of algorithms as character} \item{params}{list of vectors providing parameters to be passed to each NMLR function call} } \value{ -A SpatRaster with extent and resolution of background but values describing the environment +An updated simulation object with the newly calculated state of the environment in the correct slot } \description{ Simulates a state of the environment using a wrapper around NLMR functions } \examples{ \dontrun{ -sim_state_env_NLMR(terra::rast(nrows=100,ncols=100),"random") +sim_state_env_NLMR(simulation_object, "random") } } diff --git a/man/sim_state_env_gradient.Rd b/man/sim_state_env_gradient.Rd index 3b0e3f1..b88e153 100644 --- a/man/sim_state_env_gradient.Rd +++ b/man/sim_state_env_gradient.Rd @@ -4,23 +4,23 @@ \alias{sim_state_env_gradient} \title{Simulates a uniform state of the environment} \usage{ -sim_state_env_gradient(background, from = 0, to = 1) +sim_state_env_gradient(simulation_object, from = 0, to = 1) } \arguments{ -\item{background}{a SpatRaster from which the extent and resolution will be used} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{from}{lower value of gradient} \item{to}{upper value of gradient} } \value{ -A SpatRaster with extent and resolution of background but values from abundance +An updated simulation object with the newly calculated state of the environment in the correct slot } \description{ Simulates a uniform state of the environment } \examples{ \dontrun{ -sim_state_env_gradient(terra::rast(nrows=100,ncols=100)) +sim_state_env_gradient(simulation_object, 0, 1) } } diff --git a/man/sim_state_env_uniform.Rd b/man/sim_state_env_uniform.Rd index 91ba315..e8a376b 100644 --- a/man/sim_state_env_uniform.Rd +++ b/man/sim_state_env_uniform.Rd @@ -4,21 +4,21 @@ \alias{sim_state_env_uniform} \title{Simulates a uniform state of the environment} \usage{ -sim_state_env_uniform(background, value = 0) +sim_state_env_uniform(simulation_object, value = 0) } \arguments{ -\item{background}{a SpatRaster from which the extent and resolution will be used} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{value}{the value for the SpatRaster} } \value{ -A SpatRaster with extent and resolution of background but values from abundance +An updated simulation object with the newly calculated state of the environment in the correct slot } \description{ Simulates a uniform state of the environment } \examples{ \dontrun{ -sim_state_env_uniform(terra::rast(nrows=100,ncols=100)) +sim_state_env_uniform(simulation_object, 0) } } diff --git a/man/sim_state_state_NLMR.Rd b/man/sim_state_state_NLMR.Rd index 7668a8e..cd82d5e 100644 --- a/man/sim_state_state_NLMR.Rd +++ b/man/sim_state_state_NLMR.Rd @@ -4,18 +4,10 @@ \alias{sim_state_state_NLMR} \title{Simulates a state of the target using a wrapper around sim_state_env_NLMR} \usage{ -sim_state_state_NLMR( - background, - state_env = NULL, - alg, - params = NULL, - abundance = 1 -) +sim_state_state_NLMR(simulation_object, alg, params = NULL, abundance = 1) } \arguments{ -\item{background}{a SpatRaster from which the extent and resolution will be used} - -\item{state_env}{State of the environment} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{alg}{single or list of algorithms as character} @@ -24,7 +16,7 @@ sim_state_state_NLMR( \item{abundance}{Abundance of species} } \value{ -A SpatRaster with extent and resolution of background but values describing the environment +An updated simulation object with the newly calculated state of the target in the correct slot } \description{ Simulates a state of the target using a wrapper around sim_state_env_NLMR diff --git a/man/sim_state_target_uniform.Rd b/man/sim_state_target_uniform.Rd index 44db050..f4c92ca 100644 --- a/man/sim_state_target_uniform.Rd +++ b/man/sim_state_target_uniform.Rd @@ -4,23 +4,21 @@ \alias{sim_state_target_uniform} \title{Simulates a uniform state of the target} \usage{ -sim_state_target_uniform(background, state_env = NULL, abundance = 10) +sim_state_target_uniform(simulation_object, abundance = 10) } \arguments{ -\item{background}{a SpatRaster from which the extent and resolution will be used} - -\item{state_env}{a SpatRaster for the environmental sate} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{abundance}{a number indicating the abundance of the target in each cell} } \value{ -A SpatRaster with extent and resolution of background but values from abundance +An updated simulation object with the newly calculated state of the target in the correct slot } \description{ Simulates a uniform state of the target } \examples{ \dontrun{ -sim_state_target_uniform(background = terra::rast(nrows=100,ncols=100),abundance = 42) +sim_state_target_uniform(simulation_object, 42) } } diff --git a/man/sim_state_target_virtualspecies.Rd b/man/sim_state_target_virtualspecies.Rd index 0392bcc..7e668f3 100644 --- a/man/sim_state_target_virtualspecies.Rd +++ b/man/sim_state_target_virtualspecies.Rd @@ -5,26 +5,23 @@ \title{Simulates a state of the target using a wrapper around virtualspecies functions} \usage{ sim_state_target_virtualspecies( - background, - environment, + simulation_object, n_targets = 1, prop_env = 1, params = NULL ) } \arguments{ -\item{background}{a SpatRaster from which the extent and resolution will be used} - -\item{environment}{a SpatRaster from which the extent and resolution will be used} +\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} \item{n_targets}{numeric for the number of targets to generate} -\item{prop_env}{numeric between 0 and 1 for proportion of environmental variables to be randomly used for each virtual species} +\item{prop_env}{numeric between 0 and 1 for the proportion of environmental variables to be randomly used for each virtual species} \item{params}{list of vectors providing parameters to be passed to each NMLR function call} } \value{ -A SpatRaster with extent and resolution of background but values describing the environment +An updated simulation object with the newly calculated state of the target in the correct slot } \description{ Simulates a state of the target using a wrapper around virtualspecies functions diff --git a/tests/testthat/test-simulation_basic.R b/tests/testthat/test-simulation_basic.R index d4f25c0..c252ac0 100644 --- a/tests/testthat/test-simulation_basic.R +++ b/tests/testthat/test-simulation_basic.R @@ -1,50 +1,52 @@ library(STRIDER) -# create background -background <- terra::rast(matrix(0,1000,1000)) +# Create the background +background <- terra::rast(matrix(0,1000,600)) -#simulate a uniform state of the environment across the background -state_env <- sim_state_env_uniform(background) +# 1 Create the simulation object +sim_obj <- SimulationObject(background = background) -test_that("Test creating a uniform environment", { - expect_true(is(state_env, "SpatRaster")) - expect_equal(dim(background),dim(state_env)) -}) +# 2 Simulate a uniform state of the target across the background within the simulation object +sim_obj <- sim_state_target_uniform(sim_obj, abundance = 42) +# 3 Simulate effort across the landscape within the simulation object +sim_obj <- sim_effort_uniform(sim_obj, n_visits = 100, replace = FALSE) -#simulate a uniform state of the target across the background -state_target <- sim_state_target_uniform(background,state_env,42) +# 4 Simulate detection within the simulation object +sim_obj <- sim_detect_equal(sim_obj, prob = 0.5) -test_that("Creating a uniform target distribution", { - expect_true(is(state_target, "SpatRaster")) - expect_equal(dim(background),dim(state_target)) -}) +# 5 Simulate reporting within the simulation object +sim_obj <- sim_report_equal(sim_obj, prob = 0.8, platform = "iRecord") -#simulate effort across the landscape -effort <- sim_effort_uniform(background,state_env,state_target,n_visits=100,replace=F) - -test_that("Simulating effort across the landscape", { - expect_true(is(effort, "sf")) - expect_equal(nrow(effort),100) +#1 +test_that("Test creating a uniform environment", { + expect_true(class(sim_obj) == "SimulationObject") + expect_true(class(sim_obj@background) == "SpatRaster") + expect_equal(dim(sim_obj@background), dim(sim_obj@background)) }) +#2 +test_that("Creating a uniform target distribution", { + expect_true(class(sim_obj@state_target) == "SpatRaster") + expect_equal(dim(sim_obj@background), dim(sim_obj@state_target)) +}) -# simulate detection -detections <-sim_detect_equal(background,state_env,state_target,effort,prob=0.5) +#3 +test_that("Simulating effort across the landscape", { + expect_identical(class(sim_obj@effort), c("sf","data.frame")) + expect_equal(nrow(sim_obj@effort), 100) +}) +#4 test_that("Simulating detection", { - expect_true(is(detections, "sf")) - expect_equal(nrow(detections),nrow(effort)) + expect_identical(class(sim_obj@detect), c("sf","data.frame")) + expect_equal(nrow(sim_obj@detect), nrow(sim_obj@effort)) }) -# simulate reporting -reports <- sim_report_equal(background,state_env,state_target,effort,detections,prob=0.8,platform="iRecord") - +#5 test_that("Simulating reporting", { - expect_true(is(reports, "sf")) - expect_equal(nrow(reports),nrow(detections)) + expect_identical(class(sim_obj@report), c("sf","data.frame")) + expect_equal(nrow(sim_obj@report), nrow(sim_obj@detect)) }) - - diff --git a/vignettes/example_NLMR_virtualspecies.Rmd b/vignettes/example_NLMR_virtualspecies.Rmd index 55ad236..71e95f1 100644 --- a/vignettes/example_NLMR_virtualspecies.Rmd +++ b/vignettes/example_NLMR_virtualspecies.Rmd @@ -31,11 +31,11 @@ set.seed(42) First we create a background SpatRaster from which to use the extent, resolution, and CRS. ```{r state, eval = F} -# create background -background <- rast(matrix(0,1000,1000)) +# Create the simulation object +sim_obj <- SimulationObject(background = rast(matrix(0, 1000, 1000))) #simulate a uniform state of the environment across the background (although in this example we don't actually use it) -state_env <- sim_state_env_NLMR(background, +sim_obj <- sim_state_env_NLMR(sim_obj, c("mpd","mpd","mpd","random"), list( list(roughness=0.5), @@ -45,52 +45,53 @@ state_env <- sim_state_env_NLMR(background, ) ) -plot(sim_state_env) +plot(sim_obj@state_env) -#simulate a uniform state of the target across the background -state_target <- sim_state_target_virtualspecies(background,state_env,n_targets = 3) +# Simulate a uniform state of the target across the background +sim_obj <- sim_state_target_virtualspecies(sim_obj, n_targets = 3) #plot the state -plot(state_target) +plot(sim_obj@state_target) ``` Next we simulate effort across the landscape ```{r effort, eval = F} -#simulate effort across the landscape -effort <- sim_effort_uniform(state_target,n_visits=100,replace=F) +# Simulate effort across the landscape +sim_obj <- sim_effort_uniform(sim_obj, n_visits = 100, replace = FALSE) + +# Add the sampled locations to the plot +plot(sim_obj@effort$geometry) -#add the sampled locations to the plot -plot(effort$geometry) ``` Next we simulate detections and identifications ```{r detections, eval = F} -#simulate detection and identification -detections <-sim_detect_equal(state_target,effort,prob=0.5) +# Simulate detection and identification +sim_obj <- sim_detect_equal(sim_obj, prob = 0.5) -#plot the non-detections -plot(detections$geometry[detections$detected==F],col="red",pch=4) +# Plot the non-detections +plot(sim_obj@detect$geometry[sim_obj@detect$detected == FALSE], col = "red", pch = 4) ``` We then simulate whether these detections made are reported ```{r reporting, eval = F} -# simulate reporting -reports <- sim_report_equal(state_target,detections,prob=0.8,platform="iRecord") +# Simulate reporting +sim_obj <- sim_report_equal(sim_obj, prob = 0.8, platform = "iRecord") -# colour reported records to yellow -plot(reports$geometry[reports$reported],col="yellow") +# Color reported records as yellow +plot(sim_obj@report$geometry[sim_obj@report$reported], col = "yellow") ``` And we're done. let's have a look at all the objects we have created ```{r review, eval = F} -print(state_env) -print(state_target) -print(effort) -print(detections) -print(reports) +print(sim_obj@state_env) +print(sim_obj@state_target) +print(sim_obj@effort) +print(sim_obj@detect) +print(sim_obj@report) ``` diff --git a/vignettes/example_minimal.Rmd b/vignettes/example_minimal.Rmd index 3169bc2..94b29ab 100644 --- a/vignettes/example_minimal.Rmd +++ b/vignettes/example_minimal.Rmd @@ -25,60 +25,60 @@ library(sf) set.seed(42) ``` -First we create a background SpatRaster from which to use the extent, resolution, and CRS. +First, we create a SimulationObject and set up the background SpatRaster from which we use the extent, resolution, and CRS. ```{r state} -# create background -background <- rast(matrix(0,1000,1000)) +# Create the simulation object +sim_obj <- SimulationObject(background = rast(matrix(0, 1000, 1000))) -#simulate a uniform state of the environment across the background -state_env <- sim_state_env_uniform(background) +# Simulate a uniform state of the environment across the background +sim_obj <- sim_state_env_uniform(sim_obj) -#simulate a uniform state of the target across the background -state_target <- sim_state_target_uniform(background,state_env,42) +# Simulate a uniform state of the target across the background +sim_obj <- sim_state_target_uniform(sim_obj, abundance = 42) -#plot the state -plot(state_target) +# Plot the state +plot(sim_obj@state_target) ``` Next we simulate effort across the landscape ```{r effort} -#simulate effort across the landscape -effort <- sim_effort_uniform(background, state_env, state_target, n_visits=100,replace=F) +# Simulate effort across the landscape +sim_obj <- sim_effort_uniform(sim_obj, n_visits = 100, replace = FALSE) + +# Add the sampled locations to the plot +plot(sim_obj@effort$geometry) -#add the sampled locations to the plot -plot(effort$geometry) ``` Next we simulate detections and identifications ```{r detections} -#simulate detection and identification -detections <-sim_detect_equal(background, state_env, state_target, effort,prob=0.5) - -#plot the non-detections -plot(detections$geometry[detections$detected==F],col="red",pch=4) +# Simulate detection and identification +sim_obj <- sim_detect_equal(sim_obj, prob = 0.5) +# Plot the non-detections +plot(sim_obj@detect$geometry[sim_obj@detect$detected == FALSE], col = "red", pch = 4) ``` We then simulate whether these detections make are reported ```{r reporting} -# simulate reporting -reports <- sim_report_equal(background, state_env, state_target, effort,detections,prob=0.8,platform="iRecord") +# Simulate reporting +sim_obj <- sim_report_equal(sim_obj, prob = 0.8, platform = "iRecord") -# colour reported records to yellow -plot(reports$geometry[reports$reported],col="yellow") +# Color reported records as yellow +plot(sim_obj@report$geometry[sim_obj@report$reported], col = "yellow") ``` And we're done. let's have a look at all the objects we have created ```{r review} -print(state_env) -print(state_target) -print(effort) -print(detections) -print(reports) +print(sim_obj@state_env) +print(sim_obj@state_target) +print(sim_obj@effort) +print(sim_obj@detect) +print(sim_obj@report) ```