1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
|
### =========================================================================
### realize()
### -------------------------------------------------------------------------
###
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Internal helper to support block by block realization
###
### Used by coercion to RleArray, HDF5Array::writeHDF5Array(), and
### HDF5Array::writeTENxMatrix().
###
BLOCK_write_to_sink <- function(sink, x, verbose=NA)
{
stopifnot(identical(dim(x), dim(sink)))
verbose <- normarg_verbose(verbose)
## 'x' and 'sink' might both have their physical chunks but we must
## choose a grid that is compatible with the physical chunks of 'sink'.
## Calling 'defaultSinkAutoGrid()' on 'sink' will produce such grid.
## TODO: Note that it might be beneficial to use a grid that is **also**
## compatible with the physical chunks of 'x' so we might want to add
## that kind of capability to 'defaultSinkAutoGrid()'.
grid <- defaultSinkAutoGrid(sink)
FUN <- function(sink, viewport, x, verbose, verbose_read_block)
{
effective_grid <- effectiveGrid()
current_block_id <- currentBlockId()
if (verbose) {
x_is_sparse <- is_sparse(x)
nblock <- length(effective_grid)
block <- verbose_read_block(x, viewport, x_is_sparse,
as.sparse=NA, current_block_id, nblock)
} else {
block <- read_block(x, viewport, as.sparse=NA)
}
if (verbose)
message("\\ Writing it ... ", appendLF=FALSE)
sink <- write_block(sink, viewport, block)
if (verbose)
message("OK")
sink
}
sinkApply(sink, FUN, x, verbose, verbose_read_block,
grid=grid, verbose=FALSE)
}
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### realize()
###
setGeneric("realize", function(x, ...) standardGeneric("realize"))
setMethod("realize", "ANY",
function(x, BACKEND=getAutoRealizationBackend())
{
x <- DelayedArray(x)
if (is.null(BACKEND))
return(DelayedArray(as.array(x)))
load_BACKEND_package(BACKEND)
ans <- as(x, BACKEND)
## Temporarily needed because coercion to HDF5Array currently drops
## the dimnames. See R/writeHDF5Array.R in the HDF5Array package for
## more information about this.
## TODO: Remove line below when this is addressed.
set_dimnames(ans, dimnames(x))
}
)
|