R/hdf5_utils.R

In kasperdanielhansen/bsseq: Analyze, manage and store whole-genome methylation data

#-------------------------------------------------------------------------------
# Is a DelayedMatrix object (or the assays of a SummarizedExperiment object)
# backed by a HDF5 file?
#

.getSeedClasses <- function(seed) {
    if (is(seed, "DelayedOp")) {
        seeds <- try(seed@seeds, silent = TRUE)
        if (is(seeds, "try-error")) {
            seed <- seed@seed
            return(.getSeedClasses(seed))
        }
        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 {
        # Pick the first element returned by class() (starting with R 4.0,
        # 'class(matrix())' is 'c("matrix", "array")').
        class(seed)[[1L]]
    }
}

# 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))
    }
}