tar_stars: Add support for storage of arbitrary multidimensional arrays

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
     }

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
 

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]
+

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)
+})