From fc5d7143cd3e5ec67676f6565c916990ac96968f Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Sat, 27 Apr 2024 07:31:00 -0700 Subject: [PATCH 1/6] Fixes for options updates - handle case when getOption() returns vector length >1 - fix get_gdal_available_driver_list() for terra::gdal(drivers=TRUE) - Fix specification of raster creation options in tar_terra_sprc() test --- R/geotargets-option.R | 2 +- R/utils.R | 4 ++-- tests/testthat/_snaps/tar-terra-sprc.md | 14 ++++++++++++++ tests/testthat/test-tar-terra-sprc.R | 2 +- 4 files changed, 18 insertions(+), 4 deletions(-) create mode 100644 tests/testthat/_snaps/tar-terra-sprc.md diff --git a/R/geotargets-option.R b/R/geotargets-option.R index f501a4f..b8c7d8a 100644 --- a/R/geotargets-option.R +++ b/R/geotargets-option.R @@ -65,7 +65,7 @@ geotargets_option_get <- function(name) { opt <- getOption(option_name, default = Sys.getenv(env_name)) #replace empty string from Sys.getenv default with NULL - if (opt == "") { + if (length(opt) == 1 && opt == "") { opt <- NULL } #return diff --git a/R/utils.R b/R/utils.R index e407bad..a2632d7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -15,9 +15,9 @@ check_pkg_installed <- function(pkg, call = rlang::caller_env()) { } } -get_gdal_available_driver_list <- function(driver_type){ +get_gdal_available_driver_list <- function(driver_type) { # get list of drivers available for writing depending on what the user's GDAL supports drv <- terra::gdal(drivers = TRUE) - drv <- drv[drv$type == driver_type & grepl("write", drv$can), ] + drv <- drv[drv[[driver_type]] & grepl("write", drv$can), ] drv } diff --git a/tests/testthat/_snaps/tar-terra-sprc.md b/tests/testthat/_snaps/tar-terra-sprc.md new file mode 100644 index 0000000..3aaf79d --- /dev/null +++ b/tests/testthat/_snaps/tar-terra-sprc.md @@ -0,0 +1,14 @@ +# tar_terra_sprc() works + + Code + x + Output + class : SpatRasterCollection + length : 2 + nrow : 90, 115 + ncol : 95, 114 + nlyr : 1, 1 + extent : 5.741667, 1558890, 49.44167, 5556741 (xmin, xmax, ymin, ymax) + crs (first) : lon/lat WGS 84 (EPSG:4326) + names : raster_elevs, raster_elevs + diff --git a/tests/testthat/test-tar-terra-sprc.R b/tests/testthat/test-tar-terra-sprc.R index 6c9aa58..e2d6bf2 100644 --- a/tests/testthat/test-tar-terra-sprc.R +++ b/tests/testthat/test-tar-terra-sprc.R @@ -1,6 +1,6 @@ targets::tar_test("tar_terra_sprc() works", { geotargets::geotargets_option_set( - "raster_gdal_creation_options", + gdal_raster_creation_options = c("COMPRESS=DEFLATE", "TFW=YES") ) targets::tar_script({ From 23ce0a3ebf8bfe00ab4df6dcd7bdad71148cfea0 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Sat, 27 Apr 2024 08:12:20 -0700 Subject: [PATCH 2/6] get_gdal_available_driver_list: check terra version --- R/utils.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index a2632d7..b6d4b1d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -18,6 +18,10 @@ check_pkg_installed <- function(pkg, call = rlang::caller_env()) { get_gdal_available_driver_list <- function(driver_type) { # get list of drivers available for writing depending on what the user's GDAL supports drv <- terra::gdal(drivers = TRUE) - drv <- drv[drv[[driver_type]] & grepl("write", drv$can), ] + if (utils::packageVersion("terra") > "1.7-74") { + drv <- drv[drv[[driver_type]] & grepl("write", drv$can), ] + } else { + drv <- drv[drv$type == driver_type & grepl("write", drv$can), ] + } drv } From 2b8806b01f7fe775110326a50b8dbe87a4e24e61 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Sat, 27 Apr 2024 09:29:46 -0700 Subject: [PATCH 3/6] tar_terra_sprc: fix creation option name --- R/tar-terra-sprc.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tar-terra-sprc.R b/R/tar-terra-sprc.R index 7660f66..b4903fc 100644 --- a/R/tar-terra-sprc.R +++ b/R/tar-terra-sprc.R @@ -92,7 +92,7 @@ tar_terra_sprc <- function(name, filetype <- filetype %||% geotargets_option_get("gdal.raster.driver") filetype <- rlang::arg_match0(filetype, drv$name) - gdal <- gdal %||% geotargets_option_get("gdal.raster.creation_options") + gdal <- gdal %||% geotargets_option_get("gdal.raster.creation.options") .write_terra_rasters_sprc <- eval( substitute( From db37255fb6da48dd5c6b1fda813e8e94cc26ced0 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Sat, 27 Apr 2024 09:34:04 -0700 Subject: [PATCH 4/6] don't use "ENCODING=UTF-8" as default for raster output files --- R/tar-terra-rast.R | 2 +- R/tar-terra-sprc.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/tar-terra-rast.R b/R/tar-terra-rast.R index 12d89ae..f2d5db6 100644 --- a/R/tar-terra-rast.R +++ b/R/tar-terra-rast.R @@ -49,7 +49,7 @@ tar_terra_rast <- function(name, retrieval = targets::tar_option_get("retrieval"), cue = targets::tar_option_get("cue")) { filetype <- filetype %||% "GTiff" - gdal <- gdal %||% "ENCODING=UTF-8" + gdal <- gdal %||% character(0) #check that filetype option is available drv <- get_gdal_available_driver_list("raster") diff --git a/R/tar-terra-sprc.R b/R/tar-terra-sprc.R index b4903fc..84ac6c7 100644 --- a/R/tar-terra-sprc.R +++ b/R/tar-terra-sprc.R @@ -62,7 +62,7 @@ tar_terra_sprc <- function(name, retrieval = targets::tar_option_get("retrieval"), cue = targets::tar_option_get("cue")) { filetype <- filetype %||% "GTiff" - gdal <- gdal %||% "ENCODING=UTF-8" + gdal <- gdal %||% character(0) # check that filetype option is available drv <- get_gdal_available_driver_list("raster") From 55cfe11fb280eeb31569e589d6d24ce7511562b8 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Sat, 27 Apr 2024 11:40:07 -0700 Subject: [PATCH 5/6] tar_terra_rast: fix support for multiple raster creation options --- R/tar-terra-rast.R | 4 ++-- tests/testthat/test-tar-terra.R | 20 ++++++++++++++++++++ 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/R/tar-terra-rast.R b/R/tar-terra-rast.R index f2d5db6..3bccfc8 100644 --- a/R/tar-terra-rast.R +++ b/R/tar-terra-rast.R @@ -87,7 +87,7 @@ tar_terra_rast <- function(name, path, filetype = Sys.getenv("GEOTARGETS_GDAL_RASTER_DRIVER"), overwrite = TRUE, - gdal = Sys.getenv("GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS") + gdal = strsplit(Sys.getenv("GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS", unset = ";"), ";")[[1]] ) }, marshal = function(object) terra::wrap(object), @@ -104,7 +104,7 @@ tar_terra_rast <- function(name, 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" = gdal) + "GEOTARGETS_GDAL_RASTER_CREATION_OPTIONS" = paste0(gdal, collapse = ";")) ) ), storage = storage, diff --git a/tests/testthat/test-tar-terra.R b/tests/testthat/test-tar-terra.R index a4c550f..9f14351 100644 --- a/tests/testthat/test-tar-terra.R +++ b/tests/testthat/test-tar-terra.R @@ -17,6 +17,26 @@ targets::tar_test("tar_terra_rast() works", { ) }) +targets::tar_test("tar_terra_rast(zipfile=TRUE) works", { + # geotargets::geotargets_option_set(gdal_raster_creation_options = c("COMPRESS=DEFLATE", "TFW=YES")) + targets::tar_script({ + list( + geotargets::tar_terra_rast( + test_terra_rast2, + terra::rast(system.file("ex/elev.tif", package = "terra")), + gdal = c("STREAMABLE_OUTPUT=YES", "COMPRESS=NONE"), + zipfile = TRUE + ) + ) + }) + targets::tar_make() + x <- targets::tar_read(test_terra_rast2) + expect_s4_class(x, "SpatRaster") + expect_snapshot( + x + ) +}) + targets::tar_test("tar_terra_vect() works", { targets::tar_script({ lux_area <- function(projection = "EPSG:4326") { From 8f842498ad38da1df4c6a236846ea0335b2c31d2 Mon Sep 17 00:00:00 2001 From: Andrew Gene Brown Date: Sat, 27 Apr 2024 11:48:07 -0700 Subject: [PATCH 6/6] tar_terra_vect: fix use of multiple creation options via env vars --- R/tar-terra-vect.R | 6 +++--- tests/testthat/test-tar-terra.R | 20 -------------------- 2 files changed, 3 insertions(+), 23 deletions(-) diff --git a/R/tar-terra-vect.R b/R/tar-terra-vect.R index 86266f7..5cc31c0 100644 --- a/R/tar-terra-vect.R +++ b/R/tar-terra-vect.R @@ -106,7 +106,7 @@ tar_terra_vect <- function(name, custom_format = targets::tar_resources_custom_format( #these envvars are used in write function of format envvars = c("GEOTARGETS_GDAL_VECTOR_DRIVER" = filetype, - "GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS" = gdal) + "GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS" = paste0(gdal, collapse = ";")) ) ), storage = storage, @@ -129,7 +129,7 @@ create_format_terra_vect <- function() { path, filetype = Sys.getenv("GEOTARGETS_GDAL_VECTOR_DRIVER"), overwrite = TRUE, - options = Sys.getenv("GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS") + options = strsplit(Sys.getenv("GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS", unset = ";"), ";")[[1]] ) }, marshal = function(object) terra::wrap(object), @@ -151,7 +151,7 @@ create_format_terra_vect_shz <- function() { filename = paste0(path, ".shz"), filetype = "ESRI Shapefile", overwrite = TRUE, - options = Sys.getenv("GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS") + options = strsplit(Sys.getenv("GEOTARGETS_GDAL_VECTOR_CREATION_OPTIONS", unset = ";"), ";")[[1]] ) file.rename(paste0(path, ".shz"), path) }, diff --git a/tests/testthat/test-tar-terra.R b/tests/testthat/test-tar-terra.R index 9f14351..a4c550f 100644 --- a/tests/testthat/test-tar-terra.R +++ b/tests/testthat/test-tar-terra.R @@ -17,26 +17,6 @@ targets::tar_test("tar_terra_rast() works", { ) }) -targets::tar_test("tar_terra_rast(zipfile=TRUE) works", { - # geotargets::geotargets_option_set(gdal_raster_creation_options = c("COMPRESS=DEFLATE", "TFW=YES")) - targets::tar_script({ - list( - geotargets::tar_terra_rast( - test_terra_rast2, - terra::rast(system.file("ex/elev.tif", package = "terra")), - gdal = c("STREAMABLE_OUTPUT=YES", "COMPRESS=NONE"), - zipfile = TRUE - ) - ) - }) - targets::tar_make() - x <- targets::tar_read(test_terra_rast2) - expect_s4_class(x, "SpatRaster") - expect_snapshot( - x - ) -}) - targets::tar_test("tar_terra_vect() works", { targets::tar_script({ lux_area <- function(projection = "EPSG:4326") {