R/segmentize_transect.R

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

# Generated by fusen: do not edit by hand


#' Segmentize transects
#'
#' @param transect_obj sf dataframe. Transect data. 
#' @param length_m numeric. Length of the segments desired.
#' @param to character. Format desired for the output.
#'
#' @importFrom sf st_geometry st_multilinestring st_sfc st_coordinates st_set_geometry st_cast st_crs st_geometry_type st_segmentize st_length
#'
#' @return sf dataframe. Segmentized transect data.
#' @export


#' @examples
#' 
#' data("dataset_transects")
#' 
#' segs <- segmentize_transect(transect_obj = dataset_transects,
#'                             length_m = 2000,
#'                             to = "LINESTRING")
#' 
#' head(segs)
#' 
segmentize_transect <- function(transect_obj, length_m, to = "MULTILINESTRING") {
  
  assert_that(inherits(transect_obj, "sf"))
  assert_that(is.numeric(length_m))
  
  transect_obj <- st_segmentize(transect_obj, dfMaxLength=units::set_units(length_m, "metres"))
  
  ggg <- st_geometry(transect_obj)
  
  if (!unique(st_geometry_type(ggg)) %in% c("POLYGON", "LINESTRING")) {
    stop("Input should be  LINESTRING or POLYGON")
  }
  for (k in 1:length(st_geometry(ggg))) {
    sub <- ggg[k]
    geom <- lapply(
      1:(length(st_coordinates(sub)[, 1]) - 1),
      function(i)
        rbind(
          as.numeric(st_coordinates(sub)[i, 1:2]),
          as.numeric(st_coordinates(sub)[i + 1, 1:2])
        )
    ) %>%
      st_multilinestring() %>%
      st_sfc()
    
    if (k == 1) {
      endgeom <- geom
    }
    else {
      endgeom <- rbind(endgeom, geom)
    }
  }
  endgeom <- endgeom %>% st_sfc(crs = st_crs(transect_obj))
  if (class(transect_obj)[1] == "sf") {
    endgeom <- st_set_geometry(transect_obj, endgeom)
  }
  if (to == "LINESTRING") {
    endgeom <- endgeom %>% st_cast("LINESTRING")
  }
  
  endgeom$Effort <- st_length(endgeom)
  
  # Name segment
  endgeom$Sample.Label <- NA
  
  # loop over the transect IDs
  for(this_transect in unique(endgeom$transect)){
    # how many segments in this transect?
    n_segs <- nrow(subset(endgeom, transect==this_transect))
    # generate the n_segs labels that we need
    endgeom$Sample.Label[endgeom$transect==this_transect] <- paste(this_transect,1:n_segs, sep="-")}
  
  return(endgeom)
}