From 3182e52ff33e8ba349d15ac0961cddb0ae759901 Mon Sep 17 00:00:00 2001 From: Simon Rolph Date: Wed, 3 Jul 2024 16:30:12 +0100 Subject: [PATCH] Plotting function for simualtionobject class, new and improve roxygen comments for functions, including basic included functions. Move extract() call inside sim_effort() rather than the supplied custom function. Vignette under development. --- DESCRIPTION | 2 +- R/SimulationObjectClass.R | 36 +++++ R/basic_functions.R | 156 ++++++++++++++++++---- R/sim_effort.R | 41 ++++-- R/sim_state_env.R | 34 ++++- R/sim_state_target_realise.R | 30 ++++- R/sim_state_target_suitability.R | 39 ++++-- R/util.R | 16 +++ man/detect_equal.Rd | 24 ++++ man/effort_basic.Rd | 39 ++++++ man/export_df.Rd | 22 +++ man/report_equal.Rd | 26 ++++ man/sim_effort.Rd | 16 ++- man/sim_state_env.Rd | 32 ++++- man/sim_state_target_realise.Rd | 27 ++-- man/sim_state_target_suitability.Rd | 27 ++-- man/state_env_gradient.Rd | 26 ++++ man/state_env_uniform.Rd | 24 ++++ man/state_target_realise_binomial.Rd | 22 +++ man/state_target_realise_threshold.Rd | 24 ++++ man/state_target_suitability_uniform.Rd | 26 ++++ man/state_target_suitability_virtsp.Rd | 30 +++++ tests/testthat/Rplots.pdf | Bin 0 -> 16671 bytes tests/testthat/test-hashing.R | 2 +- tests/testthat/test-simulation_basic.R | 6 +- tests/testthat/test-simulation_fun.R | 2 +- vignettes/example_minimal.Rmd | 169 +++++++++++++++++++++++- 27 files changed, 798 insertions(+), 100 deletions(-) create mode 100644 man/detect_equal.Rd create mode 100644 man/effort_basic.Rd create mode 100644 man/export_df.Rd create mode 100644 man/report_equal.Rd create mode 100644 man/state_env_gradient.Rd create mode 100644 man/state_env_uniform.Rd create mode 100644 man/state_target_realise_binomial.Rd create mode 100644 man/state_target_realise_threshold.Rd create mode 100644 man/state_target_suitability_uniform.Rd create mode 100644 man/state_target_suitability_virtsp.Rd create mode 100644 tests/testthat/Rplots.pdf diff --git a/DESCRIPTION b/DESCRIPTION index d3e0673..e28609d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,7 +13,7 @@ Suggests: rmarkdown, testthat (>= 3.0.0) VignetteBuilder: knitr -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 Imports: terra, sf diff --git a/R/SimulationObjectClass.R b/R/SimulationObjectClass.R index 22ca9d0..880b0d1 100644 --- a/R/SimulationObjectClass.R +++ b/R/SimulationObjectClass.R @@ -38,3 +38,39 @@ SimulationObject <- function(background, state_env = NULL, state_target_suitabil hash = hash_sim_obj(tmp) ) } + +setMethod("plot", "SimulationObject", function(x) { + x <- read_sim_obj_rasters(x) + + if(!is.null(x@state_env)){ + plot(x@state_env, + main = paste("@state_env ",names(x@state_env))) + } + + if(!is.null(x@state_target_suitability)){ + plot(x@state_target_suitability, + main = paste("@state_target_suitability ",names(x@state_target_suitability))) + } + + if(!is.null(x@state_target_realised)){ + plot(x@state_target_realised, + main = paste("@state_target_realised ",names(x@state_target_realised))) + } + + if(!is.null(x@effort)){ + plot(x@background, main="@effort",legend = F,col = "white") + plot(x@effort$geometry,add=T) + } + + if(!is.null(x@detect)){ + plot(x@background, main="@detect",legend = F,col = "white") + plot(x@detect[x@detect$state_detected>0,c("geometry","state_detected")],col = "blue",add=T,pch=19) + plot(x@detect[x@detect$state_detected==0,c("geometry","state_detected")],col = "red",pch = 4,add=T) + } + + if(!is.null(x@report)){ + plot(x@background, main="@report",legend = F,col = "white") + plot(x@report[x@report$reported==T,c("geometry")],col = "blue",add=T,pch=19) + plot(x@detect[x@report$reported==F,c("geometry")],col = "red",pch = 4,add=T) + } +}) diff --git a/R/basic_functions.R b/R/basic_functions.R index 0cd6756..0889519 100644 --- a/R/basic_functions.R +++ b/R/basic_functions.R @@ -1,3 +1,15 @@ +#' Create a Gradient SpatRaster for Environmental State +#' +#' @param simulation_object A SimulationObject containing the background layer. +#' @param from The starting value of the gradient. Default is 0. +#' @param to The ending value of the gradient. Default is 1. +#' +#' @return A SpatRaster representing the gradient environmental state. +#' @examples +#' \dontrun{ +#' sim_state <- state_env_gradient(simulation_object, from = 0, to = 1) +#' } +#' @export state_env_gradient <- function(simulation_object, from = 0, to = 1) { #create the gradient spatraster background <- simulation_object@background @@ -7,6 +19,17 @@ state_env_gradient <- function(simulation_object, from = 0, to = 1) { sim_state } +#' Create a Uniform SpatRaster for Environmental State +#' +#' @param simulation_object A SimulationObject containing the background layer. +#' @param value The value to fill the raster with. Default is 1. +#' +#' @return A SpatRaster representing the uniform environmental state. +#' @examples +#' \dontrun{ +#' sim_state <- state_env_uniform(simulation_object, value = 1) +#' } +#' @export state_env_uniform <- function(simulation_object, value = 1) { #create the gradient spatraster background <- simulation_object@background @@ -16,7 +39,18 @@ state_env_uniform <- function(simulation_object, value = 1) { sim_state } - +#' Create a Uniform Suitability SpatRaster for Target State +#' +#' @param simulation_object A SimulationObject containing the background layer. +#' @param value The value to fill the raster with. Default is 0.5. +#' @param n_targets The number of target layers. Default is 1. +#' +#' @return A SpatRaster representing the uniform suitability for target state. +#' @examples +#' \dontrun{ +#' sim_state <- state_target_suitability_uniform(simulation_object, value = 0.5, n_targets = 2) +#' } +#' @export state_target_suitability_uniform <- function(simulation_object,value = 0.5,n_targets=1){ background <- simulation_object@background @@ -28,6 +62,18 @@ 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) @@ -77,7 +123,16 @@ state_target_suitability_virtsp <- function(simulation_object, n_targets = 1, pa return(simulation_object_original) } - +#' Realize Target Suitability Using Binomial Distribution +#' +#' @param simulation_object A SimulationObject containing the target suitability layers. +#' +#' @return A SpatRaster with realized target states as binary values. +#' @examples +#' \dontrun{ +#' binary_state <- state_target_realise_binomial(simulation_object) +#' } +#' @export state_target_realise_binomial <- function(simulation_object){ state_target <- binary_state_target <- simulation_object@state_target_suitability for (i in 1:dim(state_target)[3]){ @@ -92,7 +147,17 @@ state_target_realise_binomial <- function(simulation_object){ binary_state_target } - +#' Realize Target Suitability Using Threshold +#' +#' @param simulation_object A SimulationObject containing the target suitability layers. +#' @param threshold A numeric value specifying the threshold for realization. +#' +#' @return A SpatRaster with realized target states as binary values based on the threshold. +#' @examples +#' \dontrun{ +#' binary_state <- state_target_realise_threshold(simulation_object, threshold = 0.5) +#' } +#' @export state_target_realise_threshold <- function(simulation_object,threshold){ state_target <- binary_state_target <- simulation_object@state_target_suitability for (i in 1:dim(state_target)[3]){ @@ -108,14 +173,39 @@ state_target_realise_threshold <- function(simulation_object,threshold){ } - -effort_uniform <- function(simulation_object, n_samplers = 1, n_visits = 1, n_sample_units=1, replace = FALSE) { +#' Generate Sampling Effort Points +#' +#' @param simulation_object A SimulationObject containing the target suitability layers. +#' @param n_samplers The number of samplers. Default is 1. +#' @param n_visits The number of visits per sampler. Default is 1. +#' @param n_sample_units The number of sample units per visit. Default is 1. +#' @param replace A logical value indicating whether sampling with replacement is allowed. Default is FALSE. +#' @param prob_raster A SpatRaster providing the probability of sampling each cell. Default is NULL. +#' +#' @return An sf object containing the sampling effort points. +#' @examples +#' \dontrun{ +#' effort <- effort_basic(simulation_object, n_samplers = 2, n_visits = 3) +#' } +#' @export +effort_basic <- function(simulation_object, n_samplers = 1, n_visits = 1, n_sample_units=1, replace = FALSE,prob_raster = NULL) { #which cells are visited state_target <- simulation_object@state_target_suitability - visited_cells <- rep(sample(terra::cells(state_target), size = n_samplers*n_visits, replace = replace),each = n_sample_units) - # capture data + if (is.null(prob_raster)){ + prob <- NULL + } else { + prob <- terra::values(prob_raster) + } + visited_cells <- rep(sample(terra::cells(state_target), + size = n_samplers*n_visits, + replace = replace, + prob = prob + ), + each = n_sample_units) + + # capture sampling meta data (who, when, etc.) sim_effort_points <- as.data.frame(terra::xyFromCell(state_target, visited_cells)) sim_effort_points$sampler <- rep(1:n_samplers,each = n_visits*n_sample_units) sim_effort_points$visit <- rep(1:n_visits,n_samplers,each = n_sample_units) @@ -125,22 +215,23 @@ effort_uniform <- function(simulation_object, n_samplers = 1, n_visits = 1, n_sa effort_sf <- sf::st_as_sf(sim_effort_points, coords = c("x", "y"), crs = terra::crs(state_target)) - #get values from env, suitability, realised - extracted_values <- terra::extract(simulation_object@state_env,effort_sf$cell_id) - effort_sf[,names(extracted_values)] <- extracted_values - extracted_values <- terra::extract(simulation_object@state_target_suitability,effort_sf$cell_id) - effort_sf[,paste0("suit_",names(extracted_values))] <- extracted_values - extracted_values <- terra::extract(simulation_object@state_target_realised,effort_sf$cell_id) - effort_sf[,paste0("real_",names(extracted_values))] <- extracted_values - effort_sf - } - -detect_equal <- function(simulation_object, prob = 0.5) { +#' Detect Presence/Absence Based on Equal Probability +#' +#' @param simulation_object A SimulationObject containing the realized target states and sampling effort points. +#' @param prob The detection probability. Default is 1. +#' +#' @return A data frame containing the detection results. +#' @examples +#' \dontrun{ +#' detections <- detect_equal(simulation_object, prob = 0.8) +#' } +#' @export +detect_equal <- function(simulation_object, prob = 1) { background <- simulation_object@background state_env <- simulation_object@state_env @@ -164,11 +255,14 @@ detect_equal <- function(simulation_object, prob = 0.5) { detections$state_realised <- unname(terra::extract(state_target[[i]], effort,ID=F,raw=T)) #detect based probability value provided as argument - detections$detected <- detections$state_realised * (runif(nrow(detections)) < prob) + detections$detection_ability <- runif(nrow(detections)) < prob + + #recorded presence/absense + detections$state_detected <- detections$detection_ability * detections$state_realised - #in this basic example all are identified correctly - detections$identified_as <- detections$target - detections$identified_correct <- detections$identified_as==detections$target + #in this basic example all are identified correctly (ignore for now) + # detections$identified_as <- detections$target + # detections$identified_correct <- detections$identified_as==detections$target detections_all <- rbind(detections_all, detections) } @@ -177,15 +271,23 @@ detect_equal <- function(simulation_object, prob = 0.5) { detections_all } - -report_equal <- function(simulation_object, prob = 1, platform = "iRecord") { +#' Report Detections Based on Reporting Probability +#' +#' @param simulation_object A SimulationObject containing the detection results. +#' @param prob The reporting probability. Default is 1. +#' @param platform The platform used for reporting. Default is "None". +#' +#' @return A data frame containing the reporting results. +#' @examples +#' \dontrun{ +#' reports <- report_equal(simulation_object, prob = 0.8, platform = "Online") +#' } +#' @export +report_equal <- function(simulation_object, prob = 1, platform = "None") { detect <- simulation_object@detect reports <- detect reports$reported <- runif(nrow(reports)) < prob - - reports$reported[reports$detected == FALSE] <- FALSE - reports$platform <- platform reports diff --git a/R/sim_effort.R b/R/sim_effort.R index 8a2b596..c2a17c8 100644 --- a/R/sim_effort.R +++ b/R/sim_effort.R @@ -1,32 +1,47 @@ -#' Defines effort using a custom function +#' Defines effort using a built-in function, a custom function, or sf POINTS #' -#' @param simulation_object a SimulationObject -#' @param fun a function that takes the simulation object and returns a simulation object with data in effort slot -#' @param ... other parameters for the user supplied function fun -#' @return A SimulationObject with a state_target_realised +#' This function applies a user-supplied function to a SimulationObject to define effort. +#' +#' @param simulation_object A SimulationObject containing simulation data. +#' @param fun A function that takes the simulation_object and additional parameters, and returns a modified simulation_object with effort data. +#' @param sf Optional; if provided, skips applying 'fun' and directly uses this Spatial*DataFrame (sf) for effort calculation. +#' @param ... Additional parameters passed to the user-supplied function 'fun'. +#' @return A SimulationObject with updated effort information. #' @examples #' \dontrun{ #' sim_effort(simulation_object, fun, ...) #' } -sim_effort <- function(simulation_object, fun, ...) { +#' @export +sim_effort <- function(simulation_object, fun, sf=NULL, ...) { simulation_object_original <- simulation_object simulation_object <- read_sim_obj_rasters(simulation_object) - if(is.character(fun)){ - if(!(fun %in% c("uniform"))){ - stop("Provided function must be 'uniform'") + if (is.null(sf)){ + if(is.character(fun)){ + if(!(fun %in% c("basic"))){ + stop("Provided function must be 'basic'") + } + fun <- get(paste0("effort_",fun)) } - fun <- get(paste0("effort_",fun)) + # apply the function + effort_sf <- fun(simulation_object, ...) + } else { + effort_sf <- sf } - # apply the function - effort <- fun(simulation_object, ...) + #get values from env, suitability, realised + extracted_values <- terra::extract(simulation_object@state_env,effort_sf) + effort_sf[,names(extracted_values)] <- extracted_values + extracted_values <- terra::extract(simulation_object@state_target_suitability,effort_sf) + effort_sf[,paste0("suit_",names(extracted_values))] <- extracted_values + extracted_values <- terra::extract(simulation_object@state_target_realised,effort_sf) + effort_sf[,paste0("real_",names(extracted_values))] <- extracted_values # validity checks fun_args <- as.list(match.call()) simulation_object_original@metadata[["effort"]] <- fun_args[3:length(fun_args)] - simulation_object_original@effort <- effort + simulation_object_original@effort <- effort_sf simulation_object_original@hash <- hash_sim_obj(simulation_object_original) simulation_object_original } diff --git a/R/sim_state_env.R b/R/sim_state_env.R index e61c8c2..7c25a27 100644 --- a/R/sim_state_env.R +++ b/R/sim_state_env.R @@ -1,14 +1,36 @@ -#' The state of the environment +#' Define the state of the environment +#' +#' This function updates the state environment of a given simulation object by +#' either using a provided SpatRaster, a predefined function (`gradient` or `uniform`), +#' or a user-defined function. The updated simulation object with the new state environment +#' and metadata is returned. +#' +#' @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 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`. #' -#' @param simulation_object an R object of class 'SimulationObject' containing all the necessary information for the simulation -#' @param fun either a function to be used, or a name of a provided function -#' @param filename a file name and path to save the spatraster -#' @param spatraster a SpatRaster to be used as the environment #' @return An updated simulation object with the newly added state of the environment in the correct slot +#' +#' @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_state_env(simulation_object, fun = "uniform",value=1) +#' 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, 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") #' } +#' +#' @export sim_state_env <- function(simulation_object, fun= NULL, filename = NULL, spatraster=NULL, ...) { #load in rasters but create a copy with the original version diff --git a/R/sim_state_target_realise.R b/R/sim_state_target_realise.R index e068470..dfb3759 100644 --- a/R/sim_state_target_realise.R +++ b/R/sim_state_target_realise.R @@ -1,14 +1,30 @@ -#' Realizes the state_target into binary or abundance using a custom function +#' Realizes the State Target into Binary or Abundance +#' +#' This function realizes the state target for a given simulation object into either +#' binary (presence/absence) or abundance using a predefined or a custom function. +#' 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 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. #' -#' @param simulation_object a SimulationObject -#' @param fun either 'uniform' to use the included uniform suitability function or a function that takes an SimulationObject with an environment slot and outputs a SimulationObject with a target suitability SpatRaster with either a presence/absence or an abundance -#' @param filename a file name and path to save the spatraster -#' @param ... other parameters for the user supplied function fun -#' @return A SimulationObject with a state_target_realised #' @examples #' \dontrun{ -#' sim_state_target_realise(simulation_object, fun, ...) +#' 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 = 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, ...) { simulation_object_original <- simulation_object simulation_object <- read_sim_obj_rasters(simulation_object) diff --git a/R/sim_state_target_suitability.R b/R/sim_state_target_suitability.R index e5d4a47..0cbb450 100644 --- a/R/sim_state_target_suitability.R +++ b/R/sim_state_target_suitability.R @@ -1,23 +1,42 @@ -#' Determines the state_target_suitability from state_env using a custom function +#' Determine the Target Suitability from the State Environment +#' +#' This function calculates the state target suitability for a given simulation object +#' using either a predefined or a custom function. The updated simulation object with the +#' new state target suitability and metadata is returned. +#' +#' @param simulation_object A SimulationObject +#' @param fun Either 'uniform' to use the included uniform suitability function or a custom function that takes a SimulationObject with an environment slot and outputs a target suitability SpatRaster with as many bands as there are targets +#' @param filename A character string specifying the filename to save the resultant SpatRaster. If `NULL`, the SpatRaster is not saved to a file. +#' @param ... Additional arguments to be passed to the function specified in `fun`. +#' +#' @return The updated simulation object with the new state target suitability. +#' +#' @details +#' - If `fun` is provided as 'uniform', the function uses the included uniform suitability function. This is unlikely to be a useful function but provided as a baseline. +#' - If `fun` is a character string corresponding to a function name, the function checks its existence and retrieves it. +#' - 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. #' -#' @param simulation_object a SimulationObject -#' @param fun either 'uniform' to use the included uniform suitability function or a function that takes an SimulationObject with an environment slot and outputs a SimulationObject with a target suitability SpatRaster with values from 0 to 1 -#' @param filename a file name and path to save the spatraster -#' @param ... other parameters for the user supplied function fun -#' @return A SimulationObject with a state_target_realised #' @examples #' \dontrun{ -#' sim_state_target_suitability(simulation_object, fun, ...) +#' sim_obj <- sim_state_target_suitability(sim_obj, fun = "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, ...) { simulation_object_original <- simulation_object simulation_object <- read_sim_obj_rasters(simulation_object) if(is.character(fun)){ - if(!(fun %in% c("uniform"))){ - stop("Provided function must be 'uniform'") + if(exists(fun)){ + fun <- get(fun) + } else if((fun %in% c("uniform"))) { + fun <- get(paste0("state_target_suitability_",fun)) + } else { + stop("Function not found") } - fun <- get(paste0("state_target_suitability_",fun)) } # apply the function diff --git a/R/util.R b/R/util.R index 50d2bc0..2454522 100644 --- a/R/util.R +++ b/R/util.R @@ -59,3 +59,19 @@ hash_sim_obj <- function(sim_obj){ digest::digest(sim_obj) } + +#' Export Simulation Report Data Frame +#' +#' This function exports the report data frame from a SimulationObject. +#' +#' @param sim_obj A SimulationObject containing the report data frame. +#' +#' @return A data frame containing the report from the SimulationObject. +#' @examples +#' \dontrun{ +#' report_df <- export_df(simulation_object) +#' } +#' @export +export_df <- function(sim_obj){ + sim_obj@report +} diff --git a/man/detect_equal.Rd b/man/detect_equal.Rd new file mode 100644 index 0000000..78fad0c --- /dev/null +++ b/man/detect_equal.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{detect_equal} +\alias{detect_equal} +\title{Detect Presence/Absence Based on Equal Probability} +\usage{ +detect_equal(simulation_object, prob = 1) +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the realized target states and sampling effort points.} + +\item{prob}{The detection probability. Default is 1.} +} +\value{ +A data frame containing the detection results. +} +\description{ +Detect Presence/Absence Based on Equal Probability +} +\examples{ +\dontrun{ +detections <- detect_equal(simulation_object, prob = 0.8) +} +} diff --git a/man/effort_basic.Rd b/man/effort_basic.Rd new file mode 100644 index 0000000..7f73f68 --- /dev/null +++ b/man/effort_basic.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{effort_basic} +\alias{effort_basic} +\title{Generate Sampling Effort Points} +\usage{ +effort_basic( + simulation_object, + n_samplers = 1, + n_visits = 1, + n_sample_units = 1, + replace = FALSE, + prob_raster = NULL +) +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the target suitability layers.} + +\item{n_samplers}{The number of samplers. Default is 1.} + +\item{n_visits}{The number of visits per sampler. Default is 1.} + +\item{n_sample_units}{The number of sample units per visit. Default is 1.} + +\item{replace}{A logical value indicating whether sampling with replacement is allowed. Default is FALSE.} + +\item{prob_raster}{A SpatRaster providing the probability of sampling each cell. Default is NULL.} +} +\value{ +An sf object containing the sampling effort points. +} +\description{ +Generate Sampling Effort Points +} +\examples{ +\dontrun{ +effort <- effort_basic(simulation_object, n_samplers = 2, n_visits = 3) +} +} diff --git a/man/export_df.Rd b/man/export_df.Rd new file mode 100644 index 0000000..3d70f0d --- /dev/null +++ b/man/export_df.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/util.R +\name{export_df} +\alias{export_df} +\title{Export Simulation Report Data Frame} +\usage{ +export_df(sim_obj) +} +\arguments{ +\item{sim_obj}{A SimulationObject containing the report data frame.} +} +\value{ +A data frame containing the report from the SimulationObject. +} +\description{ +This function exports the report data frame from a SimulationObject. +} +\examples{ +\dontrun{ +report_df <- export_df(simulation_object) +} +} diff --git a/man/report_equal.Rd b/man/report_equal.Rd new file mode 100644 index 0000000..ca46863 --- /dev/null +++ b/man/report_equal.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{report_equal} +\alias{report_equal} +\title{Report Detections Based on Reporting Probability} +\usage{ +report_equal(simulation_object, prob = 1, platform = "None") +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the detection results.} + +\item{prob}{The reporting probability. Default is 1.} + +\item{platform}{The platform used for reporting. Default is "None".} +} +\value{ +A data frame containing the reporting results. +} +\description{ +Report Detections Based on Reporting Probability +} +\examples{ +\dontrun{ +reports <- report_equal(simulation_object, prob = 0.8, platform = "Online") +} +} diff --git a/man/sim_effort.Rd b/man/sim_effort.Rd index 13288af..c0a563f 100644 --- a/man/sim_effort.Rd +++ b/man/sim_effort.Rd @@ -2,22 +2,24 @@ % Please edit documentation in R/sim_effort.R \name{sim_effort} \alias{sim_effort} -\title{Defines effort using a custom function} +\title{Defines effort using a built-in function, a custom function, or sf POINTS} \usage{ -sim_effort(simulation_object, fun, ...) +sim_effort(simulation_object, fun, sf = NULL, ...) } \arguments{ -\item{simulation_object}{a SimulationObject} +\item{simulation_object}{A SimulationObject containing simulation data.} + +\item{fun}{A function that takes the simulation_object and additional parameters, and returns a modified simulation_object with effort data.} -\item{fun}{a function that takes the simulation object and returns a simulation object with data in effort slot} +\item{sf}{Optional; if provided, skips applying 'fun' and directly uses this Spatial*DataFrame (sf) for effort calculation.} -\item{...}{other parameters for the user supplied function fun} +\item{...}{Additional parameters passed to the user-supplied function 'fun'.} } \value{ -A SimulationObject with a state_target_realised +A SimulationObject with updated effort information. } \description{ -Defines effort using a custom function +This function applies a user-supplied function to a SimulationObject to define effort. } \examples{ \dontrun{ diff --git a/man/sim_state_env.Rd b/man/sim_state_env.Rd index c8dcec9..90bba5f 100644 --- a/man/sim_state_env.Rd +++ b/man/sim_state_env.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/sim_state_env.R \name{sim_state_env} \alias{sim_state_env} -\title{The state of the environment} +\title{Define the state of the environment} \usage{ sim_state_env( simulation_object, @@ -13,22 +13,40 @@ sim_state_env( ) } \arguments{ -\item{simulation_object}{an R object of class 'SimulationObject' containing all the necessary information for the simulation} +\item{simulation_object}{An object representing the simulation. The object should contain +a `background` slot and a `state_env` slot.} -\item{fun}{either a function to be used, or a name of a provided function} +\item{fun}{A character string specifying the name of a predefined function (`"gradient"` or `"uniform"`) or a user-defined function.} -\item{filename}{a file name and path to save the spatraster} +\item{filename}{A character string specifying the filename to save the resultant SpatRaster. If `NULL`, the SpatRaster is not saved to a file.} -\item{spatraster}{a SpatRaster to be used as the environment} +\item{spatraster}{A `SpatRaster` object to be used directly as the state environment. If provided, it overrides the `fun` parameter.} + +\item{...}{Additional arguments to be passed to the function specified in `fun`.} } \value{ An updated simulation object with the newly added state of the environment in the correct slot } \description{ -The state of the environment +This function updates the state environment of a given simulation object by +either using a provided SpatRaster, a predefined function (`gradient` or `uniform`), +or a user-defined function. The updated simulation object with the new state environment +and metadata is returned. +} +\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_state_env(simulation_object, fun = "uniform",value=1) +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, 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") } + } diff --git a/man/sim_state_target_realise.Rd b/man/sim_state_target_realise.Rd index ad9b44d..a09a209 100644 --- a/man/sim_state_target_realise.Rd +++ b/man/sim_state_target_realise.Rd @@ -2,27 +2,38 @@ % Please edit documentation in R/sim_state_target_realise.R \name{sim_state_target_realise} \alias{sim_state_target_realise} -\title{Realizes the state_target into binary or abundance using a custom function} +\title{Realizes the State Target into Binary or Abundance} \usage{ sim_state_target_realise(simulation_object, fun, filename = NULL, ...) } \arguments{ -\item{simulation_object}{a SimulationObject} +\item{simulation_object}{A SimulationObject containing the state environment.} -\item{fun}{either 'uniform' to use the included uniform suitability function or a function that takes an SimulationObject with an environment slot and outputs a SimulationObject with a target suitability SpatRaster with either a presence/absence or an abundance} +\item{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.} -\item{filename}{a file name and path to save the spatraster} +\item{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`.} -\item{...}{other parameters for the user supplied function fun} +\item{...}{Additional arguments to be passed to the function specified in `fun`.} } \value{ -A SimulationObject with a state_target_realised +The updated simulation object with the new state target realization. } \description{ -Realizes the state_target into binary or abundance using a custom function +This function realizes the state target for a given simulation object into either +binary (presence/absence) or abundance using a predefined or a custom function. +The updated simulation object with the new state target realization and metadata is returned. +} +\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_state_target_realise(simulation_object, fun, ...) +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 = my_custom_function) +sim_obj <- sim_state_target_realise(sim_obj, fun = my_custom_function, filename = "output.tif") } + } diff --git a/man/sim_state_target_suitability.Rd b/man/sim_state_target_suitability.Rd index e8ca465..521da98 100644 --- a/man/sim_state_target_suitability.Rd +++ b/man/sim_state_target_suitability.Rd @@ -2,27 +2,38 @@ % Please edit documentation in R/sim_state_target_suitability.R \name{sim_state_target_suitability} \alias{sim_state_target_suitability} -\title{Determines the state_target_suitability from state_env using a custom function} +\title{Determine the Target Suitability from the State Environment} \usage{ sim_state_target_suitability(simulation_object, fun, filename = NULL, ...) } \arguments{ -\item{simulation_object}{a SimulationObject} +\item{simulation_object}{A SimulationObject} -\item{fun}{either 'uniform' to use the included uniform suitability function or a function that takes an SimulationObject with an environment slot and outputs a SimulationObject with a target suitability SpatRaster with values from 0 to 1} +\item{fun}{Either 'uniform' to use the included uniform suitability function or a custom function that takes a SimulationObject with an environment slot and outputs a target suitability SpatRaster with as many bands as there are targets} -\item{filename}{a file name and path to save the spatraster} +\item{filename}{A character string specifying the filename to save the resultant SpatRaster. If `NULL`, the SpatRaster is not saved to a file.} -\item{...}{other parameters for the user supplied function fun} +\item{...}{Additional arguments to be passed to the function specified in `fun`.} } \value{ -A SimulationObject with a state_target_realised +The updated simulation object with the new state target suitability. } \description{ -Determines the state_target_suitability from state_env using a custom function +This function calculates the state target suitability for a given simulation object +using either a predefined or a custom function. The updated simulation object with the +new state target suitability and metadata is returned. +} +\details{ +- If `fun` is provided as 'uniform', the function uses the included uniform suitability function. This is unlikely to be a useful function but provided as a baseline. +- If `fun` is a character string corresponding to a function name, the function checks its existence and retrieves it. +- 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_state_target_suitability(simulation_object, fun, ...) +sim_obj <- sim_state_target_suitability(sim_obj, fun = "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") } + } diff --git a/man/state_env_gradient.Rd b/man/state_env_gradient.Rd new file mode 100644 index 0000000..f838d22 --- /dev/null +++ b/man/state_env_gradient.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{state_env_gradient} +\alias{state_env_gradient} +\title{Create a Gradient SpatRaster for Environmental State} +\usage{ +state_env_gradient(simulation_object, from = 0, to = 1) +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the background layer.} + +\item{from}{The starting value of the gradient. Default is 0.} + +\item{to}{The ending value of the gradient. Default is 1.} +} +\value{ +A SpatRaster representing the gradient environmental state. +} +\description{ +Create a Gradient SpatRaster for Environmental State +} +\examples{ +\dontrun{ +sim_state <- state_env_gradient(simulation_object, from = 0, to = 1) +} +} diff --git a/man/state_env_uniform.Rd b/man/state_env_uniform.Rd new file mode 100644 index 0000000..ed24d2d --- /dev/null +++ b/man/state_env_uniform.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{state_env_uniform} +\alias{state_env_uniform} +\title{Create a Uniform SpatRaster for Environmental State} +\usage{ +state_env_uniform(simulation_object, value = 1) +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the background layer.} + +\item{value}{The value to fill the raster with. Default is 1.} +} +\value{ +A SpatRaster representing the uniform environmental state. +} +\description{ +Create a Uniform SpatRaster for Environmental State +} +\examples{ +\dontrun{ +sim_state <- state_env_uniform(simulation_object, value = 1) +} +} diff --git a/man/state_target_realise_binomial.Rd b/man/state_target_realise_binomial.Rd new file mode 100644 index 0000000..c8c9d3d --- /dev/null +++ b/man/state_target_realise_binomial.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{state_target_realise_binomial} +\alias{state_target_realise_binomial} +\title{Realize Target Suitability Using Binomial Distribution} +\usage{ +state_target_realise_binomial(simulation_object) +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the target suitability layers.} +} +\value{ +A SpatRaster with realized target states as binary values. +} +\description{ +Realize Target Suitability Using Binomial Distribution +} +\examples{ +\dontrun{ +binary_state <- state_target_realise_binomial(simulation_object) +} +} diff --git a/man/state_target_realise_threshold.Rd b/man/state_target_realise_threshold.Rd new file mode 100644 index 0000000..6f3f48f --- /dev/null +++ b/man/state_target_realise_threshold.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{state_target_realise_threshold} +\alias{state_target_realise_threshold} +\title{Realize Target Suitability Using Threshold} +\usage{ +state_target_realise_threshold(simulation_object, threshold) +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the target suitability layers.} + +\item{threshold}{A numeric value specifying the threshold for realization.} +} +\value{ +A SpatRaster with realized target states as binary values based on the threshold. +} +\description{ +Realize Target Suitability Using Threshold +} +\examples{ +\dontrun{ +binary_state <- state_target_realise_threshold(simulation_object, threshold = 0.5) +} +} diff --git a/man/state_target_suitability_uniform.Rd b/man/state_target_suitability_uniform.Rd new file mode 100644 index 0000000..a1fad25 --- /dev/null +++ b/man/state_target_suitability_uniform.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{state_target_suitability_uniform} +\alias{state_target_suitability_uniform} +\title{Create a Uniform Suitability SpatRaster for Target State} +\usage{ +state_target_suitability_uniform(simulation_object, value = 0.5, n_targets = 1) +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the background layer.} + +\item{value}{The value to fill the raster with. Default is 0.5.} + +\item{n_targets}{The number of target layers. Default is 1.} +} +\value{ +A SpatRaster representing the uniform suitability for target state. +} +\description{ +Create a Uniform Suitability SpatRaster for Target State +} +\examples{ +\dontrun{ +sim_state <- state_target_suitability_uniform(simulation_object, value = 0.5, n_targets = 2) +} +} diff --git a/man/state_target_suitability_virtsp.Rd b/man/state_target_suitability_virtsp.Rd new file mode 100644 index 0000000..29b69e8 --- /dev/null +++ b/man/state_target_suitability_virtsp.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/basic_functions.R +\name{state_target_suitability_virtsp} +\alias{state_target_suitability_virtsp} +\title{Create Virtual Species Suitability SpatRaster for Target State} +\usage{ +state_target_suitability_virtsp( + simulation_object, + n_targets = 1, + params = NULL +) +} +\arguments{ +\item{simulation_object}{A SimulationObject containing the background and environmental layers.} + +\item{n_targets}{The number of target layers. Default is 1.} + +\item{params}{A list of parameters for generating virtual species. Default is NULL.} +} +\value{ +A SimulationObject with updated target suitability layers. +} +\description{ +Create Virtual Species Suitability SpatRaster for Target State +} +\examples{ +\dontrun{ +sim_object <- state_target_suitability_virtsp(simulation_object, n_targets = 2) +} +} diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000000000000000000000000000000000000..08e8c74bee29a65f733e4de8a6d03985470b3496 GIT binary patch literal 16671 zcmeHu2T+vF(k?kHl9S{GL4v{t*d5*3f`uU>P$*Q49{|!o+5YW! z`be}Brk5^I#ofx)0cqm_)bd2TdZIDiwB1p*o;C<~?6)F9B0^vc?N}BHOX3GyxBx)7 z*kWe^{e3n-kiM@g0tiyDLR&eZ?13O{D|>_oP#D9Y3;d&l=r0|xd{}OGgbVryJ4gZL zg2psGfMUnpLAnSJl&8B5W;~If#=|oFrjAPp7kjh=5C#_mf|QX?Xv_jY%1#*FC?af7 zwg~LBJWjD>&9pUL{ajx%NzcJr6cSXMvc8#SoKJh686p$tQ+mBir_AxgPL0nv z>+7TPnWD5}s)Gq#Rc-MyTvZb^bE@>E4|J&+K127zTa$u&TTRq9tp%CnZLXHom_6a< zY%_UMOeNV}SJ?c~z2swzuzt)6{mjd?dWPDLW@VM_8iqr;^tEqxUt$igOub-ibCP+z z!uD>S%+#%|M^oG6C_}8|L%j!||IPE`_)nBb9L8n&o^jnGRTTkCnCT>KF9eidY=kxY ziqz!Nndy{m^3BSAa@8QEsC&dmXq2RzCY|3zKbQMB&~Uhi!p)Ct&pN;vNvU~{d{+km z>(P^y)O}~8Tl{W0j&3i?7&#Hxe0zqSRwb@Ko*vUS4bSY3IV?83p#(ECdX739HVE{S zkD!;kH%K5M9}MFxkY6KZG9++5v)D@uI8v#Q)===y&DJ4*T6CTzZzewv&Du8NG-`h* zuAGnD0o6+_7E2)fZg;D-=(^I<&8b0B@&MSk=>mrriY#)HE@q>vH0JYZ-!g`t_ld9i zH*-`{nCn`1>n4CVyv9vEZHXU9yvTSVb|D~eEO3my;N_uKJ^ps_fTTn6gEj$Tfl+~P zmg*ITGrW5D-|b^|{f`~=WB-eP-+n;M+X(#a4KUWSzKXCxV+nem*68E6Ld_Yo%dr$A zq%CHPih{w|hAIMS?|=r1h#a>RP);a!Jy$Cm1Q3SZiQqJe)%1B>7A z--B7Qe=#T!@b3rOZ}#Nh9*_{MKcEZzHz(vV$4^J3C>;E+?Z%(2Mzf)Y77K)`?$D?c zBL3QExumY%pqG;V(H#daH(3&$R70RVp_;+Yl=tqyq_a9ajeuff5iu3Ja&LY|L5wg= z(udA|okTT(&LK$?Hv*5U`e;KW(!+;ORb9YbukBR5@TF2& zgK0@0Qd|}`h0sxndk`%^k-~QcE$_F0YiZZ)lxF6+;_evc-+t)VDsiS<%f|ED$V;VM zk>Tx|N}aY5NU$??r$#v^d4(x~e?m)sf zJ@=_Eq0;*7&HGICt6CXBwZrx!ZhxaH zGU&{PSziVVH~|;a^~;#g5SYBISc|`BU9*xCFK|!slMfSG z2X~Qmu`XJPhs8H%u{=dvF7L^y5+AiWyp&*-IUmL6h&iuCc0V z-f6M5cM)DzQe$(B4KGY%KbE_jWJ)KoC04ACIvSPhIx&hSm_L}-*t6pZPJ3)U_{cbz z*TjUJNFxwkZOND?+A*|qHL$!Uka=qlS6QY7{N6k7^WxRdOJ1H|c6Psd?GRhC;kKrL zC7l^-$FvPr76F=116Ir^ziF?0^(8J5Hz=c`_x7gD+55;@mX~u@-afD@2J8^|jzqz( z>L%ENe2@C9ZBqaNQgmG9RzCjcs0sl_o&2_y4wFkoilJwk*GW~o6hmnN;mH{euJRl8 zbG*#yRm@+L^8<4mNt^E`XJM#rk1^EoUD`CQJ$b$qf#u#Rj5K zE!HdAlOJk;7RmMvvye(@nA#Cx*tM&Vetjc<__!x${6AzWPsE;R;J;D>e|yGbK{4h; zKCvkOm5=pg(kB}DhcxiF76p4P_T9(-&rrkh1;f8Z4Oot!Q3DL}KSB*V*Qw-h87hSV zXdVSMlwPUuPCILr_>$A2ZaJ+)dh10X$^3O!O05~ZOdPcYytsb;m)f{oMi(;Y*V)+5 zB_ya1g;vyDGgg{Aljqd6#Z4tfs%5TM0`5OoWlj=1$~$Ci^KfeD(PP;no`~J%w)ybj zy@qBb@mjHr8;Nt3S`S=n=@9V}S0sf{9L;SiU3xu%vefp45dbcGAsll~XWUZ4*um3w zdoxW>)L-!T8zT+aZ(N->w!gpY`(#oY?s}W=CakuVi{bf8sk;_bSkypS0V3Juj_U}W zSZy?MOS#0ptmiuMrSwzks#Z_^X2aww4maQCnQ9x(%&j#G%R5Ig3ncE;I~dg9gL8}; zxXQrP7}P+M6Mh4O8t#$^Uc#b=Hw=9PicM7uaKb+RqNk?E|NteY$(l_$k9r{l~?GpB~V~M<>@ZRxiTsLhcX4ut&=qcaTbSS z0I!U|%8At4H}6DtaxLlvobHoZ_9o3I7kY~ORhmsa`S`XlZ5|TDYPs!kiZ)O*wfJe) zyeMTu@|NUvPn6p=!qP35oU|^HJ1#;~%dg&cuS~P1W}tQ{-s$md^}6nPQ=-9p*=*$H zlr`&3Uqa<1$7N4Lo7loOu2zMDb55@URcqfxy&YhAY%Yjs4OLD@dNAYlpOLP&mg2>f!isF35Ci3{=l=I7>Cj20(bl|OWw`zu~;q20!>U;%z|wEsi4@kH#22L6jR@V7_% zkBHd`Sokk~xF=IT(ZK(@2L9Hf{1G$%&%gpU$ocO>3_rr4$4Lpl1t-D(K@@(%s7;eq z?o{2L(co=y%d1yhsBLv_(cA#*QbY|9P(&%o-aiU7t0=4?QYzw<6OUEiUSHmGGD>k| z%G11~Bf97&p?9<0?u|+2q{{l2rBCVsMtgV4ST@|C>a(pRZKv_o3cDt3W%KebP<(1L zzO7|Fc(aRH9vPq4<1JSgbhrCq$m|Y!`)FmLWK2p6M%3!qGvDWHQ;pwTf%wogRP5*Y$DEwsHl70>M$mm4W79ca@t)6f8W!F?7QqKE9km8uS~N)n_LMMDo4Sk2yyY1ysu2}a zIfOC9^pRznmn+f6<(saHMMtsTz0NmC0{4xo&mk|dneeNT=~Eji3&D)hoV%p+w(OpZ zk|6wyoyY3Olp00J;krnhzS}PNeR7>r$#$fc&oce|X2Wwek;?juy7Y>lUHO;BzqAYs z<{(*eM>-i|2=(j)CyydV!lEYJW3DV(uNY1oiY8C*Q@#4q-KU+3n`lBWweQDT>qkts ztsp1cMgPo7ea|kcR1-&uM}P${BRN+gZB>Vf>W)WrN+I=x@sdT-+J-Fu?T@XFj~h%E zHkaL2H9k(h^f(m+9a@6sk(b~Xz53W1!TfyzA^c8nt=*9ET~VXywV(5a`rjb})`o=WB|%~6|@oVviA{ZJ8s&+d0Ygl%%f`DS~z zE)Oruedb~3p&H`3ER6=-VNPelUyuy+MpQ)ewnr*hGyTG#t`uVX%oW#_?xnc4&DHHJKquS}dwHbA7O86!S3@!~8@n&})f zEyqre9eGY!aLkpr4=2CYnduOvM9$58y?I4wXe02^g^?@%lN>T2Mj6vn0s9x{*yGp< zoWpJzJyH?E%M%0D4Vq?^Vf^dDZO_ud$+yt)2&y0iP%9>o!0!}ckur3JA|=* z2i57o{O1#z3LPY-A+wJsI8t(hqWp)xt!YeGamP-Ep4`LOv-6yY5kB!RbuMIl=8y3w(W4P z?xM4Q`M|6+7lB`jOG&nLE&*=Plfo}U&APP@vzdE%=u$7lpUaA<;N0wTs<^9r?m1E; zMCzI_SH)|W+4K|#QQx2`(3E?euTu{XO_L*LjGV$ptqW&8ynGy{iPh?2p%OHbz2oI> z*YefQMO_m%J%9R@mopz4cmt)}`EkVAY?EdseXqkmCB4yZEWEj|Pz2xo$t(38LR{s> z9v+jcxG;v{$2S9#7);URw~TV1<5pHuYDDf?y{m&h)W6Y2)E42HX6AVCvCq^9MKcH; z?h7$%VBhV2zmGTSPooA;n)fA*7eeBqhQ#UsK{j=EH3w`k+L3XG}7&@1+TuGaIj#;%Ohc5v7Yvdh_0?{Y$~{HtSo>uqHvx|$f5+V zMu}8#`Lba6CE9TAsY`dHgUp{Mf5WNuUJCuy*!;86)f30%pE-I?q@HNt|6c=t;YV*Y%uO@Mr_S%7{|%rwVTM4&t|iQ6zBNCRPu zw30{p08O#j3I-Oz{+j=(IO2~e?r{x85IE`Gv8~{?r6i8r@ z8Aurlg#L)-DhmUl*yz)7wFOAY2d$!q#@2;k=8nng1pUZL{{iRJoWa23YaMI?xtcQs z2sw7SzPF%2$Z^@m_m(gaay;z!mIx4Xyy)*O81NV-9;d3SIm3a_@BOgy{*=v*)t-m0 ziv0JqcI<30KN!1>_1}IAGn<0c6cpsGJP@|PV`=8UG5iRq9X|p&Y)yv?c2OWjgcs5V zfgKd2iK!a-EhQcb6NmpxC-5)%@EOV8`g)@bkv(;yb=nD3(Mi3I4!U@%%62^r-dgx&;Yittupdo^@zBtpWZCBR&LB^duv>lYq-JK>v zG~5rOn9iE%MZ_i2#=P(8(U^~E?gUea#+{jgjND_o%=+FP$FAq-GM%q8({nD#5ixNw zu(P0ZJ>OuE`B7TJo>#I(SkNkyBFBEyu2JAUa-3%ci1N{cNM|HHj`ENpDP?6H@k?N<;V|OSUbp~2vWFmtw*rhCTq^Qn(nk^3CPUp?6wsE@eoqd-YYiX8=)fR~cXP2bQ)5#E!JkloKp z-KT8&dVjP!`Nr5jb#JmUUOp$YY#=)hp8z$G)Zg}8?^*y^iwgedu9&`icQX!qLcRtV zRbBe}hJiaM-bO_cT1BJNy_|Yvf+qsRQIf@9lx11Kr+rCK@shdCGSHb&unUuP`K-9bg<2|h#0X@aEB$qIIb?3BJ(=`I-paQ zDlGgB6}@gG8mRDw^?A7QEtU`XgbLK!tVtw13i7IW^s-CYx(`_&M=a*pEtoFwp_yxN z$Q3HHbsT68=>3S#fJqA)O`cIZ5tdqNiIK#IF*dfXL&Z3RLMmV0amBwzwHl_?lrl|i z43G(aKz*HxS|T?FOwI60S^l;UHz_q|;Vqi`cu3i?TkQ8as-snJKX_wGN2H_#(Y};K z*3Lm6K9ifAW0(Wad#ppOo$>I(pur&DRlp9lhO%RBS6}x64*I+VQ$~!CvQc(gFWW-t z0`<1o0XC6HgV;3HFBk`VtPR{NwpSB*}S#hv4PlEzD5~H zA`_p*$wwPY`ZP>cUcgE)C!tqa>|)hLA31KCohZ%MuDRE%B8=6f6s5FSdFpv|RPDIo z{K4Fu&YUZ}8C(-wb-=_nWm`&jsmqrpG%{x z8Hwm`>zh5fTWp-;qv)o(@rcHvP4!06YaNq({XDe(r-=SCsKKbRxW2f8Z>f9CCgGe4 z-TCII8HM*c(R_z|_Ix(_VUM*CdewuTgUXAS7sbdGgbN6Jb&>gHD2LE8e){O>4D~Yg zO!c^SH+p`y9F{)(g-_ei1FHki14#ox11*F4#j`{3p>vOmhdw^^eYi2CJ~%d{JUIDC zcrajaV6gI$_oJx+S>#=0nB#}5%Y9;n8)ypW_zu?9^aSz9`SIZ}SeM8d5hI7y0oLC1 z;r`*xf%g8#{StXQ`e{#Baxxy*DIA9F-ls5V)lkVURhYluZ4&`#O1$0u&~_VAfQET~ z@#Lx5sR^wS_G|Ie@eB7`@!Q)bJvje``wQDa-GLsF1Q90@AyE-gCHY3g`6jw1^N24I z#c{E5*0J!@o=nnELtzSVx2OxO-ccUzCVJVf-_pH{&ZZrzAw1#iH+l+QDtZx82w{On zcCmF5eyr_^6zpZtWRQ;`ieb4#Gmv<%$q5l}(k~b)NG4c&KI<}*akHs&>0;%9gEK0_ zWx^q#HNu+KLC;~pW~;F1p5WVxmfbP4O|z-$!g;Tr02h0g*2;G_-UFFeIjkER>)(D2 z4b2OElhb9@-}e&IS2Dao6w?B*akk6wmY4JuFY=Q3xIH}DczOBS$Y(~zf{UpaV> zuYbJ$NVfImo!|hu``LtYLvoZMT_H-1(wwfUmTz`%)ozi`lg)dFhxA_WUCG&d72A{? z9>5V#N=a5s8g$x%#zdZUp+T66fE3H1QNv*0j zMb<_w7SRJyw68r|ZD#Xk(`Ftp9-JSqc9m+pkR$f~fNNICH%93EuyK0*{yt4JPdbkZ zP2Ua34Z$00;yLL=-P`@w^UE(jsB&5rTBXe-MiHYD*4jbyTHMuV@9;{idudE&O5K~u z)V;l_|B^wUEc3y^gW>#oO)`ylS-bqwXX~W#Q*PgN(^sV~AU%YZ3vWRqOFK)WOYe82 zr>vO4c>pvpgu-ad^V(*S(VoHUuN9wLKvQRv^%A$vic0LMX1ZsBQI^%Cn;IRwn*m!5 z7QrTs=6$Bwrq3!Y(fRZ32L`>5^9%iqmWqW;r0ZKyUBTsHwbDVk%I}P6tFTESDWaBdu>H%@QV}D-fL2RSa7M~)Sviw5Z%1Ea&=Gn#P z7fqPVM$Hl0<>iY3p6WZQaYh>cMRqF%V{dDHYm1jRMg|NY7#NxCxfENjb@??MbQ9%8 zLuXsvx4sweY^@rsb=~jwzp@ zfr%EULezuG6n4Bw?nw5awEdNxCb>xeo6q9Q0_^wAor%ly?$a)sO^OfQ>E~IAUt+(& z>{C|Rn*U(dzhiBWV?f%_!)(rHl=Rh&T-q$nk6Gy#?szVK`t)JIrtYHOTKWxXk0Q_u z)Vfpe=+^wTo{Ud>%QC)`J4YpC-Hh=Tw&u$6fiD&~KU+12bt`V2d8g8PHh>o- zW3lgZq&A#*??JQ7xo>8NogYTM8+?wSV0uZ|SF`P-f#S3)4;x0l^{*n<&?DPljF^h; zEK*+R1bIvgE;)azz3WXYT)kGZc24GQ;KJwA+Z(G7VzsgY@%O^E4u8E>__J^Rz0z69 z1yfawbitH5WBt}YT1H40ITsJ)Zv+5H5ou?Kz?3&*>z7S|A~29M(#6vQX#OWR_}Gd6 zYXax7i~mOjDOM&X{ZiA)8RPw8-2P*s-+5FKPF@H!(#8q^`b{Vh`W=k?;b<8%bI}HNIV28iZ zAW*m{W)(ltM8zx<~oWJma!BFvEY2w1a^o4?jF-YXEeW4I6 z*87Pj4#R-EztTj&uwVMZAn;%0!k{8QuNMpl!!da4uj7eAM1R&5SPY7}{r-thO!!wF zhzpDSyfz3}4Ee_@}-wagjgG5AAM+bV9fvgE~E= u9|E&qFfi1`4h6(?Jihryq0qo%NctVPS-GQ+cNPQ=hCu;5JW5*1fd2!*42|gk literal 0 HcmV?d00001 diff --git a/tests/testthat/test-hashing.R b/tests/testthat/test-hashing.R index 86d0640..1b27233 100644 --- a/tests/testthat/test-hashing.R +++ b/tests/testthat/test-hashing.R @@ -51,7 +51,7 @@ test_that("Testing hashing at environment suitability simulation - Ensure that t expect_false(sim_obj2_bin@hash == sim_obj3_bin@hash) }) -sim_obj1_effort <- sim_effort(sim_obj1_thresh,fun="uniform",n_samplers = 10) +sim_obj1_effort <- sim_effort(sim_obj1_thresh,fun="basic",n_samplers = 10) test_that("Ensure that the hash changes after effort simulation",{ expect_false(sim_obj1_thresh@hash == sim_obj1_effort@hash) diff --git a/tests/testthat/test-simulation_basic.R b/tests/testthat/test-simulation_basic.R index 3128687..79b124e 100644 --- a/tests/testthat/test-simulation_basic.R +++ b/tests/testthat/test-simulation_basic.R @@ -1,4 +1,6 @@ library(STRIDER) +library(sf) +library(terra) # Create the background background <- terra::rast(matrix(0,440,700)) @@ -17,7 +19,7 @@ sim_obj <- sim_state_target_realise(sim_obj,fun = "threshold",threshold = 0.5) sim_state_target_realise(sim_obj, fun = "binomial") # 3 Simulate effort across the landscape within the simulation object -sim_obj <- sim_effort(sim_obj,fun="uniform", n_samplers = 2, n_visits = 3, n_sample_units=2, replace = FALSE) +sim_obj <- sim_effort(sim_obj,fun="basic", n_samplers = 2, n_visits = 3, n_sample_units=2, replace = FALSE) # 4 Simulate detection within the simulation object sim_obj <- sim_detect(sim_obj,fun="equal", prob = 0.5) @@ -25,7 +27,7 @@ sim_obj <- sim_detect(sim_obj,fun="equal", prob = 0.5) # 5 Simulate reporting within the simulation object sim_obj <- sim_report(sim_obj, fun="equal", prob = 0.8, platform = "iRecord") -#print(sim_obj) +plot(sim_obj) #1 test_that("Test creating a uniform environment", { diff --git a/tests/testthat/test-simulation_fun.R b/tests/testthat/test-simulation_fun.R index 200d4da..52d922a 100644 --- a/tests/testthat/test-simulation_fun.R +++ b/tests/testthat/test-simulation_fun.R @@ -36,7 +36,7 @@ realise_fun <- function(sim_obj){ sim_obj <- sim_state_target_realise(sim_obj,fun = realise_fun) # 3 Simulate effort across the landscape within the simulation object -sim_obj <- sim_effort(sim_obj,fun="uniform", n_samplers = 2, n_visits = 3, n_sample_units=2, replace = FALSE) +sim_obj <- sim_effort(sim_obj,fun="basic", n_samplers = 2, n_visits = 3, n_sample_units=2, replace = FALSE) # 4 Simulate detection within the simulation object sim_obj <- sim_detect(sim_obj,fun="equal", prob = 0.5) diff --git a/vignettes/example_minimal.Rmd b/vignettes/example_minimal.Rmd index bf8feec..8d445cd 100644 --- a/vignettes/example_minimal.Rmd +++ b/vignettes/example_minimal.Rmd @@ -14,14 +14,179 @@ knitr::opts_chunk$set( ) ``` -This is a basic example of how this package works. +This is an example showing how different sampling methods impact. -```{r setup, eval=F} +```{r setup} +# everything you need for STRIDER library(STRIDER) library(terra) library(sf) +#for general data wrangling and visualistion +library(dplyr) +library(ggplot2) + +#for model vaidation +library(caret) + #set a seed so it's reproducible set.seed(42) ``` +## Simulating data + +### Background + +The background is simply a SpatRaster from which the CRS/extent/resolution will be used for subsequent simulation steps. + +```{r} +dim_x <- 500 +dim_y <- 500 +background <- terra::rast(matrix(0,dim_x,dim_y)) +sim_obj <- SimulationObject(background = background) +``` + + +### Environmental state + +Here we want to represent the state of the environment. Essentially we need to capture variables (real or abstract) which influence where the target might exist. + +Here we define three variables: + + * Rainfall (ecological niche) + * Temperature (ecological niche) + * Urban density (factor affecting effort) + +```{r} +# Define an environmental state with two variables, env1 and env2 which create gradients perpendicular +env1 <- terra::rast(matrix(rep(seq(from = 1, to = dim_x),times = dim_y),dim_x,dim_y)) +env1 <- env1/max(values(env1)) +env2 <- terra::rast(matrix(rep(seq(from = 1, to = dim_x),times = dim_y),dim_x,dim_y,byrow = T)) +env2 <- env2/max(values(env2)) +env3 <- terra::rast(matrix(rep(seq(from = 1, to = dim_x),times = dim_y),dim_x,dim_y,byrow = T)) +env3 <- env3/max(values(env3)) +env <- c(env1,env2,env3) + +names(env) <- c("rainfall","temperature","urban_density") + +#slot it into the simulation object +sim_obj <- sim_state_env(sim_obj,spatraster = env) +``` + +### Target state + +Here we simulate the target + +```{r} +# Define a function to turn the environment into suitability +suitabiity_function <- function(sim_obj){ + out <- c(sim_obj@state_env$rainfall,sim_obj@state_env$temperature) + out <- mean(out) + names(out) <- "target" + out +} + +#apply function +sim_obj <- sim_state_target_suitability(sim_obj,fun = suitabiity_function) + +#realise +sim_obj <- sim_state_target_realise(sim_obj,fun="binomial") + + +``` + + +### Effort + +Simulate effort correlating with environment variable 2 + +```{r} +# alternative method of defining effort: add custom points +points_sf <- st_as_sf(data.frame(x = c(20,40,60),y = c(20,40,60)),coords = c("x", "y")) +sim_obj <- sim_effort(sim_obj, + sf = points_sf) + +#simulate effort, biased by urban density +sim_obj <- sim_effort(sim_obj, + fun = "basic", + n_samplers=500, + n_visits = 1, + n_sample_units = 1, + prob_raster = sim_obj@state_env$urban_density) + +``` + +### Detection + +```{r} +#detection 100% +sim_obj <- sim_detect(sim_obj,fun="equal",prob = 1) +``` + +### Reporting + +```{r} +#reporting 100% +sim_obj <- sim_report(sim_obj,fun="equal",prob = 1) +``` + +```{r} +#visualise the simulation object's components +plot(sim_obj) +``` + +## Visualising data + +```{r} +#load the data +df <- export_df(sim_obj) +``` + +## Statistical analysis + +Make a "biological recording" dataset with presence-only dataset (`po`) and a presence-absence dataset (`pa`) + +```{r} +data_pa <- df #presence absense +data_po <- df[df$state_detected==1,] #presense only +``` + +Generate some background samples to aid model fitting + +```{r} +po_background <- effort_basic(sim_obj,100) |> + extract(x=sim_obj@state_env,xy=T) |> + st_as_sf(coords=c("x","y")) |> + mutate(state_detected=0) + +data_po <- bind_rows(data_po,po_background) + +``` + +Combine dataset and fit models + +```{r} +fit_mod <- function(df){ + glm(state_detected~rainfall + temperature, data = df, family = binomial(link = "logit")) +} + +threshold = 0.5 + +# fit model to presence only data with background samples +mod_po <- fit_mod(data_po) +mod_po_predictions <- predict(sim_obj@state_env,mod_po,type = "response")>threshold + + +#Compare it to presence/absence data +mod_pa <- fit_mod(data_pa) +mod_pa_predictions <- predict(sim_obj@state_env,mod_pa,type = "response")>threshold +``` + +Compare model performance + +```{r} +plot((mod_po_predictions-sim_obj@state_target_realised)) +plot((mod_pa_predictions-sim_obj@state_target_realised)) +``` + +