Refactor to use s4 class 'simulation object' for all functions

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
+  )
+}

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)
 }

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)
 }

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)
 }

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,36 +36,39 @@ 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)]
 
     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)
 }

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)
+}

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)
+}

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)
 }

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)
+}