Commit 9a20f6b5 authored by Nicolau Manubens's avatar Nicolau Manubens
Browse files

Fixed bug with singleton dimensions and expect_all_indices. Fixes #1.

parent de33b570
......@@ -158,11 +158,6 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
}
}
}
if (expect_all_indices) {
extra_dims <- names(extra_dims)
} else {
extra_dims <- NULL
}
any_empty_selectors <- FALSE
# Here we are allowing for indices out of range (simply discarding them).
for (inner_dim in names(indices_to_take)) {
......@@ -201,15 +196,6 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
# }
# missing_dims <- missing_dim_names
#}
reorder_back <- NULL
indices_dims <- names(dim_indices)[which(names(dim_indices) %in% names(found_dims))]
if (length(indices_dims) > 0) {
if (any(names(found_dims) != indices_dims)) {
#reorder <- sapply(names(found_dims), function(x) which(indices_dims == x))
reorder_back <- sapply(indices_dims, function(x) which(names(found_dims) == x))
#indices_to_take <- indices_to_take[reorder]
}
}
start <- sapply(indices_to_take, function(x) if (is_single_na(x)) 1 else min(x))
count <- sapply(indices_to_take, function(x) if (is_single_na(x)) -1 else max(x) - min(x) + 1)
# Support for character strings
......@@ -228,19 +214,32 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
assignInNamespace('ncvar_get_inner', original_ncvar_get_inner, 'ncdf4')
}
#metadata <- c(metadata, structure(list(file_object$var[[var_name]]), .Names = var_name))
## TODO: Crop dimensions in attributes
if (!is.null(reorder_back)) {
var_result <- aperm(var_result, reorder_back)
names(dim(var_result)) <- names(indices_to_take)[reorder_back]
} else {
names(dim(var_result)) <- names(indices_to_take)
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))]
}
# Reorder if needed
reorder_back <- NULL
indices_dims <- names(dim_indices)[which(names(dim_indices) %in% names(dim(var_result)))]
if (length(indices_dims) > 0) {
if (any(names(dim(var_result))[-which(names(dim(var_result)) %in% names(extra_dims))] != indices_dims)) {
reorder_back <- 1:length(dim(var_result))
dims_to_reorder <- which(!(names(dim(var_result)) %in% names(extra_dims)))
reorder_back[dims_to_reorder] <- dims_to_reorder[sapply(indices_dims,
function(x) {
which(names(dim(var_result))[dims_to_reorder] == x)
})]
dimname_bk <- names(dim(var_result))
var_result <- aperm(var_result, reorder_back)
names(dim(var_result)) <- dimname_bk[reorder_back]
#indices_to_take <- indices_to_take[reorder]
}
}
## TODO: Crop dimensions in attributes
#if (!is.null(missing_dims)) {
# dim(var_result) <- original_dims
#}
if (!is.null(extra_dims)) {
dim(var_result) <- dim(var_result)[-which(names(indices_to_take) %in% extra_dims)]
}
#attr(var_result, 'variables') <- metadata
}
atts <- file_object$var[[var_name]]
......
......@@ -39,7 +39,7 @@ Whether to drop the 'var' dimension this function assumes (read description). If
Whether to merge the resulting array variables into a single array if possible (default) or not. Otherwise a list with as many arrays as requested variables is returned.
}
\item{expect_all_indices}{
Whether the function should stop if indices are not provided for all the dimensions of any of the requested variables rather than assuming that all the indices are requested for the unspecified dimensions. By default the later is done.
Whether the function should stop if indices are not provided for all the dimensions of any of the requested variables (TRUE) rather than assuming that all the indices are requested for the unspecified dimensions (FALSE). By default the later is done (FALSE).
}
\item{allow_out_of_range}{
Whether to allow indices out of range (simply disregard them) or to stop if indices out of range are found.
......@@ -64,6 +64,26 @@ NcClose(fnc)
# Check the obtained array matches the original array
print(a)
print(a_from_file[1, , ])
# Example with extra dimensions of length 1
# Creating sample data with singleton dimensions. Only dimensions 'a', 'b' and
# 'c' are of length > 1.
test_var <- array(1:24, dim = c(1, 1, 2, 1, 1, 3, 1, 4, 1, 1))
names(dim(test_var)) <- c('x', 'y', 'a', 'z', 't', 'b', 'u', 'c', 'v', 'w')
# Storing the data into a NetCDF file
a2nc(list(test_var = test_var), file_path)
# Reading the data back
fff <- nc2a(file_path, list(a = NA, b = NA, c = NA), vars_to_read = 'test_var')
# By default, if no indices are provided for the singleton dimensions, they are
# automatically read in and preserved
dim(fff)
# Reading the data back with expect_all_indices = TRUE
fff <- nc2a(file_path, list(a = NA, b = NA, c = NA), vars_to_read = 'test_var',
expect_all_indices = TRUE)
# If indices for all dimensions are not provided and expect_all_indices = TRUE,
# the function crashes, except if those dimensions are of length 1. In that
# case, the function ignores those (those are dropped)
dim(fff)
}
\author{
History:\cr
......
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