R/tile_bbox.R

In MatthewJWhittle/spatialutils:

#' Split Bounding Box
#'
#' Split a bounding box into an equal number of squares
#' @param bbox a bounding_box created by sf::st_bbox()
#' @param resolution the resolution (in the units of the crs) of the output bbox.
#' @param ratio the ratio of the x to y dimension of the output bbox
#' @return a list of bounding boxs generated by sf::st_bbox()
#' @import dplyr
#' @import tidyr
#' @importFrom tidyr expand_grid
#' @importFrom magrittr %>%
#' @import sf
#' @importFrom purrr map
#' @export tile_bbox
# require(tidyverse)
# require(sf)
# bbox <- xy_to_points() %>% st_buffer(100) %>% st_bbox()
# bbox <- st_bbox(c(xmin = 1, ymin = 1, xmax = 101, ymax = 101))
# resolution <- 10
# ratio <- 1
tile_bbox <- function(bbox, resolution, ratio = 1){
  # Assert that bbox is a bounding box
  stopifnot(class(bbox) %in% "bbox")

  # Get the length of the x axis
  x_ext <- bbox["xmax"] - bbox["xmin"]
  # Get the length of the y axis
  y_ext <- bbox["ymax"] - bbox["ymin"]

  incr_x <- resolution
  incr_y <- resolution * ratio
  # incr_x <- x_ext / n_x
  # incr_y <- y_ext / n_y

  # Create a sequence of x and y coordinates to generate the xmins and ymins
  xmin <- seq(from = bbox["xmin"], to = bbox["xmax"], by = incr_x)
  ymin <- seq(from = bbox["ymin"], to = bbox["ymax"], by = incr_y)



  # Remove any in sequence above max so that
  # top right corner doesn't create an xmin or ymin
  xmin <-  xmin[xmin < bbox["xmax"]]
  ymin <-  ymin[ymin < bbox["ymax"]]

  bbox_table <-
    expand_grid(xmin, ymin) %>%
    mutate(xmax = xmin + incr_x,
           ymax = ymin + incr_y)

  bbox_table <-
    bbox_table %>%
    mutate(xmax = if_else(xmax > bbox["xmax"],
                          true = bbox["xmax"],
                          false = xmax
                          ),
           ymax = if_else(ymax > bbox["ymax"],
                          true = bbox["ymax"],
                          false = ymax
           ))

  bounding_boxes <-
    transpose(bbox_table) %>% map( ~ .x %>%
                                     unlist %>% st_bbox(crs = st_crs(bbox)$epsg))

  return(bounding_boxes)
}