From 9ef0bcf8fafde15eb50a25d5c12f81b7d396c434 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Fri, 14 Jul 2017 17:40:42 +0200 Subject: [PATCH 1/3] Small bugfix in nc2a, solving crash when all dims in file are singleton and expect_all_indices = TRUE. --- R/NcToArray.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/NcToArray.R b/R/NcToArray.R index 7bb13b6..4ad00ea 100644 --- a/R/NcToArray.R +++ b/R/NcToArray.R @@ -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 -- GitLab From 95051724ed5d33b8c2f4a6d7938b11129327d4b5 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Fri, 14 Jul 2017 19:22:13 +0200 Subject: [PATCH 2/3] Improved a2nc to store data types properly. --- R/ArrayToNc.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/R/ArrayToNc.R b/R/ArrayToNc.R index f548a7b..a716232 100644 --- a/R/ArrayToNc.R +++ b/R/ArrayToNc.R @@ -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.") -- GitLab From f13a7d84b8935aa4b674116713cebd6c13544b8e Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Mon, 18 Sep 2017 18:47:56 +0200 Subject: [PATCH 3/3] Fix in .MergeArrays. --- R/Utils.R | 54 +++++++++++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 23 deletions(-) diff --git a/R/Utils.R b/R/Utils.R index 82c2fb6..cc9b059 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -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 } -- GitLab