Removes VRTs on-exit

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mapme.biodiversity
 Title: Efficient Monitoring of Global Biodiversity Portfolios
-Version: 0.8.0.9002
+Version: 0.8.0.9003
 Authors@R: c(
     person("Darius A.", "Görgen", , "darius2402@web.de", role = c("aut", "cre")),
     person("Om Prakash", "Bhandari", role = "aut")

NEWS.md

@@ -1,5 +1,10 @@
 # mapme.biodiversity (development version)
 
+## General
+
+- `prep_resources()` recieved additional argument `mode` to 
+  get control over the reading mode (e.g. portfolio or asset)
+
 ## Bug fixes
 
 - fixes transforming asset to the CRS of raster dataset 
@@ -11,6 +16,7 @@
 
 - `.check_portfolio()` now checks if `assetid` has unique values and only 
   overrides them if this in not the case (#305)
+- `.read_raster()` now reads values into memory and removes VRT files on-exit
 
 # mapme.biodiversity 0.8.0
 

R/calc_indicators.R

@@ -119,7 +119,7 @@ calc_indicators <- function(x, ...) {
     }
 
     results <- furrr::future_map(chunks, function(chunk) {
-      resources <- prep_resources(chunk, avail_resources, req_resources)
+      resources <- prep_resources(chunk, avail_resources, req_resources, mode = "asset")
       result <- .compute(chunk, resources, fun, verbose)
       .check_single_asset(result, chunk)
     }, .options = furrr::furrr_options(seed = TRUE))
@@ -144,7 +144,7 @@ calc_indicators <- function(x, ...) {
                                  aggregation,
                                  verbose) {
   x_bbox <- st_as_sf(st_as_sfc(st_bbox(x)))
-  resources <- prep_resources(x_bbox, avail_resources, req_resources)
+  resources <- prep_resources(x_bbox, avail_resources, req_resources, mode = "portfolio")
   results <- .compute(x, resources, fun, verbose)
   if (!inherits(results, "list")) {
     stop("Expected output for processing mode 'portfolio' is a list.")

R/spatial-utils.R

@@ -35,15 +35,15 @@
 spds_exists <- function(path, oo = character(0), what = c("vector", "raster")) {
   what <- match.arg(what)
   util <- switch(what,
-                 vector = "ogrinfo",
-                 raster = "gdalinfo"
+    vector = "ogrinfo",
+    raster = "gdalinfo"
   )
   opts <- switch(what,
-                 vector = c(
-                   "-json", "-ro", "-so", "-nomd",
-                   "-nocount", "-noextent", "-nogeomtype", oo
-                 ),
-                 raster = c("-json", "-nomd", "-norat", "-noct", oo)
+    vector = c(
+      "-json", "-ro", "-so", "-nomd",
+      "-nocount", "-noextent", "-nogeomtype", oo
+    ),
+    raster = c("-json", "-nomd", "-norat", "-noct", oo)
   )
   if (what == "vector" && sf::sf_extSoftVersion()[["GDAL"]] < "3.7.0") {
     util <- "gdalinfo"
@@ -139,9 +139,9 @@ make_footprints <- function(srcs = NULL,
   if (inherits(srcs, "character")) {
     what <- match.arg(what)
     srcs <- switch(what,
-                   vector = purrr::map2(srcs, oo, function(src, opt) .vector_footprint(src, opt)),
-                   raster = purrr::map2(srcs, oo, function(src, opt) .raster_footprint(src, opt)),
-                   stop("Can make footprints for vector and raster data only.")
+      vector = purrr::map2(srcs, oo, function(src, opt) .vector_footprint(src, opt)),
+      raster = purrr::map2(srcs, oo, function(src, opt) .raster_footprint(src, opt)),
+      stop("Can make footprints for vector and raster data only.")
     )
     srcs <- purrr::list_rbind(srcs)
   }
@@ -167,13 +167,16 @@ make_footprints <- function(srcs = NULL,
 #'   the available resources will automatically be determined.
 #' @param resources A character vector with the resources to be prepared. If it
 #'   it is NULL (the default) all available resources will be prepared.
+#' @param mode A character indicating the reading mode, e.g. either "portfolio"
+#'   (the default) or "asset".
 #'
 #' @return `prep_resources()` returns a list with prepared vector and raster
 #'   resources as `sf` and `SpatRaster`-objects.
 #' @name mapme
 #' @export
-prep_resources <- function(x, avail_resources = NULL, resources = NULL) {
+prep_resources <- function(x, avail_resources = NULL, resources = NULL, mode = c("portfolio", "asset")) {
   stopifnot(nrow(x) == 1)
+  mode <- match.arg(mode)
 
   if (is.null(avail_resources)) avail_resources <- .avail_resources()
   if (length(avail_resources) == 0) {
@@ -188,11 +191,11 @@ prep_resources <- function(x, avail_resources = NULL, resources = NULL) {
     resource <- avail_resources[[resource]]
     resource_type <- unique(resource[["type"]])
     reader <- switch(resource_type,
-                     raster = .read_raster,
-                     vector = .read_vector,
-                     stop(sprintf("Resource type '%s' currently not supported", resource_type))
+      raster = .read_raster,
+      vector = .read_vector,
+      stop(sprintf("Resource type '%s' currently not supported", resource_type))
     )
-    reader(x, resource)
+    reader(x, resource, mode)
   })
   names(out) <- resources
   out
@@ -240,7 +243,7 @@ prep_resources <- function(x, avail_resources = NULL, resources = NULL) {
   st_as_sfc(st_bbox(bbox, crs = crs))
 }
 
-.read_vector <- function(x, tindex) {
+.read_vector <- function(x, tindex, mode = "portfolio") {
   matches <- .get_intersection(x, tindex)
 
   if (nrow(matches) == 0) {
@@ -302,14 +305,16 @@ prep_resources <- function(x, avail_resources = NULL, resources = NULL) {
 }
 
 .raster_bbox <- function(info) {
-
   crs <- st_crs(info[["coordinateSystem"]][["wkt"]])
 
-  bbox <- try({
-    poly <- jsonlite::toJSON(info[["wgs84Extent"]], auto_unbox = TRUE)
-    bbox <- st_read(poly, quiet = TRUE)
-    st_transform(bbox, crs)
-  }, silent = TRUE)
+  bbox <- try(
+    {
+      poly <- jsonlite::toJSON(info[["wgs84Extent"]], auto_unbox = TRUE)
+      bbox <- st_read(poly, quiet = TRUE)
+      st_transform(bbox, crs)
+    },
+    silent = TRUE
+  )
 
   if (inherits(bbox, "try-error") || st_is_empty(bbox)) {
     coords <- info[["cornerCoordinates"]]
@@ -324,7 +329,7 @@ prep_resources <- function(x, avail_resources = NULL, resources = NULL) {
   bbox
 }
 
-.read_raster <- function(x, tindex) {
+.read_raster <- function(x, tindex, mode = "portfolio") {
   x <- st_as_sfc(st_bbox(x))
   if (st_crs(x) != st_crs(tindex)) {
     x <- st_transform(x, st_crs(tindex))
@@ -350,13 +355,15 @@ prep_resources <- function(x, avail_resources = NULL, resources = NULL) {
     stop("Did not find equal number of tiles per timestep.")
   }
 
-  out <- lapply(1:n_timesteps, function(i) {
+  vrts <- sapply(1:n_timesteps, function(i) tempfile(fileext = ".vrt"))
+  if (mode == "asset") on.exit(file.remove(vrts))
+
+  out <- purrr::map2(1:n_timesteps, vrts, function(i, vrt) {
     index <- rep(FALSE, n_timesteps)
     index[i] <- TRUE
     filenames <- names(grouped_geoms[index])
     layer_name <- tools::file_path_sans_ext(basename(filenames[1]))
-    vrt_name <- tempfile(pattern = sprintf("vrt_%s", layer_name), fileext = ".vrt")
-    tmp <- terra::vrt(filenames, filename = vrt_name)
+    tmp <- terra::vrt(filenames, filename = vrt)
     names(tmp) <- layer_name
     tmp
   })
@@ -368,6 +375,7 @@ prep_resources <- function(x, avail_resources = NULL, resources = NULL) {
     warning(as.character(cropped))
     return(NULL)
   }
+  if (mode == "asset") cropped[] <- terra::values(cropped)
   cropped
 }
 
@@ -401,8 +409,8 @@ prep_resources <- function(x, avail_resources = NULL, resources = NULL) {
   }
 
   util <- switch(what,
-                 vector = "vectortranslate",
-                 raster = "translate"
+    vector = "vectortranslate",
+    raster = "translate"
   )
   try(sf::gdal_utils(
     util = util,

tests/testthat/test-calc_indicator.R

@@ -242,6 +242,30 @@ test_that("prep_resources works correctly", {
 })
 
 
+test_that("VRT deletion works as expected", {
+  .clear_resources()
+  x <- read_sf(
+    system.file("extdata", "gfw_sample.gpkg",
+      package = "mapme.biodiversity"
+    )
+  )
+
+  xb <- st_buffer(x, 10000)
+  x2 <- st_as_sf(st_as_sfc(st_bbox(xb)))
+
+  r <- rast(ext(xb), nrows = 100, ncols = 100)
+  r[] <- runif(ncell(r))
+  f <- tempfile(fileext = ".tif")
+  writeRaster(r, f)
+  fps <- list(test = make_footprints(f, what = "raster"))
+
+  out <- prep_resources(x, avail_resources = fps, resources = "test", mode = "asset")
+  expect_true(inMemory(out$test))
+  out <- prep_resources(x2, avail_resources = fps, resources = "test", mode = "portfolio")
+  expect_true(file.exists(sources(out$test)))
+})
+
+
 test_that(".read_raster works correctly", {
   dummy <- terra::rast()
   dummy_splitted <- aggregate(dummy, fact = c(ceiling(nrow(dummy) / 4), ceiling(ncol(dummy) / 4)))