Add filetype argument to tar_terra_vect()

R/tar-terra-rast.R

@@ -1,9 +1,11 @@
-#' Create a terra _SpatRaster_ Target
+#' Create a terra _SpatRaster_ target
 #'
-#' Creates a target for a terra _SpatRaster_ object.
+#' Provides a target format for [terra::SpatRaster-class] objects.
 #'
-#' @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 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

R/tar-terra-vect.R

@@ -1,9 +1,18 @@
-#' Targets format for terra vectors
+#' Create a terra _SpatVector_ target
 #'
-#' Provides targets format for `terra::vect` objects
+#' Provides a target format for [terra::SpatVector-class] objects.
 #'
+#' @param filetype character. File format expressed as GDAL driver names passed
+#'   to [terra::writeVector()]. See 'Note' for more details
+#' @param gdal character. GDAL driver specific datasource creation options
+#'   passed to [terra::writeVector()].
+#' @param ... Additional arguments not yet used
 #' @inheritParams targets::tar_target
 #'
+#' @note Although you may pass any supported GDAL vector driver to the
+#'   `filetype` argument, not all formats are guaranteed to work with
+#'   `geotargets`.  At the moment, we have tested `GeoJSON` and `ESRI Shapefile`
+#'   which both appear to work generally.
 #' @export
 #' @examples
 #' if (Sys.getenv("TAR_LONG_EXAMPLES") == "true") {
@@ -29,68 +38,142 @@
 #'   })
 #' }
 tar_terra_vect <- function(name,
-                          command,
-                          pattern = NULL,
-                          packages = targets::tar_option_get("packages"),
-                          tidy_eval = targets::tar_option_get("tidy_eval"),
-                          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")) {
-  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
-  )
-
-  format_terra_shapefile_zip <- targets::tar_format(
-      read = function(path) terra::vect(paste0("/vsizip/{", path, "}")),
-      write = function(object, path) {
-          terra::writeVector(
-              x = object,
-              filename = paste0(path, ".shz"),
-              filetype = "ESRI Shapefile"
-          )
-          file.rename(paste0(path, ".shz"), path)
-      },
-      marshal = function(object) terra::wrap(object),
-      unmarshal = function(object) terra::unwrap(object)
-  )
-
-  targets::tar_target_raw(
-    name = name,
-    command = command,
-    pattern = pattern,
-    packages = packages,
-    library = library,
-    format = format_terra_shapefile_zip,
-    repository = repository,
-    iteration = iteration,
-    error = error,
-    memory = memory,
-    garbage_collection = garbage_collection,
-    deployment = deployment,
-    priority = priority,
-    resources = resources,
-    storage = storage,
-    retrieval = retrieval,
-    cue = cue
-  )
+                           command,
+                           pattern = NULL,
+                           filetype = NULL,
+                           gdal = NULL,
+                           ...,
+                           packages = targets::tar_option_get("packages"),
+                           tidy_eval = targets::tar_option_get("tidy_eval"),
+                           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")) {
+    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
+    filetype <- filetype %||% geotargets_option_get("gdal.vector.driver")
+    gdal <- gdal %||% geotargets_option_get("gdal.vector.creation_options")
+
+    format <- ifelse(
+        test = filetype == "ESRI Shapefile",
+        #special handling of ESRI shapefiles because the output is a dir of multiple files.
+        yes = create_format_terra_vect_shz(options = gdal, ...),
+        no =  create_format_terra_vect(filetype, options = gdal, ...)
+    )
+
+    targets::tar_target_raw(
+        name = name,
+        command = command,
+        pattern = pattern,
+        packages = packages,
+        library = library,
+        format = format,
+        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 filetype File format expressed as GDAL driver names passed to
+#'   `terra::writeVector()`
+#' @param options GDAL driver specific datasource creation options passed to
+#'   `terra::writeVector()`
+#' @param ... Additional arguments not yet used
+#' @noRd
+create_format_terra_vect <- function(filetype, options, ...) {
+
+    if (!requireNamespace("terra")) {
+        stop("package 'terra' is required", call. = FALSE)
+    }
+
+    # get list of drivers available for writing depending on what the user's GDAL supports
+    drv <- terra::gdal(drivers = TRUE)
+    drv <- drv[drv$type == "vector" & grepl("write", drv$can), ]
+
+    if (is.null(filetype)) {
+        filetype <- "GeoJSON"
+    }
+
+    filetype <- match.arg(filetype, drv$name)
+
+    .write_terra_vector <- function(object, path) {
+        terra::writeVector(
+            object,
+            path,
+            filetype = NULL,
+            overwrite = TRUE,
+            options = NULL
+        )
+    }
+    body(.write_terra_vector)[[2]][["filetype"]] <- filetype
+    body(.write_terra_vector)[[2]][["options"]] <- options
+
+    targets::tar_format(
+        read = function(path) terra::vect(path),
+        write = .write_terra_vector,
+        marshal = function(object) terra::wrap(object),
+        unmarshal = function(object) terra::unwrap(object)
+    )
+}
+
+#' Special handling for ESRI Shapefiles
+#' @param options GDAL driver specific datasource creation options passed to
+#'   `terra::writeVector()`
+#' @param ... Additional arguments not yet used
+#' @noRd
+create_format_terra_vect_shz <- function(options, ...) {
+
+    if (!requireNamespace("terra")) {
+        stop("package 'terra' is required", call. = FALSE)
+    }
+
+    .write_terra_vector <- function(object, path) {
+        terra::writeVector(
+            x = object,
+            filename = paste0(path, ".shz"),
+            filetype = "ESRI Shapefile",
+            overwrite = TRUE,
+            options = NULL
+        )
+        file.rename(paste0(path, ".shz"), path)
+    }
+    body(.write_terra_vector)[[2]][["options"]] <- options
+
+    targets::tar_format(
+        read = function(path) terra::vect(paste0("/vsizip/{", path, "}")),
+        write = .write_terra_vector,
+        marshal = function(object) terra::wrap(object),
+        unmarshal = function(object) terra::unwrap(object)
+    )
 }

tests/testthat/_snaps/tar-terra.md

@@ -22,7 +22,24 @@
        geometry    : polygons 
        dimensions  : 12, 6  (geometries, attributes)
        extent      : 5.74414, 6.528252, 49.44781, 50.18162  (xmin, xmax, ymin, ymax)
-       source      : test_terra_vect} (test_terra_vect)
+       source      : test_terra_vect
+       coord. ref. : lon/lat WGS 84 (EPSG:4326) 
+       names       :  ID_1   NAME_1  ID_2   NAME_2  AREA   POP
+       type        : <num>    <chr> <num>    <chr> <num> <int>
+       values      :     1 Diekirch     1 Clervaux   312 18081
+                         1 Diekirch     2 Diekirch   218 32543
+                         1 Diekirch     3  Redange   259 18664
+
+---
+
+    Code
+      y
+    Output
+       class       : SpatVector 
+       geometry    : polygons 
+       dimensions  : 12, 6  (geometries, attributes)
+       extent      : 5.74414, 6.528252, 49.44781, 50.18162  (xmin, xmax, ymin, ymax)
+       source      : test_terra_vect_shz} (test_terra_vect_shz)
        coord. ref. : lon/lat WGS 84 (EPSG:4326) 
        names       :  ID_1   NAME_1  ID_2   NAME_2  AREA   POP
        type        : <num>    <chr> <num>    <chr> <num> <int>

tests/testthat/test-tar-terra.R

@@ -5,7 +5,7 @@ targets::tar_test("tar_terra_rast() works", {
     list(
       geotargets::tar_terra_rast(
         test_terra_rast,
-        system.file("ex/elev.tif", package = "terra") |> terra::rast()
+        terra::rast(system.file("ex/elev.tif", package = "terra"))
       )
     )
   })
@@ -31,13 +31,20 @@ targets::tar_test("tar_terra_vect() works", {
       geotargets::tar_terra_vect(
         test_terra_vect,
         lux_area()
+      ),
+      geotargets::tar_terra_vect(
+          test_terra_vect_shz,
+          lux_area(),
+          filetype = "ESRI Shapefile"
       )
     )
   })
   targets::tar_make()
   x <- targets::tar_read(test_terra_vect)
+  y <- targets::tar_read(test_terra_vect_shz)
   expect_s4_class(x, "SpatVector")
-  expect_snapshot(
-      x
-  )
+  expect_s4_class(y, "SpatVector")
+  expect_snapshot(x)
+  expect_snapshot(y)
+  expect_equal(terra::values(x), terra::values(y))
 })