@@ -109,7 +109,7 @@

                         ncol = 1)

                 }

                 ipclock(sink_lock)

-                write_block(x = sink, viewport = sink_grid[[b]], block = ans)

+                write_block(sink, viewport = sink_grid[[b]], block = ans)

                 ipcunlock(sink_lock)

                 NULL

             },

@@ -194,7 +194,7 @@

                         nrow = 1)

                 }

                 ipclock(sink_lock)

-                write_block(x = sink, viewport = sink_grid[[b]], block = ans)

+                write_block(sink, viewport = sink_grid[[b]], block = ans)

                 ipcunlock(sink_lock)

                 NULL

             },

@@ -272,7 +272,7 @@ blockApplyWithRealization <- function(x, FUN, ..., sink = NULL, x_grid = NULL,

         block_ans <- FUN(block, ...)

         # NOTE: This is the only part different from DelayedArray::blockApply()

         if (!is.null(sink)) {

-            write_block(x = sink, viewport = sink_viewport, block = block_ans)

+            write_block(sink, viewport = sink_viewport, block = block_ans)

             block_ans <- NULL

         }

         if (DelayedArray:::get_verbose_block_processing()) {

@@ -89,7 +89,7 @@

         # Construct ArrayGrid --------------------------------------------------

-        sink_grid <- colGrid(x = sink, ncol = 1L)

+        sink_grid <- colAutoGrid(x = sink, ncol = 1L)

         list_of_cols <- split(seq_along(group), group)[ugroup]

         # Compute colsum() -----------------------------------------------------

@@ -174,7 +174,7 @@

         # Construct ArrayGrid --------------------------------------------------

-        sink_grid <- rowGrid(x = sink, nrow = 1L)

+        sink_grid <- rowAutoGrid(x = sink, nrow = 1L)

         list_of_rows <- split(seq_along(group), group)[as.character(ugroup)]

         # Compute colsum() -----------------------------------------------------

@@ -251,8 +251,8 @@ blockApplyWithRealization <- function(x, FUN, ..., sink = NULL, x_grid = NULL,

     FUN <- match.fun(FUN)

     # Check conformable dots_grids and sinks_grids

-    x_grid <- DelayedArray:::.normarg_grid(x_grid, x)

-    sink_grid <- DelayedArray:::.normarg_grid(sink_grid, sink)

+    x_grid <- DelayedArray:::normarg_grid(x_grid, x)

+    sink_grid <- DelayedArray:::normarg_grid(sink_grid, sink)

     if (!identical(dim(x_grid), dim(sink_grid))) {

         stop("non-conformable 'x_grid' and 'sink_grid'")

     }

@@ -1,4 +1,4 @@

-# Functions/methods that would be good to have in DelayedArray

+# Functions/methods that would be good to have in DelayedArray -----------------

 .rowVars <- function(x, rows = NULL, cols = NULL, ...) {

     if (is(x, "DelayedArray")) {

@@ -41,6 +41,176 @@

     }

 }

+# A temporary workaround to

+# https://github.com/Bioconductor/DelayedArray/issues/41.

+.colsum <- function(x, group, reorder = TRUE, na.rm = FALSE, filepath = NULL,

+                    name = NULL, chunkdim = NULL, level = NULL,

+                    type = c("double", "integer"), BPPARAM = bpparam()) {

+

+    # NOTE: Special case for HDF5Matrix, otherwise defer to rowsum().

+    if (is(x, "HDF5Matrix")) {

+        # Check arguments ------------------------------------------------------

+

+        type <- match.arg(type)

+        if (any(!c(type(x), type) %in% c("integer", "double"))) {

+            stop("'type(x)' must be 'integer' or 'double'.")

+        }

+        if (length(group) != NCOL(x)) {

+            stop("incorrect length for 'group'")

+        }

+        if (anyNA(group)) {

+            warning("missing values for 'group'")

+        }

+        ugroup <- unique(group)

+        if (reorder) {

+            ugroup <- sort(ugroup, na.last = TRUE, method = "quick")

+        }

+        # TODO: Default is type = "double" because rowSums2() returns numeric,

+        #       but it can be useful to manually override this when you know

+        #       the result is integer.

+

+        # Construct RealizationSink --------------------------------------------

+

+        # NOTE: This is ultimately coerced to the output DelayedMatrix

+        #       object

+        ans_nrow <- nrow(x)

+        ans_ncol <- length(ugroup)

+        ans_dim <- c(ans_nrow, ans_ncol)

+        sink <- HDF5RealizationSink(

+            dim = ans_dim,

+            dimnames = list(rownames(x), as.character(ugroup)),

+            type = type,

+            filepath = filepath,

+            name = name,

+            chunkdim = chunkdim,

+            level = level)

+        sink_lock <- ipcid()

+        on.exit(ipcremove(sink_lock), add = TRUE)

+

+        # Construct ArrayGrid --------------------------------------------------

+

+        sink_grid <- colGrid(x = sink, ncol = 1L)

+        list_of_cols <- split(seq_along(group), group)[ugroup]

+

+        # Compute colsum() -----------------------------------------------------

+

+        bplapply(

+            X = seq_along(sink_grid),

+            FUN = function(b, x, sink, sink_lock, sink_grid, list_of_cols) {

+                cols <- list_of_cols[[b]]

+                if (length(cols) == 1L) {

+                    ans <- as.matrix(x[, cols, drop = FALSE])

+                    if (na.rm) {

+                        ans[is.na(ans)] <- 0L

+                    }

+                } else {

+                    ans <- matrix(

+                        rowSums2(x, cols = cols, na.rm = na.rm),

+                        ncol = 1)

+                }

+                ipclock(sink_lock)

+                write_block(x = sink, viewport = sink_grid[[b]], block = ans)

+                ipcunlock(sink_lock)

+                NULL

+            },

+            x = x,

+            sink = sink,

+            sink_lock = sink_lock,

+            sink_grid = sink_grid,

+            list_of_cols = list_of_cols,

+            BPPARAM = BPPARAM)

+        return(as(sink, "DelayedArray"))

+    }

+

+    colsum(x, group, reorder)

+}

+

+# A temporary workaround to

+# https://github.com/Bioconductor/DelayedArray/issues/41.

+.rowsum <- function(x, group, reorder = TRUE, na.rm = FALSE, filepath = NULL,

+                    name = NULL, chunkdim = NULL, level = NULL,

+                    type = c("double", "integer"), BPPARAM = bpparam()) {

+

+    # NOTE: Special case for HDF5Matrix, otherwise defer to rowsum().

+    if (is(x, "HDF5Matrix")) {

+

+        # Check arguments ------------------------------------------------------

+

+        if (any(!c(type(x), type) %in% c("integer", "double"))) {

+            stop("'type(x)' must be 'integer' or 'double'.")

+        }

+        if (length(group) != NROW(x)) {

+            stop("incorrect length for 'group'")

+        }

+        if (anyNA(group)) {

+            warning("missing values for 'group'")

+        }

+        ugroup <- unique(group)

+        if (reorder) {

+            ugroup <- sort(ugroup, na.last = TRUE, method = "quick")

+        }

+        # NOTE: Default is type = "double" because colSums2() returns numeric,

+        #       but it can be useful to manually override this when you know the

+        #       result is integer.

+        type <- match.arg(type)

+

+        # Construct RealizationSink --------------------------------------------

+

+        # NOTE: This is ultimately coerced to the output DelayedMatrix

+        #       object

+        ans_nrow <- length(ugroup)

+        ans_ncol <- ncol(x)

+        ans_dim <- c(ans_nrow, ans_ncol)

+        sink <- HDF5RealizationSink(

+            dim = ans_dim,

+            dimnames = list(as.character(ugroup), colnames(x)),

+            type = type,

+            filepath = filepath,

+            name = name,

+            chunkdim = chunkdim,

+            level = level)

+        sink_lock <- ipcid()

+        on.exit(ipcremove(sink_lock), add = TRUE)

+

+        # Construct ArrayGrid --------------------------------------------------

+

+        sink_grid <- rowGrid(x = sink, nrow = 1L)

+        list_of_rows <- split(seq_along(group), group)[as.character(ugroup)]

+

+        # Compute colsum() -----------------------------------------------------

+

+        bplapply(

+            X = seq_along(sink_grid),

+            FUN = function(b, x, sink, sink_lock, sink_grid, list_of_rows) {

+                rows <- list_of_rows[[b]]

+                if (length(rows) == 1L) {

+                    ans <- as.matrix(x[rows, , drop = FALSE])

+                    if (na.rm) {

+                        ans[is.na(ans)] <- 0L

+                    }

+                } else {

+                    ans <- matrix(

+                        colSums2(x, rows = rows, na.rm = na.rm),

+                        nrow = 1)

+                }

+                ipclock(sink_lock)

+                write_block(x = sink, viewport = sink_grid[[b]], block = ans)

+                ipcunlock(sink_lock)

+                NULL

+            },

+            x = x,

+            sink = sink,

+            sink_lock = sink_lock,

+            sink_grid = sink_grid,

+            list_of_rows = list_of_rows,

+            BPPARAM = BPPARAM)

+        return(as(sink, "DelayedArray"))

+    }

+

+    rowsum(x, group, reorder)

+}

+

+

 # Missing methods --------------------------------------------------------------

 # NOTE: Copied from minfi

@@ -135,12 +135,13 @@ blockApplyWithRealization <- function(x, FUN, ..., sink = NULL, x_grid = NULL,

 #       can contain other files besides these; check.

 .isHDF5BackedBSseqUpdatable <- function(x) {

     stopifnot(is(x, "BSseq"))

-    if (!identical(.getBSseqBackends(x), "HDF5Array")) {

+    assay_class <- vapply(assays(x, withDimnames = FALSE), class, character(1L))

+    if (!all(assay_class == "HDF5Matrix")) {

         return(FALSE)

     }

     paths <- vapply(assays(x, withDimnames = FALSE), path, character(1L))

-    if (all(paths == paths[[1L]]) && all(basename(paths) == "assays.h5")) {

-        return(TRUE)

+    if (!all(paths == paths[[1L]]) || !all(basename(paths) == "assays.h5")) {

+        return(FALSE)

     }

-    FALSE

+    TRUE

 }

@@ -27,19 +27,6 @@

     quantile(x, ...)

 }

-.DelayedMatrix <- function(x) {

-    x_name <- deparse(substitute(x))

-    X <- try(DelayedArray(x), silent = TRUE)

-    if (is(X, "try-error")) {

-        stop("Could not construct DelayedMatrix from '", x_name, "'",

-             call. = FALSE)

-    }

-    if (!is(X, "DelayedMatrix")) {

-        stop("'", x_name, "' must be matrix-like", call. = FALSE)

-    }

-    X

-}

-

 .isSimpleDelayedMatrix <- function(x) {

     is(x@seed, "matrix")

 }

@@ -126,3 +126,34 @@ blockApplyWithRealization <- function(x, FUN, ..., sink = NULL, x_grid = NULL,

     BPPARAM = BPPARAM)

 }

+# TODO: Needed?

+.getSEDir <- function(x) {

+    paths <- lapply(assays(x, withDimnames = FALSE), function(a) {

+        try(path(a), silent = TRUE)

+    })

+    if (any(vapply(paths, is, logical(1L), "try-error"))) {

+        stop("Cannot extract 'dir'.")

+    }

+    unique_paths <- unique(unlist(paths, use.names = FALSE))

+    if (length(unique_paths) > 1) {

+        stop("Assay data spread across multiple HDF5 files.")

+    }

+    dirs <- dirname(unlist(paths, use.names = FALSE))

+    unique(dirs)

+}

+

+# Should return TRUE for BSseq object created with read.bismark() or saved with

+# HDF5Array::saveHDF5SummarizedExperiment().

+# TODO: Check dirname(paths[[1L]]) also contains 'se.rds'? It looks like dir

+#       can contain other files besides these; check.

+.isHDF5BackedBSseqUpdatable <- function(x) {

+    stopifnot(is(x, "BSseq"))

+    if (!identical(.getBSseqBackends(x), "HDF5Array")) {

+        return(FALSE)

+    }

+    paths <- vapply(assays(x, withDimnames = FALSE), path, character(1L))

+    if (all(paths == paths[[1L]]) && all(basename(paths) == "assays.h5")) {

+        return(TRUE)

+    }

+    FALSE

+}

@@ -79,30 +79,6 @@ setMethod("dimnames", "arrayRealizationSink", function(x) {

     dimnames(x@result_envir$result)

 })

-# Helper functions for setting up ArrayGrid instances --------------------------

-

-# NOTE: Copy of minfi:::colGrid()

-# TODO: Perhaps move this to DelayedMatrixStats?

-colGrid <- function(x) {

-    block_maxlen <- max(nrow(x),

-                        DelayedArray:::get_default_block_maxlength(type(x)))

-    spacings <- DelayedArray:::get_spacings_for_linear_capped_length_blocks(

-        refdim = dim(x),

-        block_maxlen = block_maxlen)

-    RegularArrayGrid(dim(x), spacings)

-}

-

-# NOTE: Copy of minfi:::rowGrid()

-# TODO: Perhaps move this to DelayedMatrixStats?

-rowGrid <- function(x) {

-    block_maxlen <- max(ncol(x),

-                        DelayedArray:::get_default_block_maxlength(type(x)))

-    spacings <- DelayedArray:::get_spacings_for_hypercube_capped_length_blocks(

-        refdim = dim(x),

-        block_maxlen = block_maxlen)

-    RegularArrayGrid(dim(x), spacings)

-}

-

 # Advanced block processing routines -------------------------------------------

 # NOTE: Copy of minfi:::blockApplyWithRealization()

@@ -133,10 +133,7 @@ blockApplyWithRealization <- function(x, FUN, ..., sink = NULL, x_grid = NULL,

         }

         x_viewport <- x_grid[[b]]

         sink_viewport <- sink_grid[[b]]

-        block <- DelayedArray:::extract_block(x, x_viewport)

-        if (!is.array(block)) {

-            block <- DelayedArray:::.as_array_or_matrix(block)

-        }

+        block <- read_block(x, x_viewport)

         attr(block, "from_grid") <- x_grid

         attr(block, "block_id") <- b

         block_ans <- FUN(block, ...)

@@ -142,7 +142,7 @@ blockApplyWithRealization <- function(x, FUN, ..., sink = NULL, x_grid = NULL,

         block_ans <- FUN(block, ...)

         # NOTE: This is the only part different from DelayedArray::blockApply()

         if (!is.null(sink)) {

-            write_block_to_sink(block_ans, sink, sink_viewport)

+            write_block(x = sink, viewport = sink_viewport, block = block_ans)

             block_ans <- NULL

         }

         if (DelayedArray:::get_verbose_block_processing()) {

@@ -54,6 +54,31 @@

     }

 }

+# Missing methods --------------------------------------------------------------

+

+# NOTE: Copied from minfi

+# TODO: Perhaps move this to DelayedMatrixStats?

+# TODO: DelayedArray::type() for all RealizationSink subclasses

+setMethod("type", "HDF5RealizationSink", function(x) {

+    x@type

+})

+# NOTE: Copied from minfi

+# TODO: Perhaps move this to DelayedMatrixStats?

+setMethod("type", "arrayRealizationSink", function(x) {

+    DelayedArray::type(x@result_envir$result)

+})

+# NOTE: Copied from minfi

+# TODO: Perhaps move this to DelayedMatrixStats?

+setMethod("type", "RleRealizationSink", function(x) {

+    x@type

+})

+# NOTE: Copied from minfi

+# TODO: Perhaps move this to DelayedMatrixStats?

+# TODO: dimnames() for all RealizationSink subclasses

+setMethod("dimnames", "arrayRealizationSink", function(x) {

+    dimnames(x@result_envir$result)

+})

+

 # Helper functions for setting up ArrayGrid instances --------------------------

 # NOTE: Copy of minfi:::colGrid()

@@ -53,3 +53,78 @@

         stop("'type' = ", type, " is not supported")

     }

 }

+

+# Helper functions for setting up ArrayGrid instances --------------------------

+

+# NOTE: Copy of minfi:::colGrid()

+# TODO: Perhaps move this to DelayedMatrixStats?

+colGrid <- function(x) {

+    block_maxlen <- max(nrow(x),

+                        DelayedArray:::get_default_block_maxlength(type(x)))

+    spacings <- DelayedArray:::get_spacings_for_linear_capped_length_blocks(

+        refdim = dim(x),

+        block_maxlen = block_maxlen)

+    RegularArrayGrid(dim(x), spacings)

+}

+

+# NOTE: Copy of minfi:::rowGrid()

+# TODO: Perhaps move this to DelayedMatrixStats?

+rowGrid <- function(x) {

+    block_maxlen <- max(ncol(x),

+                        DelayedArray:::get_default_block_maxlength(type(x)))

+    spacings <- DelayedArray:::get_spacings_for_hypercube_capped_length_blocks(

+        refdim = dim(x),

+        block_maxlen = block_maxlen)

+    RegularArrayGrid(dim(x), spacings)

+}

+

+# Advanced block processing routines -------------------------------------------

+

+# NOTE: Copy of minfi:::blockApplyWithRealization()

+# TODO: Perhaps move this to DelayedMatrixStats?

+# NOTE: DelayedArray::blockApply() with the option to write the blocks to

+#       'sink'. Useful, for example, to apply a function across column-blocks

+#       of a DelayedMatrix, write these results to disk, and then wrap

+#       these in a DelayedMatrix.

+# TODO: See https://github.com/Bioconductor/DelayedArray/issues/10

+blockApplyWithRealization <- function(x, FUN, ..., sink = NULL, x_grid = NULL,

+                                      sink_grid = NULL, BPREDO = list(),

+                                      BPPARAM = bpparam()) {

+    FUN <- match.fun(FUN)

+

+    # Check conformable dots_grids and sinks_grids

+    x_grid <- DelayedArray:::.normarg_grid(x_grid, x)

+    sink_grid <- DelayedArray:::.normarg_grid(sink_grid, sink)

+    if (!identical(dim(x_grid), dim(sink_grid))) {

+        stop("non-conformable 'x_grid' and 'sink_grid'")

+    }

+

+    # Loop over blocks of `x` and write to `sink`

+    nblock <- length(x_grid)

+    bplapply(seq_len(nblock), function(b) {

+        if (DelayedArray:::get_verbose_block_processing()) {

+            message("Processing block ", b, "/", nblock, " ... ",

+                    appendLF = FALSE)

+        }

+        x_viewport <- x_grid[[b]]

+        sink_viewport <- sink_grid[[b]]

+        block <- DelayedArray:::extract_block(x, x_viewport)

+        if (!is.array(block)) {

+            block <- DelayedArray:::.as_array_or_matrix(block)

+        }

+        attr(block, "from_grid") <- x_grid

+        attr(block, "block_id") <- b

+        block_ans <- FUN(block, ...)

+        # NOTE: This is the only part different from DelayedArray::blockApply()

+        if (!is.null(sink)) {

+            write_block_to_sink(block_ans, sink, sink_viewport)

+            block_ans <- NULL

+        }

+        if (DelayedArray:::get_verbose_block_processing()) {

+            message("OK")

+        }

+    },

+    BPREDO = BPREDO,

+    BPPARAM = BPPARAM)

+}

+

@@ -44,48 +44,12 @@

     is(x@seed, "matrix")

 }

-# NOTE: Equivalent to rowSums2(x[, j, drop = FALSE]) but does it using a

-#       delayed operation and always returns a nrow(x) x 1 DelayedMatrix

-.delayed_rowSums2 <- function(x, j) {

-    Reduce(`+`, lapply(j, function(jj) x[, jj, drop = FALSE]))

-}

-

-# NOTE: Equivalent to colSums2(x[i, , drop = FALSE]) but does it using a

-#       delayed operation and always returns a 1 x ncol(x) DelayedMatrix

-.delayed_colSums2 <- function(x, i) {

-    Reduce(`+`, lapply(i, function(ii) x[ii, , drop = FALSE]))

-}

-

-# MARGIN = 1: collapse using rowSums

-# MARGIN = 2: collapse using colSums

-.collapseDelayedMatrix <- function(x, sp, MARGIN, BACKEND = NULL) {

-    stopifnot(is(x, "DelayedMatrix"))

-    if (MARGIN == 1) {

-        if (is.null(BACKEND)) {

-            collapsed_x <- do.call(cbind, lapply(sp, function(j) {

-                rowSums2(x[, j, drop = FALSE])

-            }))

-        } else {

-            collapsed_x <- do.call(cbind, lapply(sp, function(j) {

-                .delayed_rowSums2(x, j)

-            }))

-            # NOTE: Need to manually add colnames when using this method

-            colnames(collapsed_x) <- names(sp)

-        }

-    } else if (MARGIN == 2) {

-        if (is.null(BACKEND)) {

-            collapsed_x <- do.call(rbind, lapply(sp, function(i) {

-                colSums2(x[i, , drop = FALSE])

-            }))

-        } else {

-            collapsed_x <- do.call(rbind, lapply(sp, function(i) {

-                .delayed_colSums2(x, i)

-            }))

-            # NOTE: Need to manually add rownames when using this method

-            rownames(collapsed_x) <- names(sp)

-        }

+.zero_type <- function(type) {

+    if (identical(type, "integer")) {

+        fill <- 0L

+    } else if (identical(type, "double")) {

+        fill <- 0

     } else {

-        stop("'MARGIN' must be 1 or 2")

+        stop("'type' = ", type, " is not supported")

     }

-    realize(collapsed_x, BACKEND = BACKEND)

 }

@@ -44,15 +44,15 @@

     is(x@seed, "matrix")

 }

-# NOTE: Equivalent to rowSums(x[, j, drop = FALSE]) but does it using a

+# NOTE: Equivalent to rowSums2(x[, j, drop = FALSE]) but does it using a

 #       delayed operation and always returns a nrow(x) x 1 DelayedMatrix

-.delayed_rowSums <- function(x, j) {

+.delayed_rowSums2 <- function(x, j) {

     Reduce(`+`, lapply(j, function(jj) x[, jj, drop = FALSE]))

 }

-# NOTE: Equivalent to colSums(x[i, , drop = FALSE]) but does it using a

+# NOTE: Equivalent to colSums2(x[i, , drop = FALSE]) but does it using a

 #       delayed operation and always returns a 1 x ncol(x) DelayedMatrix

-.delayed_colSums <- function(x, i) {

+.delayed_colSums2 <- function(x, i) {

     Reduce(`+`, lapply(i, function(ii) x[ii, , drop = FALSE]))

 }

@@ -63,11 +63,11 @@

     if (MARGIN == 1) {

         if (is.null(BACKEND)) {

             collapsed_x <- do.call(cbind, lapply(sp, function(j) {

-                rowSums(x[, j, drop = FALSE])

+                rowSums2(x[, j, drop = FALSE])

             }))

         } else {

             collapsed_x <- do.call(cbind, lapply(sp, function(j) {

-                .delayed_rowSums(x, j)

+                .delayed_rowSums2(x, j)

             }))

             # NOTE: Need to manually add colnames when using this method

             colnames(collapsed_x) <- names(sp)

@@ -75,11 +75,11 @@

     } else if (MARGIN == 2) {

         if (is.null(BACKEND)) {

             collapsed_x <- do.call(rbind, lapply(sp, function(i) {

-                colSums(x[i, , drop = FALSE])

+                colSums2(x[i, , drop = FALSE])

             }))

         } else {

             collapsed_x <- do.call(rbind, lapply(sp, function(i) {

-                .delayed_colSums(x, i)

+                .delayed_colSums2(x, i)

             }))

             # NOTE: Need to manually add rownames when using this method

             rownames(collapsed_x) <- names(sp)

new file mode 100644

@@ -0,0 +1,91 @@

+# Functions/methods that would be good to have in DelayedArray

+

+.rowVars <- function(x, rows = NULL, cols = NULL, ...) {

+    if (is(x, "DelayedArray")) {

+        if (!is.null(rows)) {

+            x <- x[rows, ]

+        }

+        if (!is.null(cols)) {

+            x <- x[, cols]

+        }

+        row_vars <- rowVars(as.array(x), ...)

+    } else {

+        row_vars <- rowVars(x, rows = rows, cols = cols, ...)

+    }

+    row_vars

+}

+

+.rowSds <- function(x, rows = NULL, cols = NULL, ...) {

+    row_vars <- .rowVars(x, rows = rows, cols = cols, ...)

+    sqrt(row_vars)

+}

+

+.quantile <- function(x, ...) {

+    if (is(x, "DelayedArray")) {

+        x <- as.array(x)

+    }

+    quantile(x, ...)

+}

+

+.DelayedMatrix <- function(x) {

+    x_name <- deparse(substitute(x))

+    X <- try(DelayedArray(x), silent = TRUE)

+    if (is(X, "try-error")) {

+        stop("Could not construct DelayedMatrix from '", x_name, "'",

+             call. = FALSE)

+    }

+    if (!is(X, "DelayedMatrix")) {

+        stop("'", x_name, "' must be matrix-like", call. = FALSE)

+    }

+    X

+}

+

+.isSimpleDelayedMatrix <- function(x) {

+    is(x@seed, "matrix")

+}

+

+# NOTE: Equivalent to rowSums(x[, j, drop = FALSE]) but does it using a

+#       delayed operation and always returns a nrow(x) x 1 DelayedMatrix

+.delayed_rowSums <- function(x, j) {

+    Reduce(`+`, lapply(j, function(jj) x[, jj, drop = FALSE]))

+}

+

+# NOTE: Equivalent to colSums(x[i, , drop = FALSE]) but does it using a

+#       delayed operation and always returns a 1 x ncol(x) DelayedMatrix

+.delayed_colSums <- function(x, i) {

+    Reduce(`+`, lapply(i, function(ii) x[ii, , drop = FALSE]))

+}

+

+# MARGIN = 1: collapse using rowSums

+# MARGIN = 2: collapse using colSums

+.collapseDelayedMatrix <- function(x, sp, MARGIN, BACKEND = NULL) {

+    stopifnot(is(x, "DelayedMatrix"))

+    if (MARGIN == 1) {

+        if (is.null(BACKEND)) {

+            collapsed_x <- do.call(cbind, lapply(sp, function(j) {

+                rowSums(x[, j, drop = FALSE])

+            }))

+        } else {

+            collapsed_x <- do.call(cbind, lapply(sp, function(j) {

+                .delayed_rowSums(x, j)

+            }))

+            # NOTE: Need to manually add colnames when using this method

+            colnames(collapsed_x) <- names(sp)

+        }

+    } else if (MARGIN == 2) {

+        if (is.null(BACKEND)) {

+            collapsed_x <- do.call(rbind, lapply(sp, function(i) {

+                colSums(x[i, , drop = FALSE])

+            }))

+        } else {

+            collapsed_x <- do.call(rbind, lapply(sp, function(i) {

+                .delayed_colSums(x, i)

+            }))

+            # NOTE: Need to manually add rownames when using this method

+            rownames(collapsed_x) <- names(sp)

+        }

+    } else {

+        stop("'MARGIN' must be 1 or 2")

+    }

+    realize(collapsed_x, BACKEND = BACKEND)

+}