R/hdf5_utils.R
95e90594
 #-------------------------------------------------------------------------------
 # Is a DelayedMatrix object (or the assays of a SummarizedExperiment object)
 # backed by a HDF5 file?
 #
 
 .getSeedClasses <- function(seed) {
be836cbe
     if (is(seed, "DelayedOp")) {
         seeds <- try(seed@seeds, silent = TRUE)
         if (is(seeds, "try-error")) {
             seed <- seed@seed
             return(.getSeedClasses(seed))
         }
95e90594
         return(lapply(seeds, .getSeedClasses))
     } else if (is(seed, "DelayedArray")) {
         # A DelayedArray can have another DelayedArray as a seed
         seed <- seed@seed
         return(.getSeedClasses(seed))
     }
     else {
56e4d813
         # Pick the first element returned by class() (starting with R 4.0,
         # 'class(matrix())' is 'c("matrix", "array")').
         class(seed)[[1L]]
95e90594
     }
 }
 
 # NOTE: Returns TRUE if *any* assay is HDF5Array-backed and FALSE if *all*
 #       assays are not HDF5Array-backed
 .isHDF5ArrayBacked <- function(object) {
     if (is(object, "SummarizedExperiment")) {
         return(all(vapply(X = assays(object, withDimnames = FALSE),
                           FUN = .isHDF5ArrayBacked,
                           FUN.VALUE = logical(1L))))
     }
     if (is(object, "DelayedArray")) {
         seed <- object@seed
         seed_classes <- .getSeedClasses(seed)
         is_hdf5_backed <- vapply(unlist(seed_classes, use.names = FALSE),
                                  extends, class2 = "HDF5ArraySeed",
                                  logical(1L))
         return(any(is_hdf5_backed))
     } else if (is.matrix(object)) {
         FALSE
     } else if (is.null(object)) {
         FALSE
     } else {
         stop("Don't know how to handle object of class ", class(object))
     }
 }