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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
### =========================================================================
### chunkGrid()
### -------------------------------------------------------------------------
###
### For use in *Seed classes that use a slot to store the chunkdim. See for
### example the "chunkdim" slot of the HDF5ArraySeed class defined in the
### HDF5Array package.
setClassUnion("integer_OR_NULL", c("integer", "NULL"))
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### chunkdim() generic and methods
###
### chunkdim(x) must return NULL or an integer vector compatible with dim(x).
###
setGeneric("chunkdim",
function(x)
{
x_dim <- dim(x)
if (is.null(x_dim))
stop(wmsg("argument to chunkdim() must be an array-like object"))
ans <- standardGeneric("chunkdim")
if (is.null(ans))
return(ans)
## When 'chunkdim(x)' is not NULL, its relationship with 'dim(x)' is
## the same as the relationship between the 'spacings' and 'refdim'
## slots of a RegularArrayGrid object. This guarantees that
## 'RegularArrayGrid(dim(x), chunkdim(x))' will always work (note
## that this always returns a grid with at least 1 element, even
## when 'x' is empty).
if (!is.integer(ans))
stop(wmsg("The \"chunkdim\" method for ", class(x), " objects ",
"didn't return an integer vector (or NULL). ",
"chunkdim() should always return an integer vector ",
"or NULL. ", .contact_author_msg(class(x))))
if (length(ans) != length(x_dim))
stop(wmsg("The \"chunkdim\" method for ", class(x), " objects ",
"returned an integer vector of length != ",
"length(dim(x)). ", .contact_author_msg(class(x))))
if (S4Vectors:::anyMissingOrOutside(ans, 0L))
stop(wmsg("The \"chunkdim\" method for ", class(x), " objects ",
"returned an integer vector with negative or NA ",
"values. ", .contact_author_msg(class(x))))
if (!all(ans <= x_dim))
stop(wmsg("The \"chunkdim\" method for ", class(x), " objects ",
"returned chunk dimensions that are not <= their ",
"corresponding dimension in 'x'. ",
.contact_author_msg(class(x))))
if (any(ans == 0L & x_dim != 0L))
stop(wmsg("The \"chunkdim\" method for ", class(x), " objects ",
"returned an integer vector with illegal zeros. ",
"chunkdim() should always return an integer vector with ",
"nonzero values unless the zero values correspond to ",
"dimensions in 'x' that are also zero. ",
.contact_author_msg(class(x))))
if (prod(ans) > .Machine$integer.max)
stop(wmsg("The \"chunkdim\" method for ", class(x), " objects ",
"returned chunk dimensions that are too big. The ",
"product of the chunk dimensions should always be <= ",
".Machine$integer.max ", .contact_author_msg(class(x))))
ans
}
)
setMethod("chunkdim", "ANY", function(x) NULL)
setMethod("chunkdim", "DelayedUnaryOp", function(x) chunkdim(x@seed))
.get_DelayedSubset_chunkdim <- function(x)
{
seed_chunkdim <- chunkdim(x@seed)
if (is.null(seed_chunkdim))
return(NULL)
ok <- lapply(seq_along(seed_chunkdim),
function(i) {seed_chunkdim[[i]] <= 1L || is.null(x@index[[i]])})
if (!all(unlist(ok)))
return(NULL)
pmin(seed_chunkdim, dim(x))
}
setMethod("chunkdim", "DelayedSubset", .get_DelayedSubset_chunkdim)
.get_DelayedAperm_chunkdim <- function(x)
{
seed_chunkdim <- chunkdim(x@seed)
if (is.null(seed_chunkdim))
return(NULL)
ans <- seed_chunkdim[x@perm]
ans[is.na(x@perm)] <- 1L
ans
}
setMethod("chunkdim", "DelayedAperm", .get_DelayedAperm_chunkdim)
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### chunkGrid() generic and methods
###
### chunkGrid(x) must return NULL or an ArrayGrid object defining a grid on
### reference array x.
###
setGeneric("chunkGrid", function(x) standardGeneric("chunkGrid"))
setMethod("chunkGrid", "ANY",
function(x)
{
x_chunkdim <- chunkdim(x)
if (is.null(x_chunkdim))
return(NULL)
RegularArrayGrid(dim(x), x_chunkdim)
}
)
|
