Merge pull request #168 from pfuehrlich-pik/master

restore units, time, names when loading terra objects from cache

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '6449535'
+ValidationKey: '6469352'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

CITATION.cff

@@ -2,8 +2,8 @@ cff-version: 1.2.0
 message: If you use this software, please cite it using the metadata from this file.
 type: software
 title: 'madrat: May All Data be Reproducible and Transparent (MADRaT) *'
-version: 3.3.1
-date-released: '2023-05-08'
+version: 3.3.2
+date-released: '2023-05-09'
 abstract: Provides a framework which should improve reproducibility and transparency
   in data processing. It provides functionality such as automatic meta data creation
   and management, rudimentary quality management, data caching, work-flow management

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: madrat
 Title: May All Data be Reproducible and Transparent (MADRaT) *
-Version: 3.3.1
-Date: 2023-05-08
+Version: 3.3.2
+Date: 2023-05-09
 Authors@R: c(
     person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = c("aut", "cre")),
     person("Lavinia", "Baumstark", , "lavinia@pik-potsdam.de", role = "aut"),

R/cacheGet.R

@@ -17,10 +17,17 @@
 #' @importFrom digest digest
 cacheGet <- function(prefix, type, args = NULL, graph = NULL, ...) {
 
-  .spatRasterLoad <- function(x) {
-    if (!requireNamespace("terra", quietly = TRUE)) stop("Package `terra` required for caching of SpatRaster objects!")
-    out <- terra::rast(x$file)
-    names(out) <- x$names
+  .terraLoad <- function(x) {
+    if (!requireNamespace("terra", quietly = TRUE)) {
+      stop("Package `terra` required for caching of terra objects!")
+    }
+
+    if (inherits(x, c("PackedSpatRaster", "PackedSpatVector"))) {
+      out <- terra::unwrap(x)
+    } else {
+      out <- terra::rast(x$file)
+    }
+
     return(out)
   }
 
@@ -43,16 +50,9 @@ cacheGet <- function(prefix, type, args = NULL, graph = NULL, ...) {
     vcat(0, " - corrupt cache file ", basename(fname), "! Continue without cache.")
     return(NULL)
   }
-  if (is.list(x)) {
-    for (elem in c("x", "weight")) {
-      if (is.list(x[[elem]]) && identical(x[[elem]]$class, "SpatRaster")) {
-        x[[elem]] <- .spatRasterLoad(x[[elem]])
-      } else if (inherits(x[[elem]], c("PackedSpatRaster", "PackedSpatVector"))) {
-        if (!requireNamespace("terra", quietly = TRUE)) {
-          stop("Package `terra` is required for reading SpatRaster/SpatVector objects from cache!")
-        }
-        x[[elem]] <- terra::unwrap(x[[elem]])
-      }
+  if (is.list(x) && isTRUE(x$class %in% c("SpatRaster", "SpatVector"))) {
+    for (elem in intersect(names(x), c("x", "weight"))) {
+      x[[elem]] <- .terraLoad(x[[elem]])
     }
   }
   attr(x, "id") <- fname

R/cachePut.R

@@ -58,13 +58,13 @@ toolTerraToCache <- function(x, name, fname) {
     return(terra::wrap(x))
   }
 
-  # copy all source files into the cache
   sources <- terra::sources(x)
   if ("" %in% sources) {
     stop("file-based and in-memory parts in the same terra object can currently not be cached")
   }
   # the regex deals with sources such as 'NETCDF:"/PIK/inputdata/sources/LUH2v2h/states.nc":primf'
   sourceFiles <- unique(gsub('^[^"]*"|"[^"]*$', "", sources))
+  # copy all source files into the cache
   for (sourceFile in sourceFiles) {
     targetName <- paste0(file_path_sans_ext(fname), "-", name, ".", file_ext(sourceFile))
     sources <- sub(sourceFile, targetName, sources, fixed = TRUE)
@@ -87,7 +87,26 @@ toolTerraToCache <- function(x, name, fname) {
   stopifnot(identical(intersect(sources, terra::sources(x)), character(0)))
 
   # re-create x using sources copied to the cache
-  out <- if (inherits(x, "SpatVector")) terra::vect(sources) else terra::rast(sources)
-  names(out) <- names(x)
-  return(terra::wrap(out))
+  if (inherits(x, "SpatVector")) {
+    x2 <- terra::vect(sources)
+  } else if (inherits(x, "SpatRaster")) {
+    x2 <- terra::rast(sources)
+    if (length(terra::units(x2)) == length(terra::units(x))) {
+      terra::units(x2) <- terra::units(x)
+    }
+    if (length(terra::time(x2)) == length(terra::time(x))) {
+      terra::time(x2) <- terra::time(x)
+    }
+  } else {
+    stop("Expected x to be SpatVector or SpatRaster")
+  }
+
+  if (length(names(x2)) == length(names(x))) {
+    names(x2) <- names(x)
+  } else {
+    stop("Cannot cache this terra object, because loading it from cache would yield a different number of layers. ",
+         "Add `cache = FALSE` to the returned list to disable caching.")
+  }
+
+  return(terra::wrap(x2))
 }

README.md

@@ -1,6 +1,6 @@
 # May All Data be Reproducible and Transparent (MADRaT) *
 
-R package **madrat**, version **3.3.1**
+R package **madrat**, version **3.3.2**
 
 [![CRAN status](https://www.r-pkg.org/badges/version/madrat)](https://cran.r-project.org/package=madrat) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1115490.svg)](https://doi.org/10.5281/zenodo.1115490) [![R build status](https://github.com/pik-piam/madrat/workflows/check/badge.svg)](https://github.com/pik-piam/madrat/actions) [![codecov](https://codecov.io/gh/pik-piam/madrat/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/madrat) [![r-universe](https://pik-piam.r-universe.dev/badges/madrat)](https://pik-piam.r-universe.dev/builds)
 
@@ -55,7 +55,7 @@ In case of questions / problems please contact Jan Philipp Dietrich <dietrich@pi
 
 To cite package **madrat** in publications use:
 
-Dietrich J, Baumstark L, Wirth S, Giannousakis A, Rodrigues R, Bodirsky B, Kreidenweis U, Klein D, Führlich P (2023). _madrat: May All Data be Reproducible and Transparent (MADRaT)_. doi: 10.5281/zenodo.1115490 (URL: https://doi.org/10.5281/zenodo.1115490), R package version 3.3.1, <URL: https://github.com/pik-piam/madrat>.
+Dietrich J, Baumstark L, Wirth S, Giannousakis A, Rodrigues R, Bodirsky B, Kreidenweis U, Klein D, Führlich P (2023). _madrat: May All Data be Reproducible and Transparent (MADRaT)_. doi:10.5281/zenodo.1115490 <https://doi.org/10.5281/zenodo.1115490>, R package version 3.3.2, <https://github.com/pik-piam/madrat>.
 
 A BibTeX entry for LaTeX users is
 
@@ -64,7 +64,7 @@ A BibTeX entry for LaTeX users is
   title = {madrat: May All Data be Reproducible and Transparent (MADRaT)},
   author = {Jan Philipp Dietrich and Lavinia Baumstark and Stephen Wirth and Anastasis Giannousakis and Renato Rodrigues and Benjamin Leon Bodirsky and Ulrich Kreidenweis and David Klein and Pascal Führlich},
   year = {2023},
-  note = {R package version 3.3.1},
+  note = {R package version 3.3.2},
   doi = {10.5281/zenodo.1115490},
   url = {https://github.com/pik-piam/madrat},
 }

tests/testthat/test-caching.R

@@ -113,15 +113,19 @@ test_that("terra objects can be cached", {
   readSingleSource <- function() {
     x <- terra::rast(system.file("ex/meuse.tif", package = "terra"))
     names(x) <- "something"
+    terra::units(x) <- "some unit"
+    terra::time(x) <- 1234
     return(list(x = x, class = "SpatRaster"))
   }
   globalassign("downloadSingleSource", "readSingleSource")
   expect_message(a <- readSource("SingleSource"), "writing cache")
   expect_message(b <- readSource("SingleSource"), "loading cache")
   # converting to data frame because terra::sources is different
   expect_equal(terra::as.data.frame(a, xy = TRUE),
-                   terra::as.data.frame(b, xy = TRUE))
+               terra::as.data.frame(b, xy = TRUE))
   expect_identical(names(a), names(b))
+  expect_identical(terra::units(a), terra::units(b))
+  expect_equal(terra::time(a), terra::time(b))
 
 
   downloadInMemory <- function() {
@@ -138,7 +142,7 @@ test_that("terra objects can be cached", {
   expect_message(b <- readSource("InMemory"), "loading cache")
   # converting to data frame because terra::sources is different
   expect_equal(terra::as.data.frame(a, xy = TRUE),
-                   terra::as.data.frame(b, xy = TRUE))
+               terra::as.data.frame(b, xy = TRUE))
   expect_identical(names(a), names(b))
 
 
@@ -147,7 +151,7 @@ test_that("terra objects can be cached", {
   }
   readMultiSource <- function() {
     a <- terra::rast(system.file("ex/meuse.tif", package = "terra"))
-    a <- c(a, a) # one SpatRaster from source file, one in-memory
+    a <- c(a, a)
     names(a) <- c("something", "else")
     return(list(x = a, class = "SpatRaster"))
   }
@@ -156,10 +160,9 @@ test_that("terra objects can be cached", {
   expect_message(b <- readSource("MultiSource"), "loading cache")
   # converting to data frame because terra::sources is different
   expect_equal(terra::as.data.frame(a, xy = TRUE),
-                   terra::as.data.frame(b, xy = TRUE))
+               terra::as.data.frame(b, xy = TRUE))
   expect_identical(names(a), names(b))
 
-
   readMultiSource <- function() {
     a <- terra::rast(system.file("ex/meuse.tif", package = "terra"))
     a <- c(a, a * 2) # one SpatRaster from source file, one in-memory
@@ -181,8 +184,8 @@ test_that("terra objects can be cached", {
   expect_message(a <- readSource("SpatVector"), "writing cache")
   expect_message(b <- readSource("SpatVector"), "loading cache")
   # converting to data frame because terra::sources is different
-  expect_identical(terra::as.data.frame(a, geom = "WKT"),
-                   terra::as.data.frame(b, geom = "WKT"))
+  expect_equal(terra::as.data.frame(a, geom = "WKT"),
+               terra::as.data.frame(b, geom = "WKT"))
   expect_identical(names(a), names(b))
 
 
@@ -197,7 +200,7 @@ test_that("terra objects can be cached", {
   expect_message(a <- readSource("InMemoryVector"), "writing cache")
   expect_message(b <- readSource("InMemoryVector"), "loading cache")
   # converting to data frame because terra::sources is different
-  expect_identical(terra::as.data.frame(a, geom = "WKT"),
-                   terra::as.data.frame(b, geom = "WKT"))
+  expect_equal(terra::as.data.frame(a, geom = "WKT"),
+               terra::as.data.frame(b, geom = "WKT"))
   expect_identical(names(a), names(b))
 })