Commit 27e64b6c authored by Nicolau Manubens Gil's avatar Nicolau Manubens Gil
Browse files

Merge branch 'develop-bugfixes-0.0.5' into 'master'

Develop bugfixes 0.0.5

See merge request !14
parents 36e23cf3 f13a7d84
......@@ -209,7 +209,15 @@ ArrayToNc <- function(arrays, file_path) {
var_info[['longname']] <- var_info[['longname']][1]
}
if (!('prec' %in% names(var_info))) {
var_info[['prec']] <- 'float'
if (typeof(arrays[[i]]) == 'logical') {
var_info[['prec']] <- 'short'
} else if (typeof(arrays[[i]]) == 'character') {
var_info[['prec']] <- 'char'
} else if (typeof(arrays[[i]]) == 'integer') {
var_info[['prec']] <- 'integer'
} else {
var_info[['prec']] <- 'double'
}
} else {
if (!is.character(var_info[['prec']])) {
stop("The provided 'prec' for the ", j, "th variable in the ", i, "th array must be a character string.")
......
......@@ -217,7 +217,12 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
names(dim(var_result)) <- names(indices_to_take)
# Drop extra dims
if (!is.null(extra_dims) && expect_all_indices) {
dim(var_result) <- dim(var_result)[-which(names(indices_to_take) %in% names(extra_dims))]
reduced_dims <- dim(var_result)[-which(names(indices_to_take) %in% names(extra_dims))]
if (length(reduced_dims) > 0) {
dim(var_result) <- reduced_dims
} else {
dim(var_result) <- NULL
}
}
# Reorder if needed
reorder_back <- NULL
......
......@@ -173,33 +173,41 @@
# 'a' 'b' 'c' 'e' 'd' 'f' 'g'
# 2 4 3 7 5 9 11
.MergeArrays <- function(array1, array2, along) {
if (!(identical(names(dim(array1)), names(dim(array2))) &&
identical(dim(array1)[-which(names(dim(array1)) == along)],
dim(array2)[-which(names(dim(array2)) == along)]))) {
new_dims <- .MergeArrayDims(dim(array1), dim(array2))
dim(array1) <- new_dims[[1]]
dim(array2) <- new_dims[[2]]
for (j in 1:length(dim(array1))) {
if (names(dim(array1))[j] != along) {
if (dim(array1)[j] != dim(array2)[j]) {
if (which.max(c(dim(array1)[j], dim(array2)[j])) == 1) {
na_array_dims <- dim(array2)
na_array_dims[j] <- dim(array1)[j] - dim(array2)[j]
na_array <- array(dim = na_array_dims)
array2 <- abind(array2, na_array, along = j)
names(dim(array2)) <- names(na_array_dims)
} else {
na_array_dims <- dim(array1)
na_array_dims[j] <- dim(array2)[j] - dim(array1)[j]
na_array <- array(dim = na_array_dims)
array1 <- abind(array1, na_array, along = j)
names(dim(array1)) <- names(na_array_dims)
if (!(is.null(array1) || is.null(array2))) {
if (!(identical(names(dim(array1)), names(dim(array2))) &&
identical(dim(array1)[-which(names(dim(array1)) == along)],
dim(array2)[-which(names(dim(array2)) == along)]))) {
new_dims <- .MergeArrayDims(dim(array1), dim(array2))
dim(array1) <- new_dims[[1]]
dim(array2) <- new_dims[[2]]
for (j in 1:length(dim(array1))) {
if (names(dim(array1))[j] != along) {
if (dim(array1)[j] != dim(array2)[j]) {
if (which.max(c(dim(array1)[j], dim(array2)[j])) == 1) {
na_array_dims <- dim(array2)
na_array_dims[j] <- dim(array1)[j] - dim(array2)[j]
na_array <- array(dim = na_array_dims)
array2 <- abind(array2, na_array, along = j)
names(dim(array2)) <- names(na_array_dims)
} else {
na_array_dims <- dim(array1)
na_array_dims[j] <- dim(array2)[j] - dim(array1)[j]
na_array <- array(dim = na_array_dims)
array1 <- abind(array1, na_array, along = j)
names(dim(array1)) <- names(na_array_dims)
}
}
}
}
}
if (!(along %in% names(dim(array2)))) {
stop("The dimension specified in 'along' is not present in the ",
"provided arrays.")
}
array1 <- abind(array1, array2, along = which(names(dim(array1)) == along))
names(dim(array1)) <- names(dim(array2))
} else if (is.null(array1)) {
array1 <- array2
}
array1 <- abind(array1, array2, along = which(names(dim(array1)) == along))
names(dim(array1)) <- names(dim(array2))
array1
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment