R/splitClip.R

Defines functions splitClip

Documented in splitClip

#' @title Fast Clip for Spatial* objects.
#'
#' @description
#' \code{splitClip} splits a Spatial* object from the (sp) package using
#' \code{seqSPDF}, and runs \code{rgeos::gIntersection()} on the list.
#'
#' @details
#' This is a general wrapper for \code{rgeos::gIntersection()} that allows
#' for quicker clips and fixed a ram leak issue caused by large datasets
#' when using the native rgeos function.
#'
#' @param input Spatial* object.
#' @param clipFeature SpatialPolygons* object.
#' @param sep Passed to \code{seqSPDF()}. Default set to 1000.
#'
#' @return Returns the true clip of a Spatial* feature.
#' @section Warning:
#' Will not output with a dataframe due to limitations of the rgeos
#' functions. Will look into using \code{raster::intersection()} in a future
#' release.
#'
#' @export
# @examples need to find test data and add examples
splitClip <- function(input, clipFeature, sep = 1000) {

  ###Input Error Handling
  if (!grepl("SpatialPolygons", class(clipFeature))) {
    stop("\"clipFeature\" input not of a \'SpatialPolygons\' class")
  } else if (!grepl("Spatial", class(input))) {
    stop("\"input\" input not of a \'Spatial\' class")
  }

  inputSplit <- seqSPDF(input, sep)
  clippedList <- lapply(inputSplit, function(x) {
    clipped <- rgeos::gIntersection(x, clipFeature, byid = TRUE, drop_lower_td = TRUE)
    return(clipped)
  })

  if (length(which(sapply(clippedList, is.null))) > 0) {
    clippedListNoNull <- clippedList[-which(sapply(clippedList, is.null))]
  } else {
    clippedListNoNull <- clippedList
  }

  if (length(clippedListNoNull) == 1) {
    return(clippedListNoNull[[1]])
  } else if (length(clippedListNoNull) == 0) {
    warning("splitClip returned no features")
    return(NULL)
  } else {
    clippedBind <- suppressWarnings(do.call(raster::bind, clippedListNoNull))
    return(clippedBind)
  }
}
jacpete/jpfxns documentation built on May 16, 2020, 5:02 a.m.