Skip to content
GitLab
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
Hide whitespace changes
Inline Side-by-side
R/ArrayToNetCDF.R
View file @ d908e2f9
......@@ -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
R/NetCDFToArray.R
View file @ d908e2f9
......@@ -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