#' @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)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.