Newer
Older
# Function to permute arrays of non-atomic elements (e.g. POSIXct)
.aperm2 <- function(x, new_order) {
y <- array(1:length(x), dim = dim(x))
y <- aperm(y, new_order)
old_dims <- dim(x)
x <- x[as.vector(y)]
dim(x) <- old_dims[new_order]
x
}
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
# Takes as input a list of arrays. The list must have named dimensions.
.MergeArrayOfArrays <- function(array_of_arrays) {
MergeArrays <- startR:::.MergeArrays
array_dims <- (dim(array_of_arrays))
dim_names <- names(array_dims)
# Merge the chunks.
for (dim_index in 1:length(dim_names)) {
dim_sub_array_of_chunks <- dim_sub_array_of_chunk_indices <- NULL
if (dim_index < length(dim_names)) {
dim_sub_array_of_chunks <- array_dims[(dim_index + 1):length(dim_names)]
names(dim_sub_array_of_chunks) <- dim_names[(dim_index + 1):length(dim_names)]
dim_sub_array_of_chunk_indices <- dim_sub_array_of_chunks
sub_array_of_chunk_indices <- array(1:prod(dim_sub_array_of_chunk_indices),
dim_sub_array_of_chunk_indices)
} else {
sub_array_of_chunk_indices <- NULL
}
sub_array_of_chunks <- vector('list', prod(dim_sub_array_of_chunks))
dim(sub_array_of_chunks) <- dim_sub_array_of_chunks
for (i in 1:prod(dim_sub_array_of_chunks)) {
if (!is.null(sub_array_of_chunk_indices)) {
chunk_sub_indices <- which(sub_array_of_chunk_indices == i, arr.ind = TRUE)[1, ]
} else {
chunk_sub_indices <- NULL
}
for (j in 1:(array_dims[dim_index])) {
new_chunk <- do.call('[[', c(list(x = array_of_arrays),
as.list(c(j, chunk_sub_indices))))
#do.call('[[<-', c(list(x = array_of_chunks),
# as.list(c(j, chunk_sub_indices)),
# list(value = NULL)))
if (is.null(new_chunk)) {
stop("Chunks missing.")
}
if (is.null(sub_array_of_chunks[[i]])) {
sub_array_of_chunks[[i]] <- new_chunk
} else {
#if (length(new_chunk) != length(sub_array_of_chunks[[i]])) {
# stop("Missing components for some chunks.")
#}
#for (component in 1:length(new_chunk)) {
sub_array_of_chunks[[i]] <- MergeArrays(sub_array_of_chunks[[i]],
new_chunk,
dim_names[dim_index])
#}
}
}
}
array_of_arrays <- sub_array_of_chunks
rm(sub_array_of_chunks)
gc()
}
array_of_arrays[[1]]
}