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
73
74
75
76
77
78
79
80
81
82
|
#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)
}
}
|
