R/detection.R

In maudqueroue/intercali: Intercalibration Des Différents Types De Suivis Aeriens

# Generated by fusen: do not edit by hand


#' Detection function
#'
#' This funtion allows simulating the probability that a individual could be observed according to the sample design. The detection function could be an uniform detection function with a probability of detection g_zero on the whole strip band until the maximum distance of observation (in m) truncation_m. The detection function could also be a half normal detection function for which we can choose the effective strip width (in km) esw_km i.e. the distance at which there are as much non detected individuals before this distance than detected individuals after this distance. For the half normal detection function it is also possible to choose the proability of detection at 0 meter g_zero and the maximum distance of observation (in m) truncation_m.
#' @param dist_obj dataframe. Contains each observation and the distance between the observation and the transects/segments.
#' @param key character. Form of the detection function "hn" or "unif".
#' @param esw_km numeric. Effective strip width (in km). This argument is needed only for the 'hn' form. By default NA.
#' @param g_zero numeric. The detection probability for the 'unif' form. By default NA.
#' @param truncation_m numeric. A single numeric value (in m) describing the longest distance at which an object may be observed.
#'
#' @importFrom dplyr mutate
#' @importFrom stats rbinom
#' @importFrom assertthat assert_that
#'
#' @return dataframe. The dist dataframe with new columns : "proba" (numeric values between 0 and 1), the probability of being detection and 'detected' (0 or 1)informing if the individual is detected by the sample design.
#' @export


#' @examples
#' 
#' library(ggplot2)
#' 
#' data(dataset_dist)
#' 
#' detected <- detection(dist_obj = dataset_dist,
#'                    key = "hn",
#'                    esw_km = 0.16,
#'                    g_zero = 1,
#'                    truncation_m = 400)
#' 
#' ggplot(detected, aes(x=distance_m, y=proba)) +
#'   geom_point(color = "indianred4") +
#'   xlim(0,500)
#' 
#' 
#' detected <- detection(dist_obj = dataset_dist,
#'                    key = "unif",
#'                    g_zero = 0.8,
#'                    truncation_m = 250) 
#' 
#' ggplot(detected, aes(x=distance_m, y=proba)) +
#'   geom_point(color = "indianred4") +
#'   xlim(0,500)
#' 
detection <- function(dist_obj, key, esw_km = NA, g_zero = NA, truncation_m) {
  
  # Function checks
  
  assert_that(inherits(dist_obj, "data.frame"))
  if (!all(c("distance_km", "distance_m") %in% names(dist_obj))) {stop("dist_obj must contain `distance_km` and `distance_m` columns. Verify your column names.")}
  assert_that(is.numeric(dist_obj$distance_m))
  assert_that(is.numeric(dist_obj$distance_km))
  assert_that(is.numeric(truncation_m))
  assert_that(is.numeric(g_zero))
  if(!(key %in% c("unif", "hn"))){stop("key argument must be `unif` or `hn`.")}
  
  # Function
  
  if(key == 'hn'){
    assert_that(is.numeric(esw_km))
    sigma <- scale_hn(esw = esw_km)
    dist_obj <- dist_obj %>%
      mutate(proba = g_zero * exp(-(distance_km)^2 / (2 * sigma * sigma))) %>%
      mutate(detected = rbinom(nrow(dist_obj), size = 1, prob = proba))
    
    dist_obj$detected[dist_obj$distance_m > truncation_m] <- 0
    dist_obj$proba[dist_obj$distance_m > truncation_m] <- 0

  }
  
  if(key == 'unif'){
    dist_obj <- dist_obj %>%
      mutate(proba = g_zero) %>%
      mutate(detected = rbinom(nrow(dist_obj), size = 1, prob = proba))
    
    dist_obj$detected[dist_obj$distance_m > truncation_m] <- 0
    dist_obj$proba[dist_obj$distance_m > truncation_m] <- 0
  }
  
  return(dist_obj)
  
}