Deal with realoading SpatRasterImage from RDS #67

Author: lambdamoses

DESCRIPTION

@@ -20,7 +20,7 @@ Description: A new S4 class integrating Simple Features with the R package sf
     be used.
 Imports:
     Biobase,
-    BiocGenerics,
+    BiocGenerics (>= 0.51.2),
     BiocNeighbors,
     BiocParallel,
     data.table,

NAMESPACE

@@ -192,6 +192,7 @@ exportMethods(annotGeometry)
 exportMethods(annotGeometryNames)
 exportMethods(bbox)
 exportMethods(cbind)
+exportMethods(containsOutOfMemoryData)
 exportMethods(cropImg)
 exportMethods(dim)
 exportMethods(dimGeometries)
@@ -230,6 +231,8 @@ importClassesFrom(SpatialExperiment,SpatialExperiment)
 importClassesFrom(SpatialExperiment,VirtualSpatialImage)
 importClassesFrom(terra,SpatRaster)
 importFrom(BiocGenerics,cbind)
+importFrom(BiocGenerics,containsOutOfMemoryData)
+importFrom(BiocGenerics,saveRDS)
 importFrom(BiocGenerics,updateObject)
 importFrom(BiocNeighbors,AnnoyParam)
 importFrom(BiocNeighbors,KmknnParam)

R/AllGenerics.R

@@ -246,7 +246,9 @@ setGeneric("affineImg", function(x, M, v, ...) standardGeneric("affineImg"))
 #' @export
 setGeneric("cropImg", function(x, bbox, ...) standardGeneric("cropImg"))
 
-if (!isGeneric("saveRDS")) {setGeneric("saveRDS", function (object, file="", ascii=FALSE, version=NULL, compress=TRUE, refhook=NULL) standardGeneric("saveRDS"))}
+if (!isGeneric("readRDS")) {
+    setGeneric("readRDS", function(file, refhook = NULL) standardGeneric("readRDS"))
+}
 
 #' @export
 setGeneric("toExtImage", function(x, ...) standardGeneric("toExtImage"))

R/saveRDS.R

@@ -13,6 +13,7 @@
 #' @param object A \code{SpatialFeatureExperiment} object.
 #' @return Invisibly \code{NULL}.
 #' @importFrom terra wrap unwrap
+#' @importFrom BiocGenerics saveRDS
 #' @export
 #' @concept Utilities
 #' @examples
@@ -25,6 +26,10 @@
 setMethod("saveRDS", "SpatialFeatureExperiment",
           function(object, file = "", ascii = FALSE, version = NULL,
                    compress = TRUE, refhook = NULL) {
+              if (containsOutOfMemoryData(object)) {
+                  warning("This object contains out of memory data that may
+                          break when the RDS file is moved.")
+              }
               if (!nrow(imgData(object)))
                   base::saveRDS(object, file = file, ascii = ascii,
                                 version = version, compress = compress,
@@ -67,3 +72,35 @@ setMethod("unwrap", "SpatialFeatureExperiment",
               }
               x
           })
+
+#' Whether an SFE object contains out of memory data
+#' 
+#' Out of memory data, such as \code{DelayedArray}, some \code{SpatRasterImage}
+#' objects, and \code{BioFormatsImage}, will break if saved as RDS. This method
+#' of \code{\link[BiocGenerics]{containsOutOfMemoryData}} checks if an SFE 
+#' object has out of memory data, specifically the images. Having out of memory
+#' data will result into an error when \code{saveRDS} is called; we recommend
+#' using the \code{alabaster.sfe} package instead.
+#' 
+#' @param object An SFE object
+#' @return TRUE or FALSE
+#' @importFrom BiocGenerics containsOutOfMemoryData
+#' @export
+#' @concept Utilities
+#' @examples
+#' outdir <- system.file("extdata", package = "SpatialFeatureExperiment")
+#' samples <- file.path(outdir, paste0("sample0", 1:2))
+#' sfe <- read10xVisiumSFE(samples, type = "sparse", data = "filtered")
+#' containsOutOfMemoryData(sfe)
+setMethod("containsOutOfMemoryData", "SpatialFeatureExperiment",
+          function(object) {
+              imgs <- imgData(object)
+              imgData(object) <- NULL
+              object <- as(object, "SingleCellExperiment")
+              out_se <- containsOutOfMemoryData(object)
+              is_img_om <- vapply(imgs$data, function(x) {
+                  !is.na(imgSource(x))
+              }, FUN.VALUE = logical(1))
+              any(c(out_se, is_img_om))
+          })
+

tests/testthat/test-saveRDS.R

@@ -3,7 +3,7 @@ samples <- file.path(outdir, paste0("sample0", 1:2))
 sfe <- read10xVisiumSFE(samples, type = "sparse", data = "filtered")
 
 test_that("Save SFE with SpatRaster images as RDS", {
-    saveRDS(sfe, "foo.rds")
+    expect_warning(saveRDS(sfe, "foo.rds"), "This object contains out of memory data")
     sfe2 <- readRDS("foo.rds")
     imgs <- imgData(sfe2)$data
     classes <- vapply(imgs, function(x) class(x), FUN.VALUE = character(1))