inst/unitTests/test_read_block.R

In DelayedArray: A unified framework for working transparently with on-disk and in-memory array-like datasets

#setAutoRealizationBackend("RleArray")
#setAutoRealizationBackend("HDF5Array")

### We do "linear blocks" (i.e. block.shape="first-dim-grows-first") only,
### because they are the easiest to unsplit.
.split_array_by_block <- function(x, block.length)
{
    grid <- defaultAutoGrid(x, block.length, chunk.grid=NULL,
                               block.shape="first-dim-grows-first")
    lapply(grid, function(viewport) read_block(x, viewport))
}

### A simple unsplit() that works only because the blocks are assumed to
### be "linear".
.unsplit_array_by_block <- function(blocks, x)
{
    ans <- DelayedArray:::combine_array_objects(blocks)
    DelayedArray:::set_dim(ans, dim(x))
}

test_split_and_unsplit_array <- function()
{
    a1 <- array(1:300, c(3, 10, 2, 5))
    A1 <- realize(a1)

    for (block_len in c(1:7, 29:31, 39:40, 59:60, 119:120)) {
        blocks <- .split_array_by_block(a1, block_len)
        current <- .unsplit_array_by_block(blocks, a1)
        checkIdentical(a1, current)

        blocks <- .split_array_by_block(A1, block_len)
        current <- .unsplit_array_by_block(blocks, A1)
        checkIdentical(a1, current)
    }
}

test_split_and_unsplit_matrix <- function()
{
    a1 <- array(1:300, c(3, 10, 2, 5))
    A1 <- realize(a1)

    m1 <- a1[2, c(9, 3:7), 2, -4]
    M1a <- A1[2, c(9, 3:7), 2, -4]
    checkIdentical(m1, as.matrix(M1a))

    M1b <- realize(m1)
    checkIdentical(m1, as.matrix(M1b))

    tm1 <- t(m1)
    tM1a <- t(M1a)
    checkIdentical(tm1, as.matrix(tM1a))

    tM1b <- t(M1b)
    checkIdentical(tm1, as.matrix(tM1b))

    for (block_len in seq_len(length(m1) * 2L)) {
        blocks <- .split_array_by_block(m1, block_len)
        current <- .unsplit_array_by_block(blocks, m1)
        checkIdentical(m1, current)

        blocks <- .split_array_by_block(M1a, block_len)
        current <- .unsplit_array_by_block(blocks, M1a)
        checkIdentical(m1, current)

        blocks <- .split_array_by_block(M1b, block_len)
        current <- .unsplit_array_by_block(blocks, M1b)
        checkIdentical(m1, current)

        blocks <- .split_array_by_block(tm1, block_len)
        current <- .unsplit_array_by_block(blocks, tm1)
        checkIdentical(tm1, current)

        blocks <- .split_array_by_block(tM1a, block_len)
        current <- .unsplit_array_by_block(blocks, tM1a)
        checkIdentical(tm1, current)

        blocks <- .split_array_by_block(tM1b, block_len)
        current <- .unsplit_array_by_block(blocks, tM1b)
        checkIdentical(tm1, current)
    }
}