Merge pull request #15 from BiologicalRecordsCentre/dev

Dev

R/SimulationObjectClass.R

@@ -94,13 +94,7 @@ setMethod("plot", "SimulationObject", function(x) {
 
   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)
+    plot(x@detect[x@detect$target_detected>0,c("geometry","target_detected")],col = "blue",add=T,pch=19)
+    plot(x@detect[x@detect$target_detected==0,c("geometry","target_detected")],col = "red",pch = 4,add=T)
   }
 })

R/sim_detect.R

@@ -1,27 +1,25 @@
-#' Defines detection using a custom function
+#' Simulate Detection Process
 #'
-#' @param simulation_object a SimulationObject
-#' @param fun a function that takes the simulation object and returns a simulation object with  data in detection slot
-#' @param ... other parameters for the user supplied function fun
-#' @return A SimulationObject with a detection
-#' @examples
-#' \dontrun{
-#' sim_effort_fun(simulation_object, fun, ...)
-#' }
-sim_detect <- function(simulation_object, fun, ...) {
-  check_fun(fun)
+#' This function simulates the detection process in a biodiversity study using a specified function to extract the realised state.
+#'
+#' @param simulation_object A `SimulationObject` that contains the state of the environment, target, effort, and other relevant simulation information.
+#' @param realised_extract_fun A function to extract the realised state used in \code{\link[=sim_extract]{sim_extract()}}. The default is `mean`.
+#'
+#' @return A `SimulationObject` with the detection information added.
+sim_detect <- function(simulation_object, realised_extract_fun = mean) {
+  check_fun(realised_extract_fun)
 
   simulation_object_original <- simulation_object
   simulation_object <- read_sim_obj_rasters(simulation_object)
 
-  # apply the function
-  detections <- fun(simulation_object, ...)
+  extracted <- sim_extract(simulation_object,realised_extract_fun=realised_extract_fun)
+
 
   # validity checks
   fun_args <- as.list(match.call())
   simulation_object_original@metadata[["detect"]] <- fun_args[3:length(fun_args)]
 
-  simulation_object_original@detect <- detections
+  simulation_object_original@detect <- extracted
   simulation_object_original@hash <- hash_sim_obj(simulation_object_original)
   simulation_object_original
 }

R/sim_effort.R

@@ -24,31 +24,6 @@ sim_effort <- function(simulation_object, fun=NULL, sf=NULL, ...) {
     effort_sf <- sf
   }
 
-  #get values from env, suitability, realised
-  extracted_values <- terra::extract(simulation_object@state_env,effort_sf,ID=T)
-  effort_sf[,names(extracted_values)] <- extracted_values
-
-  #loop through each target
-  targets_sf <- list()
-  for (target in names(simulation_object@state_target_suitability)){
-    target_sf <- effort_sf
-    target_sf$target <- target
-
-    #extract suitability
-    extracted_values <- terra::extract(simulation_object@state_target_suitability[target],effort_sf,ID=F)
-
-    target_sf[,"target_suitability"] <- extracted_values
-
-    #extract realised
-    extracted_values <- terra::extract(simulation_object@state_target_realised[target],effort_sf,ID=F)
-    target_sf[,"target_realised"] <- extracted_values
-
-    targets_sf[[target]] <- target_sf
-  }
-
-  effort_sf <- do.call(rbind,targets_sf)
-  rownames(effort_sf) <- NULL
-
   # validity checks
   fun_args <- as.list(match.call())
   simulation_object_original@metadata[["effort"]] <- fun_args[3:length(fun_args)]

R/sim_extract.R

@@ -0,0 +1,54 @@
+#' Extract Environmental, Suitability, and Realised Values at Sampling Locations
+#'
+#' This function extracts values from the environmental state, target suitability, and realised target state
+#' at the locations defined by the sampling effort in a `SimulationObject`.
+#'
+#' @param simulation_object A `SimulationObject` containing the environmental state, target suitability,
+#'   realised target state, and sampling effort.
+#' @param fun fun argument passed to \link[terra]{extract} for extracting realised values.
+#' @param ... Additional arguments passed to \link[terra]{extract} for extracting realised values.
+#'
+#' @return A `SimulationObject` with updated `@effort` slot containing extracted values for environmental
+#'   state, target suitability, and realised target state at each sampling location.
+#'
+#' @details
+#' This function extracts the values from the environmental state (`@state_env`), target suitability
+#' (`@state_target_suitability`), and realised target state (`@state_target_realised`) at the sampling locations
+#' defined in the `@effort` slot of the input `SimulationObject`. The extracted values are added as columns to the `@effort` slot.
+#'
+#' @export
+sim_extract <- function(simulation_object,realised_extract_fun=mean) {
+  #get the effort
+  effort_sf <- simulation_object@effort
+
+  #get values from env, suitability, realised
+  extracted_values <- terra::extract(simulation_object@state_env,effort_sf,fun = mean)
+  effort_sf[,names(extracted_values)] <- extracted_values
+
+  #loop through each target
+  targets_sf <- list()
+  for (target in names(simulation_object@state_target_suitability)){
+    target_sf <- effort_sf
+    target_sf$target <- target
+
+    #extract suitability
+    extracted_values <- terra::extract(simulation_object@state_target_suitability[target],effort_sf,ID=F,fun = mean)
+    target_sf[,"target_suitability"] <- extracted_values
+
+    #target realised
+    extracted_values <- terra::extract(simulation_object@state_target_realised[target],effort_sf,ID=F,fun = mean)
+    target_sf[,"target_realised"] <- extracted_values
+
+    #extract realised
+    extracted_values <- terra::extract(simulation_object@state_target_realised[target],effort_sf,ID=F,fun = realised_extract_fun)
+    target_sf[,"target_detected"] <- extracted_values
+
+    targets_sf[[target]] <- target_sf
+  }
+
+  effort_sf <- do.call(rbind,targets_sf)
+  rownames(effort_sf) <- NULL
+
+  effort_sf_extracted <- effort_sf
+  effort_sf_extracted
+}

R/sim_report.R

@@ -1,26 +1,26 @@
-#' Defines reporting using a custom function
+#' #' Defines reporting using a custom function
+#' #'
+#' #' @param simulation_object a SimulationObject
+#' #' @param fun a function that takes the simulation object and returns a simulation object with  data in reporting slot
+#' #' @param ... other parameters for the user supplied function fun
+#' #' @return A SimulationObject with reporting
+#' #' @examples
+#' #' \dontrun{
+#' #' sim_report_fun(simulation_object, fun, ...)
+#' #' }
+#' sim_report <- function(simulation_object, fun, ...) {
+#'   check_fun(fun)
+#'   simulation_object_original <- simulation_object
+#'   simulation_object <- read_sim_obj_rasters(simulation_object)
 #'
-#' @param simulation_object a SimulationObject
-#' @param fun a function that takes the simulation object and returns a simulation object with  data in reporting slot
-#' @param ... other parameters for the user supplied function fun
-#' @return A SimulationObject with reporting
-#' @examples
-#' \dontrun{
-#' sim_report_fun(simulation_object, fun, ...)
+#'   # apply the function
+#'   report <- fun(simulation_object, ...)
+#'
+#'   # validity checks
+#'   fun_args <- as.list(match.call())
+#'   simulation_object_original@metadata[["report"]] <- fun_args[3:length(fun_args)]
+#'
+#'   simulation_object_original@report <- report
+#'   simulation_object_original@hash <- hash_sim_obj(simulation_object_original)
+#'   simulation_object_original
 #' }
-sim_report <- function(simulation_object, fun, ...) {
-  check_fun(fun)
-  simulation_object_original <- simulation_object
-  simulation_object <- read_sim_obj_rasters(simulation_object)
-
-  # apply the function
-  report <- fun(simulation_object, ...)
-
-  # validity checks
-  fun_args <- as.list(match.call())
-  simulation_object_original@metadata[["report"]] <- fun_args[3:length(fun_args)]
-
-  simulation_object_original@report <- report
-  simulation_object_original@hash <- hash_sim_obj(simulation_object_original)
-  simulation_object_original
-}

R/util.R

@@ -98,7 +98,7 @@ hash_sim_obj <- function(sim_obj){
 #' }
 #' @export
 export_df <- function(sim_obj){
-  sim_obj@report
+  sim_obj@detect
 }
 
 

README.Rmd

@@ -67,7 +67,6 @@ The `simulation_object` includes the following components:
 - `@state_target_realised`: Simulated state of the target (as a realised absolute/binary value)
 - `@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.
 
@@ -78,7 +77,6 @@ The functions used at each stage are as follows:
  * `sim_state_target_realise(simulation_object, ...)`
  * `sim_effort(simulation_object, ...)`
  * `sim_detect(simulation_object, ...)`
- * `sim_report(simulation_object, ...)`
 
 You could use the `targets` R package to create reproducible workflows for simulating your data.
 
@@ -188,10 +186,6 @@ The function for simulating effort start is `sim_effort`
 
 The minimal function for this process is `sim_effort(fun="uniform")` in which effort is uniformly distributed across the landscape.
 
-<!--`sim_effort_weighted()` can be used to sample from the target state but weighted unequally across the environment (a weighting layer is provided as a SpatRaster)-->
-
-<!--`sim_effort_byod()` can be used to bring your own data and sample but using specified locations-->
-
 ## Simulating identification/detection
 
 In STRIDER, "detection" refers to the process of whether the applied effort identifies and records the presence of a target within the specified visit. It describes the interaction between realised target state and effort, but may also be influenced by environmental state. Detection can be influenced by various factors such as the sampling methodology, the proficiency of the observer, the environmental conditions, and the characteristics of the target species.
@@ -233,45 +227,3 @@ sim_obj <- sim_state_target_suitability(sim_obj, fun = suit_fun)
 ```
 
 This function must take the SimulationObject as its first argument. This means you've got access to all other simulation components. Therefore, if for example you wanted to your detection process to depend on the environment then you'd simply need to access it via the correct slot.
-
-## A complete minimal example
-
-Here is an example which runs through a very simple example and plots the output. 
-
-```{r example}
-rm(sim_obj)
-library(STRIDER)
-library(terra)
-library(sf)
-
-# Create the background
-background <- terra::rast(matrix(0,50,50))
-
-# Create the simulation object
-sim_obj <- SimulationObject(background = background)
-
-# Simulate the environment state
-sim_obj <- sim_state_env(sim_obj,fun = state_env_gradient,from = 0,to = 1)
-
-# Simulate the target state
-state_target_suitability_example <- function(sim_obj){ 
-  out <-  sim_obj@state_env*2
-  out[out>1] <- 2-out[out>1]
-  out # optimal environment is 0.5
-}
-sim_obj <- sim_state_target_suitability(sim_obj,state_target_suitability_example)
-
-#realise the state
-sim_obj <- sim_state_target_realise(sim_obj,fun = state_target_realise_binomial)
-
-# Simulate the sampling effort
-sim_obj <- sim_effort(sim_obj,fun = effort_basic, n_visits = 100, replace = FALSE)
-
-# Simulate the detection
-sim_obj <- sim_detect(sim_obj,fun = detect_equal, prob = 0.5)
-
-# Simulate the reporting
-sim_obj <- sim_report(sim_obj,fun = report_equal, prob = 0.8, platform = "iRecord")
-
-plot(sim_obj) 
-```