Merge pull request #96 from njtierney/tile_n

Add `tile_n()`

NAMESPACE

@@ -11,6 +11,7 @@ export(tar_terra_tiles)
 export(tar_terra_vect)
 export(tile_blocksize)
 export(tile_grid)
+export(tile_n)
 importFrom(rlang,"%||%")
 importFrom(rlang,arg_match0)
 importFrom(utils,globalVariables)

NEWS.md

@@ -2,7 +2,7 @@
 
 * Created `tar_stars()` and `tar_stars_proxy()` that create `stars` and `stars_proxy` objects, respectively.
 * Created `tar_terra_tiles()`, a "target factory" for splitting a raster into multiple tiles with dynamic branching (#69).
-* Created two helper functions for use in `tar_terra_tiles()`: `tile_grid()` and `tile_blocksize()` (#69, #87, #89).
+* Created two helper functions for use in `tar_terra_tiles()`: `tile_grid()`, `tile_n()`, and `tile_blocksize()` (#69, #86, #87, #89).
 * Created utility function `set_window()` mostly for internal use within `tar_terra_tiles()`.
 * Removes the `iteration` argument from all `tar_*()` functions. `iteration` now hard-coded as `"list"` since it is the only option that works (for now at least).
 * Added the `description` argument to all `tar_*()` functions which is passed to `tar_target()`.

R/tar_terra_tiles.R

@@ -252,6 +252,7 @@ set_window <- function(raster, window) {
 #' @param raster a SpatRaster object
 #' @param ncol integer; number of columns to split the SpatRaster into
 #' @param nrow integer; number of rows to split the SpatRaster into
+#' @param n integer; total number of tiles to split the SpatRaster into
 #'
 #' @author Eric Scott
 #' @return list of named numeric vectors with xmin, xmax, ymin, and ymax values
@@ -262,8 +263,34 @@ set_window <- function(raster, window) {
 #' @examples
 #' f <- system.file("ex/elev.tif", package="terra")
 #' r <- terra::rast(f)
-#' r_tiles <- tile_grid(r, ncol = 2, nrow = 2)
-#' r_tiles
+#' tile_grid(r, ncol = 2, nrow = 2)
+#' tile_blocksize(r)
+#' tile_n(r, 8)
+#'
+#' \dontrun{
+#' #usage with tar_terra_tiles
+#' list(
+#' tar_terra_rast(
+#' my_map,
+#' terra::rast(system.file("ex/logo.tif", package = "terra"))
+#' ),
+#' tar_terra_tiles(
+#' name = rast_split,
+#' raster = my_map,
+#' tile_fun = tile_blocksize
+#' ),
+#' tar_terra_tiles(
+#' name = rast_split_grid,
+#' raster = my_map,
+#' tile_fun = \(x) tile_grid(x, ncol = 2, nrow = 2)
+#' ),
+#' tar_terra_tiles(
+#' name = rast_split_n,
+#' raster = my_map,
+#' tile_fun = \(x) tile_n(x, n = 6)
+#' )
+#' )
+#' }
 tile_grid <- function(raster, ncol, nrow) {
  template <- terra::rast(
  x = terra::ext(raster),
@@ -295,3 +322,46 @@ tile_blocksize <- function(raster) {
  tile_list
 }
 
+#' @export
+#' @rdname tile_helpers
+tile_n <- function(raster, n) {
+ if (!rlang::is_integerish(n)) {
+ rlang::abort("`n` must be an integer.")
+ }
+ sq <- sqrt(n)
+ sq_round <- floor(sq)
+ quotient <- n/sq_round
+ is_even <- rlang::is_integerish(quotient)
+ is_odd <- !is_even
+ if (is_even) {
+ nrow <- sq_round
+ ncol <- n/nrow
+ }
+ if (is_odd) {
+ nrow <- sq_round
+ ncol <- ceiling(quotient) #round up
+
+ # #alternatively, only use rows??
+ # nrow <- n
+ # ncol <- 1
+ }
+
+ cli::cli_inform("creating {nrow} * {ncol} = {nrow*ncol} tile extents")
+ template <- terra::rast(
+ x = terra::ext(raster),
+ ncol = ncol,
+ nrow = nrow,
+ crs = terra::crs(raster)
+ )
+
+ tile_ext <- terra::getTileExtents(
+ x = raster,
+ template
+ )
+ n_tiles <- seq_len(nrow(tile_ext))
+ tile_list <- lapply(
+ n_tiles,
+ \(i) tile_ext[i,]
+ )
+ tile_list
+}

tests/testthat/test-tar-terra-tiles.R

@@ -21,9 +21,14 @@ targets::tar_test("tar_terra_tiles() works", {
  tile_fun = tile_blocksize
  ),
  tar_terra_tiles(
- name = rast_split_n,
+ name = rast_split_grid,
  raster = my_map,
  tile_fun = \(x) tile_grid(x, ncol = 2, nrow = 2)
+ ),
+ tar_terra_tiles(
+ name = rast_split_n,
+ raster = my_map,
+ tile_fun = \(x) tile_n(x, n = 6)
  )
  )
  })