R/prepare_dsm.R

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

# Generated by fusen: do not edit by hand


#' Prepare data for distance sampling analysis
#'
#' This function formats the simulated data in the right direction for their use in distance sampling and distribution models. The function takes as input information about the density map `map_obj`, information about the detected individuals and their observation distance `dist_obj` and information about the transects `segs_obj`. The output is a list containing the various `dist_dsm`, `obs_dsm`, `grid_dsm` and `segs_dsm` objects formatted for their use in the functions of the `Distance` and `dsm` packages.
#'
#' @param map_obj sf dataframe. Map of the study area with the density.
#' @param dist_obj dataframe. Distances between individuals and associated transect/segment and probability that the individual is detected or not.
#' @param segs_obj sf dataframe. Transect/segment data.
#'
#' @importFrom dplyr select left_join filter mutate
#' @importFrom units drop_units
#' @importFrom sf st_centroid st_coordinates st_drop_geometry
#' @importFrom assertthat assert_that
#'
#' @return list. Objects `dist_dsm`, `obs_dsm`, `grid_dsm` and `segs_dsm` formatted for their use in the functions of the `Distance` and `dsm` packages.
#' @export

#' @examples
#' 
#' data("dataset_map")
#' data("dataset_segs")
#' data("dataset_detected")
#' 
#' list_dsm <- prepare_dsm(map_obj = dataset_map,
#'                         dist_obj = dataset_detected, 
#'                         segs_obj = dataset_segs)
#' 
#' 
prepare_dsm <- function(map_obj, dist_obj, segs_obj) {
  
  # Function checks
  
  assert_that(inherits(map_obj, "sf"))
  assert_that(inherits(dist_obj, "data.frame"))
  assert_that(inherits(segs_obj, "sf"))
  
  if (!all(c("detected", "distance_m") %in% names(dist_obj))) {stop("dist_obj must contain `detected` and `distance_m` columns. Verify your column names.")}
  if (!all(c("Effort", "Sample.Label") %in% names(segs_obj))) {stop("segs_obj must contain `Effort` and `Sample.Label`, `X`, `Y` columns. Verify your column names.")}

  # Function
  
  obs_dsm <- left_join(dist_obj, segs_obj, by='Sample.Label')  %>%
    select(object, Sample.Label, size, distance_m, detected) %>%
    drop_units() %>% 
    rename(distance = distance_m) %>%
    filter(detected == 1)
  
  dist_dsm <-  obs_dsm %>%
    select(object, distance) %>%
    drop_units()
  
  # segments
  segs_dsm <- segs_obj %>%
    st_centroid() %>%
    mutate(X = st_coordinates(.)[,1]) %>%
    mutate(Y = st_coordinates(.)[,2]) %>%
    select(Effort, Sample.Label, X, Y) %>%
    st_drop_geometry() %>%
    drop_units()
  
  grid_dsm <- map_obj %>%
    st_centroid() %>%
    mutate(X = st_coordinates(.)[,1],
           Y = st_coordinates(.)[,2]) %>%
    drop_units() %>%
    as.data.frame() %>%
    select("X","Y","area")
  
  out <- list(dist_dsm = dist_dsm,
              obs_dsm = obs_dsm,
              segs_dsm = segs_dsm,
              grid_dsm = grid_dsm)
  
  return(out)
  
}