Merge pull request #94 from njtierney/tar_terra_sds

Add `tar_terra_sds()`
njtierney · Sep 19, 2024 · 596bf4c · 596bf4c
2 parents 46189de + f9db9c9
commit 596bf4c
Show file tree

Hide file tree

Showing 5 changed files with 560 additions and 76 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -6,6 +6,7 @@ export(set_window)
 export(tar_stars)
 export(tar_stars_proxy)
 export(tar_terra_rast)
+export(tar_terra_sds)
 export(tar_terra_sprc)
 export(tar_terra_tiles)
 export(tar_terra_vect)

diff --git a/R/tar-terra-sprc.R b/R/tar-terra-sprc.R
@@ -66,87 +66,268 @@ tar_terra_sprc <- function(name,
  retrieval = targets::tar_option_get("retrieval"),
  cue = targets::tar_option_get("cue"),
  description = targets::tar_option_get("description")) {
- check_pkg_installed("terra")
+  check_pkg_installed("terra")
  #ensure that user-passed `resources` doesn't include `custom_format`
  if ("custom_format" %in% names(resources)) {
  cli::cli_abort("{.val custom_format} cannot be supplied to targets created with {.fn tar_terra_sprc}")
  }
 
- gdal <- gdal %||% character(0)
- filetype <- filetype %||% "GTiff"
-
- # check that filetype option is available
- drv <- get_gdal_available_driver_list("raster")
- filetype <- rlang::arg_match0(filetype, drv$name)
-
- name <- targets::tar_deparse_language(substitute(name))
-
- envir <- targets::tar_option_get("envir")
-
- command <- targets::tar_tidy_eval(
- expr = as.expression(substitute(command)),
- envir = envir,
- tidy_eval = tidy_eval
- )
-
- pattern <- targets::tar_tidy_eval(
- expr = as.expression(substitute(pattern)),
- envir = envir,
- tidy_eval = tidy_eval
- )
-
- .write_terra_rasters_sprc <-
- function(object, path) {
- for (i in seq(object)) {
- if (i > 1) {
- opt <- "APPEND_SUBDATASET=YES"
- } else {
- opt <- ""
- }
- terra::writeRaster(
- x = object[i],
- filename = path,
- filetype = Sys.getenv("GEOTARGETS_GDAL_RASTER_DRIVER"),
- overwrite = (i == 1),
- gdal = opt
- )
- }
- }
-
- targets::tar_target_raw(
- name = name,
- command = command,
- pattern = pattern,
- packages = packages,
- library = library,
- format = targets::tar_format(
- read = function(path) terra::sprc(path),
- write = .write_terra_rasters_sprc,
- marshal = function(object) terra::wrap(object),
- unmarshal = function(object) terra::unwrap(object)
- ),
- repository = repository,
- iteration = "list",
- error = error,
- memory = memory,
- garbage_collection = garbage_collection,
- deployment = deployment,
- priority = priority,
- resources = utils::modifyList(
- targets::tar_resources(
- custom_format = targets::tar_resources_custom_format(
- #these envvars are used in write function of format
- envvars = c(
- "GEOTARGETS_GDAL_RASTER_DRIVER" = filetype,
- "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS" = (
- paste0(gdal, collapse = ";")
+ gdal <- gdal %||% character(0)
+ filetype <- filetype %||% "GTiff"
+
+ # check that filetype option is available
+ drv <- get_gdal_available_driver_list("raster")
+ filetype <- rlang::arg_match0(filetype, drv$name)
+
+ name <- targets::tar_deparse_language(substitute(name))
+
+ envir <- targets::tar_option_get("envir")
+
+ command <- targets::tar_tidy_eval(
+ expr = as.expression(substitute(command)),
+ envir = envir,
+ tidy_eval = tidy_eval
+ )
+
+ pattern <- targets::tar_tidy_eval(
+ expr = as.expression(substitute(pattern)),
+ envir = envir,
+ tidy_eval = tidy_eval
+ )
+
+ tar_terra_collection_raw(
+ name = name,
+ command = command,
+ pattern = pattern,
+ filetype = filetype,
+ gdal = gdal,
+ packages = packages,
+ library = library,
+ format = format_terra_collections(type = "sprc"),
+ repository = repository,
+ error = error,
+ memory = memory,
+ garbage_collection = garbage_collection,
+ deployment = deployment,
+ priority = priority,
+ resources = resources,
+ storage = storage,
+ retrieval = retrieval,
+ cue = cue,
+ description = description
+ )
+}
+
+
+#' Create a terra _SpatRasterDataset_ target
+#'
+#' Provides a target format for [terra::SpatRasterDataset] objects,
+#' which hold sub-datasets, each a `SpatRaster` that can have multiple layers.
+#'
+#' @param filetype character. File format expressed as GDAL driver names passed
+#' to [terra::writeRaster()]
+#' @param gdal character. GDAL driver specific datasource creation options
+#' passed to [terra::writeRaster()]
+#' @param ... Additional arguments not yet used
+#'
+#' @inheritParams targets::tar_target
+#'
+#' @note The `iteration` argument is unavailable because it is hard-coded to
+#' `"list"`, the only option that works currently.
+#'
+#' @returns target class "tar_stem" for use in a target pipeline
+#' @seealso [targets::tar_target_raw()], [tar_terra_sprc()]
+#' @author Andrew Gene Brown
+#' @author Nicholas Tierney
+#' @author Eric R. Scott
+#' @export
+#' @examples
+#' if (Sys.getenv("TAR_LONG_EXAMPLES") == "true") {
+#' targets::tar_dir({ # tar_dir() runs code from a temporary directory.
+#' library(geotargets)
+#' targets::tar_script({
+#' elev_scale <- function(z = 1) {
+#' terra::rast(system.file("ex", "elev.tif", package = "terra")) * z
+#' }
+#' list(
+#' tar_terra_sds(
+#' raster_elevs,
+#' # two rasters, one unaltered, one scaled by factor of 2
+#' command = terra::sds(list(
+#' elev_scale(1),
+#' elev_scale(2)
+#' ))
+#' )
+#' )
+#' })
+#' targets::tar_make()
+#' targets::tar_read(raster_elevs)
+#' })
+#' }
+tar_terra_sds <- function(name,
+ command,
+ pattern = NULL,
+ filetype = geotargets_option_get("gdal.raster.driver"),
+ gdal = geotargets_option_get("gdal.raster.creation.options"),
+ ...,
+ tidy_eval = targets::tar_option_get("tidy_eval"),
+ packages = targets::tar_option_get("packages"),
+ library = targets::tar_option_get("library"),
+ repository = targets::tar_option_get("repository"),
+ error = targets::tar_option_get("error"),
+ memory = targets::tar_option_get("memory"),
+ garbage_collection = targets::tar_option_get("garbage_collection"),
+ deployment = targets::tar_option_get("deployment"),
+ priority = targets::tar_option_get("priority"),
+ resources = targets::tar_option_get("resources"),
+ storage = targets::tar_option_get("storage"),
+ retrieval = targets::tar_option_get("retrieval"),
+ cue = targets::tar_option_get("cue"),
+ description = targets::tar_option_get("description")) {
+ check_pkg_installed("terra")
+ #ensure that user-passed `resources` doesn't include `custom_format`
+ if ("custom_format" %in% names(resources)) {
+ cli::cli_abort("{.val custom_format} cannot be supplied to targets created with {.fn tar_terra_sprc}")
+ }
+
+ gdal <- gdal %||% character(0)
+ filetype <- filetype %||% "GTiff"
+
+ # check that filetype option is available
+ drv <- get_gdal_available_driver_list("raster")
+ filetype <- rlang::arg_match0(filetype, drv$name)
+
+ name <- targets::tar_deparse_language(substitute(name))
+
+ envir <- targets::tar_option_get("envir")
+
+ command <- targets::tar_tidy_eval(
+ expr = as.expression(substitute(command)),
+ envir = envir,
+ tidy_eval = tidy_eval
+ )
+
+ pattern <- targets::tar_tidy_eval(
+ expr = as.expression(substitute(pattern)),
+ envir = envir,
+ tidy_eval = tidy_eval
+ )
+
+ tar_terra_collection_raw(
+ name = name,
+ command = command,
+ pattern = pattern,
+ filetype = filetype,
+ gdal = gdal,
+ packages = packages,
+ library = library,
+ format = format_terra_collections(type = "sds"),
+ repository = repository,
+ error = error,
+ memory = memory,
+ garbage_collection = garbage_collection,
+ deployment = deployment,
+ priority = priority,
+ resources = resources,
+ storage = storage,
+ retrieval = retrieval,
+ cue = cue,
+ description = description
+ )
+}
+
+
+
+
+#' @noRd
+tar_terra_collection_raw <- function(
+ name,
+ command,
+ filetype = geotargets_option_get("gdal.raster.driver"),
+ gdal = geotargets_option_get("gdal.raster.creation.options"),
+ pattern = NULL,
+ packages = targets::tar_option_get("packages"),
+ library = targets::tar_option_get("library"),
+ format = format_terra_collections(),
+ repository = targets::tar_option_get("repository"),
+ error = targets::tar_option_get("error"),
+ memory = targets::tar_option_get("memory"),
+ garbage_collection = targets::tar_option_get("garbage_collection"),
+ deployment = targets::tar_option_get("deployment"),
+ priority = targets::tar_option_get("priority"),
+ resources = targets::tar_option_get("resources"),
+ storage = targets::tar_option_get("storage"),
+ retrieval = targets::tar_option_get("retrieval"),
+ cue = targets::tar_option_get("cue"),
+ description = targets::tar_option_get("description")
+) {
+ targets::tar_target_raw(
+ name = name,
+ command = command,
+ pattern = pattern,
+ packages = packages,
+ library = library,
+ format = format,
+ repository = repository,
+ iteration = "list",
+ error = error,
+ memory = memory,
+ garbage_collection = garbage_collection,
+ deployment = deployment,
+ priority = priority,
+ resources = utils::modifyList(
+ targets::tar_resources(
+ custom_format = targets::tar_resources_custom_format(
+ #these envvars are used in write function of format
+ envvars = c(
+ "GEOTARGETS_GDAL_RASTER_DRIVER" = filetype,
+ "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS" = (
+ paste0(gdal, collapse = ";")
+ )
  )
  )
- )
- ), resources),
- storage = storage,
- retrieval = retrieval,
- cue = cue,
- description = description
- )
+ ), resources),
+ storage = storage,
+ retrieval = retrieval,
+ cue = cue,
+ description = description
+ )
+}
+
+
+
+
+#' Format function for sprc and sds
+#' @noRd
+format_terra_collections <- function(type = c("sprc", "sds")) {
+ type <- match.arg(type)
+ targets::tar_format(
+ read = switch(type,
+ "sprc" = function(path) terra::sprc(path),
+ "sds" = function(path) terra::sds(path)
+ ),
+ write = function(object, path) {
+ gdal <- strsplit(
+ Sys.getenv("GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS",
+ unset = ";"),
+ ";")[[1]]
+
+ for (i in seq(object)) {
+ if (i > 1) {
+ opt <- "APPEND_SUBDATASET=YES"
+ } else {
+ opt <- ""
+ }
+ terra::writeRaster(
+ x = object[i],
+ filename = path,
+ filetype = Sys.getenv("GEOTARGETS_GDAL_RASTER_DRIVER"),
+ overwrite = (i == 1),
+ gdal = c(opt, gdal)
+ )
+ }
+ },
+ marshal = function(object) terra::wrap(object),
+ unmarshal = function(object) terra::unwrap(object)
+ )
 }