Commit d908e2f9 authored by Nicolau Manubens's avatar Nicolau Manubens
Browse files

Updated a2nc and adapted nc2a to take indices as variable names.

parent dfb4fc09
......@@ -40,7 +40,7 @@ ArrayToNetCDF <- function(arrays, file_path) {
}
dim_names <- names(dim(arrays[[i]]))
if (!is.null(dim_names)) {
if (any(is.na(dim_names) || (sapply(dim_names, nchar) == 0))) {
if (any(is.na(dim_names) | (sapply(dim_names, nchar) == 0))) {
stop("The provided arrays must have all named dimensions or ",
"all unnamed dimensions.")
}
......@@ -74,7 +74,7 @@ ArrayToNetCDF <- function(arrays, file_path) {
if (!is.numeric(dim_info[['len']])) {
stop("The provided 'len' for the ", k, "th dimension in the ", i, "th array must be a numeric value.")
}
dim_info[['len']] <- round(dim_info[['len']][1])
dim_info[['len']] <- as.integer(round(dim_info[['len']][1]))
if (dim_info[['len']] != dim(arrays[[i]])[k]) {
stop("The provided 'len' for the ", k, "th dimension in the ", i, "th array does not match the actual length of the provided array.")
}
......@@ -292,10 +292,14 @@ ArrayToNetCDF <- function(arrays, file_path) {
if (!is.character(var_info[['coordinates']])) {
stop("The attribute 'coordinates' must be a character string.")
}
if (!(all(strsplit(var_info[['coordinates']], ' ')[[1]] %in% sapply(defined_vars, '[[', 'name')))) {
stop("All the dimensions appearing in 'coordinates' must point to defined variables.")
coords <- strsplit(var_info[['coordinates']], ' ')[[1]]
if (!(all(coords %in% sapply(defined_vars, '[[', 'name') |
coords %in% sapply(defined_dims[which(sapply(defined_dims, '[[', 'create_dimvar'))], '[[', 'name')))) {
coords <- coords[which(coords %in% sapply(defined_vars, '[[', 'name') |
coords %in% sapply(defined_dims[which(sapply(defined_dims, '[[', 'create_dimvar'))], '[[', 'name'))]
.warning("Some of the dimensions appearing in 'coordinates' have been removed because they point to undefined variables.")
}
ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, 'coordinates', var_info[['coordinates']])
ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, 'coordinates', paste(coords, collapse = ' '))
}
attrs_to_skip <- which(names(var_info) %in% c('addOffset', 'scaleFact', 'coordinates'))
attrs_to_add <- names(var_info)
......@@ -303,7 +307,10 @@ ArrayToNetCDF <- function(arrays, file_path) {
attrs_to_add <- attrs_to_add[-attrs_to_skip]
}
for (attribute_name in attrs_to_add) {
ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, attribute_name, var_info[[attribute_name]])
if (is.numeric(var_info[[attribute_name]]) ||
is.character(var_info[[attribute_name]])) {
ncatt_put(ncdf_object, defined_vars[[var_counter]]$name, attribute_name, var_info[[attribute_name]])
}
}
var_counter <- var_counter + 1
}
......@@ -311,5 +318,3 @@ ArrayToNetCDF <- function(arrays, file_path) {
nc_close(ncdf_object)
invisible(NULL)
}
a2nc <- ArrayToNetCDF
......@@ -86,8 +86,8 @@ NetCDFReadDims <- function(file_to_read, var_names = NULL) {
dims
}
NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
# unlist = TRUE) {
NetCDFToArray <- function(file_to_read, vars_to_read, inner_indices,
drop_var_dim = FALSE, unlist = TRUE) {
file_opener <- NcOpen
file_closer <- NcClose
file_dim_reader <- NetCDFReadDims
......@@ -104,26 +104,26 @@ NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
}
# Check var_names
# if (is.character(var_names)) {
# var_names <- list(var_names)
# }
# print_error <- FALSE
# if (is.list(var_names)) {
# if (!all(sapply(var_names, is.character))) {
# print_error <- TRUE
# }
# } else {
# print_error <- TRUE
# }
# if (print_error) {
# stop("Parameter 'var_names' must be one or a list of vectors of character strings or NULL.")
# }
if (!is.character(var_names)) {
stop("Parameter 'var_names' must be a vector of character strings.")
if (is.character(vars_to_read) || is.numeric(vars_to_read)) {
vars_to_read <- list(vars_to_read)
}
print_error <- FALSE
if (is.list(vars_to_read)) {
if (!all(sapply(vars_to_read, function(x) is.character(x) || is.numeric(x)))) {
print_error <- TRUE
}
} else {
print_error <- TRUE
}
if (print_error) {
stop("Parameter 'vars_to_read' must be one or a list of numeric vectors or vectors of character strings or NULL.")
}
# if (!is.character(var_names) && !is.numeric(var_names)) {
# stop("Parameter 'var_names' must be a numeric vector or vector of character strings.")
# }
# result_list <- NULL
# for (var_names_vector in var_names) {
result_list <- NULL
for (vars_to_read_vector in vars_to_read) {
result <- NULL
if (!is.null(file_object)) {
# Create all variables that are 'dimvars'
......@@ -143,8 +143,14 @@ NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
}
#file_object$var[extra_dimvars] <- extra_dimvars_list
#file_object$nvars <- file_object$nvars + length(extra_dimvars)
# for (var_name in var_names_vector) {
for (var_name in var_names) {
nmv <- numeric_var_indices <- which(is.numeric(vars_to_read_vector))
if (length(nmv) > 0) {
if (any(vars_to_read_vector[nmv] > (length(file_object$var) + length(extra_dimvars)))) {
stop("Provided numerical variable indices out of bounds in 'vars_to_read'.")
}
vars_to_read_vector[nmv] <- c(sapply(file_object$var, '[[', 'name'), extra_dimvars)[vars_to_read_vector[nmv]]
}
for (var_name in vars_to_read_vector) {
if (var_name %in% extra_dimvars) {
var_result <- file_object$dim[[var_name]]$vals
#atts <- file_object$dim[[var_name]]
......@@ -193,8 +199,7 @@ NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
}
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(var_names_vector) == 1)) {
if (!drop_var_dim && (length(var_names) == 1)) {
if (!drop_var_dim && (length(vars_to_read_vector) == 1)) {
dim(var_result) <- c(c(var = 1), dim(var_result))
}
attr(var_result, 'variables') <- structure(list(atts), .Names = var_name)
......@@ -210,33 +215,32 @@ NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
}
}
}
# if (is.null(result_list)) {
# if (length(var_names) == 1 && simplify) {
# result_list <- result
# } else {
# if (length(var_names_vector) == 1) {
# result_list <- structure(list(result), .Names = var_names_vector)
# } else {
# result_list <- list(result)
# }
# }
# } else {
# if (length(var_names_vector) == 1) {
# result_list <- do.call('[[<-', list(x = result_list,
# i = var_names_vector,
# value = result))
# } else {
# result_list <- do.call('[[<-', list(x = result_list,
# i = length(result_list) + 1,
# value = result))
# }
# }
# }
if (is.null(result_list)) {
if (length(vars_to_read) == 1 && unlist) {
result_list <- result
} else {
if (length(vars_to_read_vector) == 1) {
result_list <- structure(list(result), .Names = vars_to_read_vector)
} else {
result_list <- list(result)
}
}
} else {
if (length(vars_to_read_vector) == 1) {
result_list <- do.call('[[<-', list(x = result_list,
i = vars_to_read_vector,
value = result))
} else {
result_list <- do.call('[[<-', list(x = result_list,
i = length(result_list) + 1,
value = result))
}
}
}
if (close) {
file_closer(file_object)
}
# result_list
result
result_list
}
# Parameter 'file_selectos' expects a named character vector of single
......
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