Commit b724771f authored by Nicolau Manubens Gil's avatar Nicolau Manubens Gil
Browse files

Fixes.

parent 3f53aa44
ArrayToNetCDF <- function(arrays, file_path) {
ArrayToNc <- function(arrays, file_path) {
# Check parameter arrays.
if (is.array(arrays)) {
arrays <- list(arrays)
......
NcReadVarNames <- function(file_to_read) {
file_opener <- nc_open
file_closer <- nc_close
close <- FALSE
if (is.character(file_to_read)) {
file_object <- file_opener(file_to_read)
file_path <- file_to_read
close <- TRUE
} else if (grepl('^ncdf', class(file_to_read))) {
file_object <- file_to_read
file_path <- file_object$filename
} else {
stop("Either the path to a NetCDF file or a ncdf object must be provided as 'file_to_read'.")
}
var_names <- names(file_object$var)
if (!is.null(file_object)) {
extra_dimvars <- NULL
# Create all variables that are 'dimvars'
for (dim_name in names(file_object$dim)) {
if (file_object$dim[[dim_name]]$create_dimvar) {
extra_dimvars <- c(extra_dimvars, dim_name)
}
}
var_names <- c(var_names, extra_dimvars)
}
var_names
}
......@@ -17,30 +17,37 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
stop("Either the path to a NetCDF file or a ncdf object must be provided as 'file_to_read'.")
}
var_tag <- 'var'
# Check dim_indices
if (length(dim_indices) == 0) {
dim_indices <- NULL
}
if (!is.null(dim_indices)) {
if (!is.list(dim_indices)) {
stop("Parameter 'dim_indices' must be a list of numeric vectors.")
}
if (is.null(names(dim_indices))) {
stop("Parameter 'dim_indices' must have dimension names.")
stop("Parameter 'dim_indices' must have dimension names as names.")
}
var_indices_position <- NULL
for (i in 1:length(dim_indices)) {
i <- 1
while (i <= length(dim_indices)) {
if (names(dim_indices)[i] %in% c('var', 'variable')) {
vars_to_read <- dim_indices[[i]]
var_indices_position <- i
var_tag <- names(dim_indices)[i]
} else {
if (!(names(dim_indices)[i] %in% names(file_object$dim))) {
stop("Provided indices in 'dim_indices' for a non-existing dimension.")
}
if (!is.numeric(dim_indices[[i]])) {
stop("Parameter 'dim_indices' must be a list of numeric vectors.")
if (!(is.numeric(dim_indices[[i]]) || is.logical(dim_indices[[i]]))) {
stop("Parameter 'dim_indices' must be a list of numeric vectors, TRUE or NA.")
}
}
if (identical(dim_indices[[i]], TRUE)) {
dim_indices[[i]] <- NA
}
i <- i + 1
}
if (!is.null(var_indices_position)) {
dim_indices <- dim_indices[-var_indices_position]
......@@ -134,6 +141,9 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
common_dims <- which(names(found_dims) %in% names(dim_indices))
if (length(common_dims) > 0) {
extra_dims <- found_dims[-common_dims]
if (length(extra_dims) == 0) {
extra_dims <- NULL
}
} else {
extra_dims <- found_dims
}
......@@ -190,12 +200,12 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
# }
# missing_dims <- missing_dim_names
#}
inner_dims <- names(indices_to_take)
reorder <- NULL
if (any(names(found_dims) != inner_dims)) {
reorder <- sapply(names(found_dims), function(x) which(inner_dims == x))
reorder_back <- sapply(inner_dims, function(x) which(names(found_dims) == x))
indices_to_take <- indices_to_take[reorder]
indices_dims <- names(dim_indices)[which(names(dim_indices) %in% names(found_dims))]
reorder_back <- NULL
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)
......@@ -203,17 +213,17 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
lapply(indices_to_take, function(x) if (is_single_na(x)) TRUE else x - min(x) + 1), list(drop = FALSE)))
#metadata <- c(metadata, structure(list(file_object$var[[var_name]]), .Names = var_name))
## TODO: Crop dimensions in attributes
if (!is.null(reorder)) {
if (!is.null(reorder_back)) {
var_result <- aperm(var_result, reorder_back)
}
#if (!is.null(missing_dims)) {
# dim(var_result) <- original_dims
#}
if (!is.null(extra_dims)) {
dim(var_result) <- dim(var_result)[-which(inner_dims %in% extra_dims)]
dim(var_result) <- dim(var_result)[-which(indices_dims %in% extra_dims)]
}
#attr(var_result, 'variables') <- metadata
names(dim(var_result)) <- inner_dims
names(dim(var_result)) <- indices_dims
}
atts <- file_object$var[[var_name]]
atts_to_remove <- c('id', 'name', 'ndims', 'natts', 'size',
......@@ -226,7 +236,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
extra_atts <- ncatt_get(file_object, var_name)
atts[names(extra_atts)] <- extra_atts
units <- file_object$var[[var_name]]$units
names(dim(var_result)) <- sapply(file_object$var[[var_name]]$dim, '[[', 'name')
#names(dim(var_result)) <- sapply(file_object$var[[var_name]]$dim, '[[', 'name')
}
if (!is.null(var_result)) {
# if (units %in% c('seconds', 'minutes', 'hours', 'days', 'weeks', 'months', 'years')) {
......@@ -247,7 +257,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
# var_result <- seq(as.POSIXct(parts[2]), length = max(var_result, na.rm = TRUE) + 1, by = units)[var_result + 1]
# }
if (!drop_var_dim && (length(vars_to_read_vector) == 1)) {
dim(var_result) <- c(c(var = 1), dim(var_result))
dim(var_result) <- c(setNames(1, var_tag), dim(var_result))
}
attr(var_result, 'variables') <- structure(list(atts), .Names = var_name)
## TODO: Take the general attributes out of atts and put them as
......@@ -257,7 +267,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
} else {
new_attrs <- c(attr(result, 'variables'),
attr(var_result, 'variables'))
result <- .MergeArrays(result, var_result, 'var')
result <- .MergeArrays(result, var_result, var_tag)
attr(result, 'variables') <- new_attrs
}
}
......
Supports Markdown
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