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

Solved package check issues.

parent 7bce3c0c
......@@ -3,7 +3,7 @@ Title: Tools to Easily Read/Write NetCDF Files into/from Multi-Dimensional R Arr
Version: 0.0.0
Authors@R: c(
person("BSC-CNS", role = c("aut", "cph")),
person("Nicolau", "Manubens", , "nicolau.manubens@bsc.es", role = c("aut", "cre")),
person("Nicolau", "Manubens", , "nicolau.manubens@bsc.es", role = c("aut", "cre")))
Description: Set of wrappers for the \code{ncdf4} package to simplify and extend its reading/writing capabilities into/from multi-dimensional R arrays.
Depends:
R (>= 2.14.1)
......
......@@ -3,7 +3,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
expect_all_indices = FALSE, allow_out_of_range = TRUE) {
file_opener <- NcOpen
file_closer <- NcClose
file_dim_reader <- NetCDFReadDims
file_dim_reader <- NcReadDims
is_single_na <- function(x) ifelse(length(x) > 1, FALSE, is.na(x))
close <- FALSE
if (is.character(file_to_read)) {
......@@ -47,7 +47,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
}
}
# Check var_names
# Check vars_to_read
if (is.character(vars_to_read) || is.numeric(vars_to_read)) {
vars_to_read <- list(vars_to_read)
}
......@@ -62,8 +62,8 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
if (print_error) {
stop("The variables to take specified in 'vars_to_read' or in 'dim_indices[['var']]' 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.")
# if (!is.character(vars_to_read) && !is.numeric(vars_to_read)) {
# stop("Parameter 'vars_to_read' must be a numeric vector or vector of character strings.")
# }
result_list <- NULL
......@@ -97,7 +97,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
for (var_name in vars_to_read_vector) {
if (var_name %in% extra_dimvars) {
indices_to_take <- TRUE
if (var_names %in% names(dim_indices)) {
if (var_name %in% names(dim_indices)) {
indices_to_take <- dim_indices[[var_name]]
if (length(dim(indices_to_take)) > 1) {
stop("More than 1 dimensions found for the dimension variable ", var_name, ".")
......
Subset <- function(x, along, indices, drop = FALSE) {
# Check x
if (!is.array(x)) {
stop("Input array 'x' must be a numeric array.")
}
# Take the input array dimension names
dim_names <- attr(x, 'dimensions')
if (!is.character(dim_names)) {
dim_names <- names(dim(x))
}
if (!is.character(dim_names)) {
if (any(sapply(along, is.character))) {
stop("The input array 'x' doesn't have labels for the dimensions but the parameter 'along' contains dimension names.")
}
}
# Check along
if (any(sapply(along, function(x) !is.numeric(x) && !is.character(x)))) {
stop("All provided dimension indices in 'along' must be integers or character strings.")
}
if (any(sapply(along, is.character))) {
req_dimnames <- along[which(sapply(along, is.character))]
if (length(unique(req_dimnames)) < length(req_dimnames)) {
stop("The parameter 'along' must not contain repeated dimension names.")
}
along[which(sapply(along, is.character))] <- match(req_dimnames, dim_names)
if (any(is.na(along))) {
stop("Could not match all dimension names in 'indices' with dimension names in input array 'x'.")
}
along <- as.numeric(along)
}
# Check indices
if (!is.list(indices)) {
indices <- list(indices)
}
# Check parameter drop
dims_to_drop <- c()
if (is.character(drop)) {
if (drop == 'all') {
drop <- TRUE
} else if (any(drop %in% c('selected', 'non-selected', 'none'))) {
if (drop == 'selected') {
dims_to_drop <- along[which(sapply(indices, length) == 1)]
} else if (drop == 'non-selected') {
dims_to_drop <- dim(x) == 1
dims_to_drop[along] <- FALSE
dims_to_drop <- which(dims_to_drop)
}
drop <- FALSE
} else {
stop("Parameter 'drop' must be one of TRUE, FALSE, 'all', 'selected', 'non-selected', 'none'.")
}
} else if (!is.logical(drop)) {
stop("Parameter 'drop' must be one of TRUE, FALSE, 'all', 'selected', 'non-selected', 'none'.")
}
# Take the subset
nd <- length(dim(x))
index <- as.list(rep(TRUE, nd))
index[along] <- indices
subset <- eval(as.call(c(as.name("["), as.name("x"), index, drop = drop)))
# If dropped all dimensions, need to drop dimnames too
if (is.character(dim_names) && drop == TRUE) {
dim_names_to_remove <- unique(c(along[which(sapply(indices, length) == 1)],
which(dim(x) == 1)))
if (length(dim_names_to_remove) > 0) {
dim_names <- dim_names[-dim_names_to_remove]
}
}
# Amend the final dimensions and put dimnames and attributes
metadata <- attributes(x)
metadata[['dim']] <- dim(subset)
if (length(dims_to_drop) > 0) {
metadata[['dim']] <- metadata[['dim']][-dims_to_drop]
if (is.character(dim_names)) {
names(metadata[['dim']]) <- dim_names[-dims_to_drop]
metadata[['dimensions']] <- dim_names[-dims_to_drop]
}
} else if (is.character(dim_names)) {
names(metadata[['dim']]) <- dim_names
metadata[['dimensions']] <- dim_names
}
attributes(subset) <- metadata
subset
}
.message <- function(...) {
# Function to use the 'message' R function with our custom settings
# Default: new line at end of message, indent to 0, exdent to 3,
# collapse to \n*
args <- list(...)
## In case we need to specify message arguments
if (!is.null(args[["appendLF"]])) {
appendLF <- args[["appendLF"]]
} else {
## Default value in message function
appendLF <- TRUE
}
if (!is.null(args[["domain"]])) {
domain <- args[["domain"]]
} else {
## Default value in message function
domain <- NULL
}
args[["appendLF"]] <- NULL
args[["domain"]] <- NULL
## To modify strwrap indent and exdent arguments
if (!is.null(args[["indent"]])) {
indent <- args[["indent"]]
} else {
indent <- 0
}
if (!is.null(args[["exdent"]])) {
exdent <- args[["exdent"]]
} else {
exdent <- 3
}
args[["indent"]] <- NULL
args[["exdent"]] <- NULL
## To modify paste collapse argument
if (!is.null(args[["collapse"]])) {
collapse <- args[["collapse"]]
} else {
collapse <- "\n*"
}
args[["collapse"]] <- NULL
## Message tag
if (!is.null(args[["tag"]])) {
tag <- args[["tag"]]
} else {
tag <- "* "
}
args[["tag"]] <- NULL
message(paste0(tag, paste(strwrap(
args, indent = indent, exdent = exdent
), collapse = collapse)), appendLF = appendLF, domain = domain)
}
.warning <- function(...) {
# Function to use the 'warning' R function with our custom settings
# Default: no call information, indent to 0, exdent to 3,
# collapse to \n
args <- list(...)
## In case we need to specify warning arguments
if (!is.null(args[["call."]])) {
call <- args[["call."]]
} else {
## Default: don't show info about the call where the warning came up
call <- FALSE
}
if (!is.null(args[["immediate."]])) {
immediate <- args[["immediate."]]
} else {
## Default value in warning function
immediate <- FALSE
}
if (!is.null(args[["noBreaks."]])) {
noBreaks <- args[["noBreaks."]]
} else {
## Default value warning function
noBreaks <- FALSE
}
if (!is.null(args[["domain"]])) {
domain <- args[["domain"]]
} else {
## Default value warning function
domain <- NULL
}
args[["call."]] <- NULL
args[["immediate."]] <- NULL
args[["noBreaks."]] <- NULL
args[["domain"]] <- NULL
## To modify strwrap indent and exdent arguments
if (!is.null(args[["indent"]])) {
indent <- args[["indent"]]
} else {
indent <- 0
}
if (!is.null(args[["exdent"]])) {
exdent <- args[["exdent"]]
} else {
exdent <- 3
}
args[["indent"]] <- NULL
args[["exdent"]] <- NULL
## To modify paste collapse argument
if (!is.null(args[["collapse"]])) {
collapse <- args[["collapse"]]
} else {
collapse <- "\n!"
}
args[["collapse"]] <- NULL
## Warning tag
if (!is.null(args[["tag"]])) {
tag <- args[["tag"]]
} else {
tag <- "! Warning: "
}
args[["tag"]] <- NULL
warning(paste0(tag, paste(strwrap(
args, indent = indent, exdent = exdent
), collapse = collapse)), call. = call, immediate. = immediate,
noBreaks. = noBreaks, domain = domain)
}
# This function is a helper for the function .MergeArrays.
# It expects as inputs two named numeric vectors, and it extends them
# with dimensions of length 1 until an ordered common dimension
......
......@@ -13,6 +13,7 @@ NcOpen(file_path)
\item{file_path}{
Character string with the path to the file to be opened.
}
}
\value{
A NetCDF object as returned by \code{ncdf4::nc_open} or NULL on failure.
}
......
......@@ -25,6 +25,9 @@ Since this function considers the variables in a NetCDF file are stored along a
- A list of vectors with numeric indices or character strings: e.g. \code{list(var = list(c(1, 3, 'foo'), c(2, 'bar')))}\cr
Vectors with combined numeric indices and character strings are accepted.\cr
Whereas the first two options will return a single extended array with the merged variables, the second option will return a list with an array for each requested variable.
}
\item{vars_to_read}{
This parameter is a shortcut to (and has less priority than) specifying the requested variable names via \code{dim_indices = list(var = ...)}. It is useful when all the indices for all the requested variables have to be taken, so the parameter \code{dim_indices} can be skipped, but still only a specific variable or set of variables have to be taken. Check the documentation for the parameter \code{dim_indices} to see the three possible ways to specify this parameter.
}
\item{drop_var_dim}{
Whether to drop the 'var' dimension this function assumes (read description). If multiple variables are requested in a vector and \code{unlist = TRUE}, the drop won't be performed (not possible).
......
\name{Subset}
\alias{Subset}
\title{Subset a Data Array}
\description{
This function allows to subset (i.e. slice, take a chunk of) an array, in a
similar way as done in the function \code{take()} in the package plyr. There
are two main inprovements:\cr\cr
The input array can have dimension names, either
in \code{names(dim(x))} or in the attribute 'dimensions', and the dimensions to
subset along can be specified via the parameter \code{along} either with
integer indices or either by their name.\cr\cr
There are additional ways to adjust which dimensions are dropped in the
resulting array: either to drop all, to drop none, to drop only the ones that
have been sliced or to drop only the ones that have not been sliced.\cr\cr
If an array is provided without dimension names, dimension names taken from
the parameter \code{dim_names} will be added to the array.
}
\usage{
Subset(x, along, indices, drop = FALSE)
}
\arguments{
\item{x}{
A multidimensional array to be sliced. It can have dimension names either
in \code{names(dim(x))} or either in the attribute 'dimensions'.
}
\item{along}{
Vector with references to the dimensions to take the subset from: either
integers or dimension names.
}
\item{indices}{
List of indices to take from each dimension specified in 'along'. If a single
dimension is specified in 'along' the indices can be directly provided as a
single integer or as a vector.
}
\item{drop}{
Whether to drop all the dimensions of length 1 in the resulting array, none,
only those that are specified in 'along', or only those that are not specified
in 'along'. The possible values are, respectively: 'all' or TRUE, 'none' or
FALSE, 'selected', and 'non-selected'.
}
}
\examples{
subset <- Subset(sampleMap$mod, c('dataset', 'sdate', 'ftime'),
list(1, 1, 1), drop = 'selected')
PlotLayout(PlotEquiMap, c('lat', 'lon'), subset,
sampleMap$lon, sampleMap$lat,
titles = paste('Member', 1:3))
}
\keyword{dplot}
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