Newer
Older
#'@description This function allows to create an 's2dv_cube' object by passing
#'information through its parameters. This function will be needed if the data
#'hasn't been loaded using CST_Start or has been transformed with other methods.
#'An 's2dv_cube' object has many different components including metadata. This
#'function will allow to create 's2dv_cube' objects even if not all elements
#'are defined and for each expected missed parameter a warning message will be
#'returned.
#'
#'@author Perez-Zanon Nuria, \email{nuria.perez@bsc.es}
#'
#'@param data A multidimensional array with named dimensions, typically with
#' dimensions: dataset, member, sdate, time, lat and lon.
#'@param coords A list of named vectors with the coordinates corresponding to
#' the dimensions of the data parameter. If any coordinate has dimensions, they
#' will be set as NULL. If any coordinate is not provided, it is set as an
#' index vector with the values from 1 to the length of the corresponding
#' dimension. The attribute 'indices' indicates wether the coordinate is an
#' index vector (TRUE) or not (FALSE).
#'@param varName A character string indicating the abbreviation of the variable
#' name.
#'@param metadata A named list where each element is a variable containing the
#' corresponding information. The information can be contained in a list of
#' lists for each variable.
#'@param Datasets Character strings indicating the names of the dataset. It
#' there are multiple datasets it can be a vector of its names or a list of
#' lists with additional information.
#'@param Dates A POSIXct array of time dimensions containing the Dates.
#'@param when A time stamp of the date when the data has been loaded. This
#' parameter is also found in Load() and Start() functions output.
#'@param source_files A vector of character strings with complete paths to all
#' the found files involved in loading the data.
#'@param \dots Additional elements to be added in the object. They will be
#' stored in the end of 'attrs' element. Multiple elements are accepted.
#'@return The function returns an object of class 's2dv_cube' with the following
#' elements in the structure:\cr
#'\itemize{
#' \item{'data', array with named dimensions;}
#' \item{'dims', named vector of the data dimensions;}
#' \item{'coords', list of named vectors with the coordinates corresponding to
#' \item{'attrs', named list with elements:
#' \itemize{
#' \item{'Dates', array with named temporal dimensions of class 'POSIXct' from
#' \item{'Variable', has the following components:
#' \itemize{
#' \item{'varName', with the short name of the loaded variable as specified
#' in the parameter 'var';}
#' \item{'metadata', named list of elements with variable metadata.
#' They can be from coordinates variables (e.g. longitude) or
#' \item{'Datasets', character strings indicating the names of the dataset;}
#' \item{'source_files', a vector of character strings with complete paths
#' to all the found files involved in loading the data;}
#' \item{'when', a time stamp of the date issued by the Start() or Load()
#' call to obtain the data;}
#' \item{'load_parameters', it contains the components used in the
#' arguments to load the data from Start() or Load() functions.}
#'@seealso \code{\link[s2dv]{Load}} and \code{\link{CST_Start}}
#'exp_original <- 1:100
#'dim(exp_original) <- c(lat = 2, time = 10, lon = 5)
#'coords <- list(lon = seq(-10, 10, 5), lat = c(45, 50))
#'exp2 <- s2dv_cube(data = exp_original, coords = coords)
#'metadata <- list(tas = list(level = '2m'))
#'exp3 <- s2dv_cube(data = exp_original, coords = coords,
#' varName = 'tas', metadata = metadata)
#'Dates = as.POSIXct(paste0(rep("01", 10), rep("01", 10), 1990:1999), format = "%d%m%Y")
#'dim(Dates) <- c(time = 10)
#'exp4 <- s2dv_cube(data = exp_original, coords = coords,
#' varName = 'tas', metadata = metadata,
#' Dates = Dates)
#'exp5 <- s2dv_cube(data = exp_original, coords = coords,
#' varName = 'tas', metadata = metadata,
#' Dates = Dates, when = "2019-10-23 19:15:29 CET")
#'exp6 <- s2dv_cube(data = exp_original, coords = coords,
#' varName = 'tas', metadata = metadata,
#' Dates = Dates,
#' source_files = c("/path/to/file1.nc", "/path/to/file2.nc"))
#'exp7 <- s2dv_cube(data = exp_original, coords = coords,
#' varName = 'tas', metadata = metadata,
#' Dates = Dates,
#' when = "2019-10-23 19:15:29 CET",
#' source_files = c("/path/to/file1.nc", "/path/to/file2.nc"),
#' Datasets = list(
#' exp1 = list(InitializationsDates = list(Member_1 = "01011990",
#' Members = "Member_1"))))
#'dim(exp_original) <- c(dataset = 1, member = 1, time = 10, lat = 2, lon = 5)
#'exp8 <- s2dv_cube(data = exp_original, coords = coords,
#' varName = 'tas', metadata = metadata,
#' Dates = Dates, original_dates = Dates)
s2dv_cube <- function(data, coords = NULL, varName = NULL, metadata = NULL,
Datasets = NULL, Dates = NULL, when = NULL,
source_files = NULL, ...) {
# data
if (is.null(data) | !is.array(data) | is.null(names(dim(data)))) {
stop("Parameter 'data' must be an array with named dimensions.")
}
dims <- dim(data)
## coords
if (!is.null(coords)) {
if (!all(names(coords) %in% names(dims))) {
coords <- coords[-which(!names(coords) %in% names(dims))]
for (i_coord in names(dims)) {
if (i_coord %in% names(coords)) {
if (length(coords[[i_coord]]) != dims[i_coord]) {
warning(paste0("Coordinate '", i_coord, "' has different lenght as ",
"its dimension and it will not be used."))
coords[[i_coord]] <- 1:dims[i_coord]
attr(coords[[i_coord]], 'indices') <- TRUE
} else {
attr(coords[[i_coord]], 'indices') <- FALSE
}
} else {
warning(paste0("Coordinate '", i_coord, "' is not provided ",
"and it will be set as index in element coords."))
coords[[i_coord]] <- 1:dims[i_coord]
attr(coords[[i_coord]], 'indices') <- TRUE
}
}
dim(coords[[i_coord]]) <- NULL
} else {
coords <- sapply(names(dims), function(x) 1:dims[x])
for (i in 1:length(coords)) {
attr(coords[[i]], "indices") <- TRUE
## attrs
attrs <- list()
# Dates
warning("Parameter 'Dates' is not provided so the metadata ",
"of 's2dv_cube' object will be incomplete.")
attrs$Dates <- NULL
} else if (length(Dates) == 1 & inherits(Dates[1], "POSIXct")) {
attrs$Dates <- Dates
} else {
if (!is.array(Dates)) {
warning("Parameter 'Dates' must be an array with named time dimensions.")
} else {
if (is.null(names(dim(Dates)))) {
warning("Parameter 'Dates' must have dimension names.")
} else if (!all(names(dim(Dates)) %in% names(dims))) {
warning("Parameter 'Dates' must have the corresponding time dimension names in 'data'.")
if (inherits(Dates[1], "POSIXct")) {
attrs$Dates <- Dates
} else {
warning("Parameter 'Dates' must be of class 'POSIXct'.")
}
# Variable
if (is.null(varName)) {
warning("Parameter 'varName' is not provided so the metadata ",
"of 's2dv_cube' object will be incomplete.")
attrs$Variable$varName <- NULL
} else {
if (!is.character(varName)) {
warning("Parameter 'varName' must be a character.")
} else {
attrs$Variable$varName <- varName
}
if (is.null(metadata)) {
warning("Parameter 'metadata' is not provided so the metadata ",
"of 's2dv_cube' object will be incomplete.")
attrs$Variable$metadata <- NULL
} else {
if (!is.list(metadata)) {
metadata <- list(metadata)
# Datasets
if (!is.null(Datasets)) {
attrs$Datasets <- Datasets
# when
if (!is.null(when)) {
attrs$when <- when
# source_files
if (!is.null(source_files)) {
attrs$source_files <- source_files
}
# dots
dots <- list(...)
if (length(dots) != 0) {
for (i_arg in 1:length(dots)) {
attrs[[names(dots)[[i_arg]]]] <- dots[[i_arg]]
}
## object
object <- list(data = data, dims = dims, coords = coords, attrs = attrs)
class(object) <- 's2dv_cube'
return(object)
}