diff --git a/R/geotargets-option.R b/R/geotargets-option.R index 49d1d03..9b2c8b2 100644 --- a/R/geotargets-option.R +++ b/R/geotargets-option.R @@ -42,8 +42,11 @@ geotargets_option_get <- function(option_name) { get_geotargets_gdal_raster_creation_options <- function(option_name, option_value) { gdal_creation_options <- Sys.getenv( x = "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS", - unset = get_option(option_name, option_value, "") + unset = "" ) + if (gdal_creation_options == "") { + gdal_creation_options <- get_option(option_name, option_value, "") + } the_option <- strsplit(gdal_creation_options, ";")[[1]] the_option } @@ -58,8 +61,11 @@ geotargets_option_get <- function(option_name) { get_geotargets_gdal_vector_creation_options <- function(option_name, option_value) { gdal_creation_options <- Sys.getenv( x = "GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS", - unset = get_option(option_name, option_value, "ENCODING=UTF-8") + unset = "" ) + if (gdal_creation_options == "") { + gdal_creation_options <- get_option(option_name, option_value, "ENCODING=UTF-8") + } the_options <- strsplit(gdal_creation_options, ";")[[1]] the_options } diff --git a/R/tar-stars.R b/R/tar-stars.R index 1e568e1..282daba 100644 --- a/R/tar-stars.R +++ b/R/tar-stars.R @@ -3,7 +3,8 @@ #' Provides a target format for stars objects. #' #' @param proxy logical. Passed to [stars::read_stars()]. If `TRUE` the target an object of class `stars_proxy`. Otherwise, the object is class `stars`. -#' @param driver character. File format expressed as GDAL driver names passed to [stars::write_stars()]. See [sf::st_drivers()]. +#' @param mdim logical. Use the [Multidimensional Raster Data Model](https://gdal.org/user/multidim_raster_data_model.html) via [stars::write_mdim()]? Default: `FALSE`. Only supported for some drivers, e.g. `"HDF5"`, `"netCDF"`, `"Zarr"`. +#' @param driver character. File format expressed as GDAL driver names passed to [stars::write_stars()] or [stars::write_mdim()] See [sf::st_drivers()]. #' @param options character. GDAL driver specific datasource creation options passed to [stars::write_stars()] #' @param ... Additional arguments not yet used #' @@ -30,6 +31,7 @@ tar_stars <- function(name, command, pattern = NULL, proxy = FALSE, + mdim = FALSE, driver = NULL, options = NULL, ..., @@ -76,7 +78,7 @@ tar_stars <- function(name, pattern = pattern, packages = packages, library = library, - format = create_format_stars(driver = driver, options = options, proxy = proxy, ...), + format = create_format_stars(driver = driver, options = options, proxy = proxy, mdim = mdim, ...), repository = repository, iteration = iteration, error = error, @@ -96,6 +98,7 @@ tar_stars <- function(name, tar_stars_proxy <- function(name, command, pattern = NULL, + mdim = FALSE, driver = NULL, options = NULL, ..., @@ -142,7 +145,7 @@ tar_stars_proxy <- function(name, pattern = pattern, packages = packages, library = library, - format = create_format_stars(driver = driver, options = options, proxy = TRUE, ...), + format = create_format_stars(driver = driver, options = options, proxy = TRUE, mdim = mdim, ...), repository = repository, iteration = iteration, error = error, @@ -158,11 +161,80 @@ tar_stars_proxy <- function(name, } +#' @export +#' @rdname tar_stars +tar_stars_proxy <- function(name, + command, + pattern = NULL, + mdim = FALSE, + driver = NULL, + options = NULL, + ..., + 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"), + iteration = targets::tar_option_get("iteration"), + 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")) { + + rlang::check_installed("stars") + + 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 + ) + + # if not specified by user, pull the corresponding geotargets option + driver <- driver %||% geotargets_option_get("gdal.raster.driver") + options <- options %||% geotargets_option_get("gdal.raster.creation_options") + + targets::tar_target_raw( + name = name, + command = command, + pattern = pattern, + packages = packages, + library = library, + format = create_format_stars(driver = driver, options = options, proxy = TRUE, mdim = mdim, ...), + repository = repository, + iteration = iteration, + error = error, + memory = memory, + garbage_collection = garbage_collection, + deployment = deployment, + priority = priority, + resources = resources, + storage = storage, + retrieval = retrieval, + cue = cue + ) +} + #' @param driver character. File format expressed as GDAL driver names passed to [stars::write_stars()]. See [sf::st_drivers()]. #' @param options character. GDAL driver specific datasource creation options passed to [stars::write_stars()] +#' @param proxy logical. Passed to [stars::read_stars()]. If `TRUE` the target an object of class `stars_proxy`. Otherwise, the object is class `stars`. +#' @param mdim logical. Use the [Multidimensional Raster Data Model](https://gdal.org/user/multidim_raster_data_model.html) via [stars::write_mdim()]? Default: `FALSE`. Only supported for some drivers, e.g. `"netCDF"` or `"Zarr"`. #' @param ... Additional arguments not yet used #' @noRd -create_format_stars <- function(driver, options, proxy, ...) { +create_format_stars <- function(driver, options, proxy, mdim, ...) { # get list of drivers available for writing depending on what the user's GDAL supports drv <- sf::st_drivers(what = "raster") @@ -191,6 +263,21 @@ create_format_stars <- function(driver, options, proxy, ...) { ) } + # TODO: should multidimensional array use the same options as 2D? + .write_stars_mdim <- function(object, path) { + stars::write_mdim( + object, + path, + driver = geotargets::geotargets_option_get("gdal.raster.driver"), + overwrite = TRUE, + options = geotargets::geotargets_option_get("gdal.raster.creation_options") + ) + } + + if (isTRUE(mdim)) { + .write_stars <- .write_stars_mdim + } + body(.write_stars)[[2]][["driver"]] <- driver body(.write_stars)[[2]][["options"]] <- options diff --git a/man/tar_stars.Rd b/man/tar_stars.Rd index ed53cdb..9edd02e 100644 --- a/man/tar_stars.Rd +++ b/man/tar_stars.Rd @@ -10,6 +10,7 @@ tar_stars( command, pattern = NULL, proxy = FALSE, + mdim = FALSE, driver = NULL, options = NULL, ..., @@ -33,6 +34,31 @@ tar_stars_proxy( name, command, pattern = NULL, + mdim = FALSE, + driver = NULL, + options = NULL, + ..., + 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"), + iteration = targets::tar_option_get("iteration"), + 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") +) + +tar_stars_proxy( + name, + command, + pattern = NULL, + mdim = FALSE, driver = NULL, options = NULL, ..., @@ -79,7 +105,9 @@ and so on. See the user manual for details.} \item{proxy}{logical. Passed to \code{\link[stars:read_stars]{stars::read_stars()}}. If \code{TRUE} the target an object of class \code{stars_proxy}. Otherwise, the object is class \code{stars}.} -\item{driver}{character. File format expressed as GDAL driver names passed to \code{\link[stars:write_stars]{stars::write_stars()}}. See \code{\link[sf:st_drivers]{sf::st_drivers()}}.} +\item{mdim}{logical. Use the \href{https://gdal.org/user/multidim_raster_data_model.html}{Multidimensional Raster Data Model} via \code{\link[stars:mdim]{stars::write_mdim()}}? Default: \code{FALSE}. Only supported for some drivers, e.g. \code{"HDF5"}, \code{"netCDF"}, \code{"Zarr"}.} + +\item{driver}{character. File format expressed as GDAL driver names passed to \code{\link[stars:write_stars]{stars::write_stars()}} or \code{\link[stars:mdim]{stars::write_mdim()}} See \code{\link[sf:st_drivers]{sf::st_drivers()}}.} \item{options}{character. GDAL driver specific datasource creation options passed to \code{\link[stars:write_stars]{stars::write_stars()}}} diff --git a/tests/testthat/_snaps/tar-stars.md b/tests/testthat/_snaps/tar-stars.md index 42c33c9..9904189 100644 --- a/tests/testthat/_snaps/tar-stars.md +++ b/tests/testthat/_snaps/tar-stars.md @@ -26,3 +26,17 @@ x 1 111 288776 89.99 UTM Zone 25, Southern Hem... FALSE [x] y 1 111 9120761 -89.99 UTM Zone 25, Southern Hem... FALSE [y] +# tar_stars(mdim=TRUE) works + + Code + x + Output + stars object with 2 dimensions and 1 attribute + attribute(s): + Min. 1st Qu. Median Mean 3rd Qu. Max. + test_stars_mdim 0.03524588 0.3224987 0.3772574 0.4289465 0.511113 0.9204841 + dimension(s): + from to offset delta x/y + x 1 2 0 1 [x] + y 1 5 5 -1 [y] + diff --git a/tests/testthat/test-tar-stars.R b/tests/testthat/test-tar-stars.R index 7c5366d..3eecb03 100644 --- a/tests/testthat/test-tar-stars.R +++ b/tests/testthat/test-tar-stars.R @@ -18,7 +18,6 @@ targets::tar_test("tar_stars() works", { ) }) - targets::tar_test("tar_stars_proxy() works", { geotargets::geotargets_option_set("gdal.raster.creation_options", c("COMPRESS=DEFLATE", "TFW=YES")) geotargets::geotargets_option_set("stars.proxy", TRUE) # needed for {covr} only @@ -36,3 +35,25 @@ targets::tar_test("tar_stars_proxy() works", { ) geotargets::geotargets_option_set("stars.proxy", FALSE) # go back to default }) + + +targets::tar_test("tar_stars(mdim=TRUE) works", { + targets::tar_script({ + geotargets::geotargets_option_set("gdal.raster.driver", "netCDF") + list(geotargets::tar_stars(test_stars_mdim, { + set.seed(135) + m <- matrix(runif(10), 2, 5) + names(dim(m)) <- c("stations", "time") + times <- as.Date("2022-05-01") + 1:5 + pts <- sf::st_as_sfc(c("POINT(0 1)", "POINT(3 5)")) + s <- stars::st_as_stars(list(Precipitation = m)) |> + stars::st_set_dimensions(1, values = pts) |> + stars::st_set_dimensions(2, values = times) + }, driver = "netCDF", mdim = TRUE)) + }) + + targets::tar_make() + x <- targets::tar_read(test_stars_mdim) + expect_s3_class(x, "stars") + expect_snapshot(x) +})