s2dv_cube.R

#'Creation of a 's2dv_cube' object
#'
#'@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_Load 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, ftime, lat and lon.
#'@param coords A named list with elements of the coordinates corresponding to 
#'  the dimensions of the data parameter. The names and length of each element 
#'  must correspond to the names of the dimensions.
#'@param varName A character string indicating the abbreviation of the variable 
#'  name.
#'@param variables 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 
#'  structure:\cr\cr
#'\item{data}{
#'  Array with named dimensions.
#'}
#'\item{dims}{
#'  Named vector of the data dimensions.
#'}
#'\item{coords}{
#'  Named list with elements of the coordinates corresponding to 
#'  the dimensions of the data parameter. 
#'}
#'\item{attrs}{
#'  Named list with elements: Dates, Variable, Datasets, source_files, when and 
#'  additional elements.
#'}
#'
#'@seealso \code{\link[s2dv]{Load}} and \code{\link{CST_Load}}
#'@examples
#'exp_original <- 1:100
#'dim(exp_original) <- c(lat = 2, time = 10, lon = 5)
#'exp1 <- s2dv_cube(data = exp_original)
#'class(exp1)
#'coords = list(lon = seq(-10, 10, 5), lat = c(45, 50))
#'exp2 <- s2dv_cube(data = exp_original, coords = coords) 
#'class(exp2)
#'variables <- list(tas = list(level = '2m'))
#'exp3 <- s2dv_cube(data = exp_original, coords = coords,
#'                  varName = 'tas', variables = variables)
#'class(exp3)
#'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', variables = variables,
#'                  Dates = Dates)  
#'class(exp4)
#'exp5 <- s2dv_cube(data = exp_original, coords = coords,
#'                  varName = 'tas', variables = variables,
#'                  Dates = Dates, when = "2019-10-23 19:15:29 CET")  
#'class(exp5)
#'exp6 <- s2dv_cube(data = exp_original, coords = coords,
#'                  varName = 'tas', variables = variables,
#'                  Dates = Dates,
#'                  when = "2019-10-23 19:15:29 CET", 
#'                  source_files = c("/path/to/file1.nc", "/path/to/file2.nc"))
#'class(exp6)
#'exp7 <- s2dv_cube(data = exp_original, coords = coords,
#'                  varName = 'tas', variables = variables,
#'                  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"))))  
#'class(exp7)
#'dim(exp_original) <- c(dataset = 1, member = 1, time = 10, lat = 2, lon = 5)
#'exp8 <- s2dv_cube(data = exp_original, coords = coords,
#'                  varName = 'tas', variables = variables,
#'                  Dates = Dates, original_dates = Dates)  
#'class(exp8)
#'@export
s2dv_cube <- function(data, coords = NULL, varName = NULL, variables = 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
  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]
        }
      } 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]
      }
    }
  } else {
    coords <- sapply(names(dims), function(x) 1:dims[x])
  }

  ## attrs
  attrs <- list()
  # Dates
  if (is.null(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'.")
      } else {
        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(variables)) {
    warning("Parameter 'variables' is not provided so the metadata ",
            "of 's2dv_cube' object will be incomplete.")
    attrs$Variable$variables <- NULL
  } else {
    if (!is.list(variables)) {
       variables <- list(variables)
    }
    attrs$Variable$variables <- variables
  }
  # 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)
}