lab/bbox_sp.R

In kamapu/spatialist: Miscellaneous Spatial Functions

#' @name bbox_sp
#' @rdname bbox_sp
#'
#' @title Bounding boxes as spatial objects
#'
#' @description
#' Bounding boxes of raster (class `Raster*`) objects will be converted either
#' to [SpatialPointsDataFrame-class] or [SpatialPointsDataFrame-class].
#'
#' This function extract the corners including the bounding box of the input
#' raster or extension and writes either four spatial points or a rectangle as
#' polygon.
#'
#' @param raster An object of class `Raster*` or [Extent-class].
#' @param geom Character value indicating the geometry of output (either point
#'     or polygon).
#' @param proj4 Character vector indicating the `proj4string` (required only
#'     for inputs of class [Extent-class]).
#' @param ... Further arguments passed among methods (not yet used).
#'
#' @return Either a [SpatialPointsDataFrame-class] or a
#' [SpatialPolygonsDataFrame-class] object.
#'
#' @author Lukas Trübenbach and Miguel Alvarez (\email{kamapu78@@gmail.com}).
#'
#' @examples
#' require(raster)
#'
#' r <- raster(system.file("external/test.grd", package = "raster"))
#' plot(r)
#' plot(bbox_sp(r, "polygon"), border = "darkgreen", lwd = 3, add = TRUE)
#' plot(bbox_sp(r, "point"), col = "red", pch = 16, cex = 3, add = TRUE)
#'
#' @exportMethod bbox_sp
#'
setGeneric(
  "bbox_sp",
  function(raster, ...) {
    standardGeneric("bbox_sp")
  }
)

#' @rdname bbox_sp
#' @aliases bbox_sp,Extent-method
#'
setMethod(
  "bbox_sp", signature(raster = "Extent"),
  function(raster, proj4 = "", geom = "point", ...) {
    geom <- pmatch(geom, c("point", "polygon"))
    if (!geom %in% c(1, 2)) {
      stop("Invalid value for argument 'geom'.")
    }
    # Extension as points
    if (geom == 1) {
      raster <- data.frame(
        fid = 1:4,
        longitude = c(
          raster@xmin, raster@xmin, raster@xmax,
          raster@xmax
        ),
        latitude = c(
          raster@ymin, raster@ymax, raster@ymax,
          raster@ymin
        )
      )
      coordinates(raster) <- ~ longitude + latitude
      proj4string(raster) <- CRS(proj4)
    }
    # rasterension as polygon
    if (geom == 2) {
      raster <- Polygons(
        list(Polygon(cbind(
          c(
            raster@xmin, raster@xmin,
            raster@xmax, raster@xmax
          ),
          c(
            raster@ymin, raster@ymax,
            raster@ymax, raster@ymin
          )
        ))),
        ID = "bbox"
      )
      raster <- SpatialPolygons(list(raster), proj4string = CRS(proj4))
      raster <- SpatialPolygonsDataFrame(raster, data.frame(fid = 1),
        match.ID = FALSE
      )
    }
    return(raster)
  }
)

#' @rdname bbox_sp
#' @aliases bbox_sp,RasterLayer-method
#'
setMethod(
  "bbox_sp", signature(raster = "RasterLayer"),
  function(raster, geom = "point", ...) {
    return(bbox_sp(extent(raster), proj4string(raster), geom, ...))
  }
)

#' @rdname bbox_sp
#' @aliases bbox_sp,RasterStack-method
#'
setMethod(
  "bbox_sp", signature(raster = "RasterStack"),
  function(raster, geom = "point", ...) {
    return(bbox_sp(extent(raster), proj4string(raster), geom, ...))
  }
)

#' @rdname bbox_sp
#' @aliases bbox_sp,RasterBrick-method
#'
setMethod(
  "bbox_sp", signature(raster = "RasterBrick"),
  function(raster, geom = "point", ...) {
    return(bbox_sp(extent(raster), proj4string(raster), geom, ...))
  }
)