R/crop_transect.R

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

# Generated by fusen: do not edit by hand


#' Crop transect
#'
#' This function allows to resize the transects `transect_obj` created with the `create_transect` function, in order to perfectly fit the density map use to simulate individuals `map_obj`. 
#'
#' An improvement that should come later consit in having a grid matching perfectly with the study region `region_obj` or `density_obj`. For the moment, the grid created with `extract_map` does not perfectly match the total area of the region because it only keeps squares of the same size, so the edges of the study region are slightly cropped. With the `create_transect` function, the transects are created on the basis of the total region `region_obj` and not on the basis of the grid `map_obj`. Hence the need to resize with the fonction `crop_transect`.
#'
#' @param transect_obj sf dataframe. The transect data.
#' @param map_obj sf dataframe. Map of the study area with the density.
#' @param ifsegs Boolean. TRUE to highlight the different segments with colors. By default FALSE.
#'
#' @importFrom sf st_union st_intersection st_length 
#' @importFrom dplyr filter mutate 
#' @importFrom assertthat assert_that
#' @importFrom units drop_units
#'
#' @return sf dataframe. The transect resize to match the density map grid.
#' @export

#' @examples
#' 
#' data(dataset_transects)
#' data(dataset_map)
#' 
#' # The transects do not correspond perfectly to the density map
#' plot_transects(transect_obj = dataset_transects, 
#'                map_obj = dataset_map, 
#'                crs = 2154)
#' 
#' # Crop transects
#' cropped_transects <- crop_transect(transect_obj = dataset_transects,
#'                                    map_obj = dataset_map)
#' 
#' # The transects correspond perfectly to the density map
#' plot_transects(transect_obj = cropped_transects, 
#'                map_obj = dataset_map, 
#'                crs = 2154)
#' 
crop_transect <- function(transect_obj, map_obj, ifsegs = FALSE) {
  
  # function check
  
  assert_that(inherits(transect_obj, "sf"))
  assert_that(inherits(map_obj, "sf"))
  
  # function
  
  contour_obj <- map_obj %>%
    st_union()
  
  transect_out <- transect_obj %>%
    st_intersection(contour_obj)
  
  
  if(ifsegs==TRUE){
    transect_out <- transect_out %>%
      mutate(length = st_length(.)) %>%
      drop_units() %>%
      filter(length != 0)
  }
  
  return(transect_out)
  
}