#'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 An array with any number of named dimensions, typically an object #' output from CST_Load, with the following dimensions: dataset, member, sdate, #' ftime, lat and lon. #'@param lon An array with one dimension containing the longitudes and #' attributes: dim, cdo_grid_name, data_across_gw, array_across_gw, first_lon, #' last_lon and projection. #'@param lat An array with one dimension containing the latitudes and #' attributes: dim, cdo_grid_name, first_lat, last_lat and projection. #'@param other_coords A named list of vectors with corresponding dimension #' coordinates different from lon and lat. #'@param Variable A list of two elements: \code{varName} a character string #' indicating the abbreviation of a variable name and \code{level} a character #' string indicating the level (e.g., "2m"), if it is not required it could be #' set as NULL. #'@param Datasets A named list with the dataset model with two elements: #' \code{InitiatlizationDates}, containing a list of the start dates for each #' member named with the names of each member, and \code{Members} containing a #' vector with the member names (e.g., "Member_1") #'@param Dates A named list of one to two elements: The first element, #' \code{start}, is an array of dimensions (sdate, time) with the POSIX initial #' date of each forecast time of each starting date. The second element, #' \code{end} (optional), is an array of dimensions (sdate, time) with the POSIX #' final date of each forecast time of each starting date. #'@param time_dims Deprecated and will be removed in the next release. Please #' use dimension names in 'Dates' parameter. #'@param when A time stamp of the date issued by the Load() call to obtain the #' data. #'@param source_files A vector of character strings with complete paths to all #' the found files involved in the Load() call. #' #'@return The function returns an object of class 's2dv_cube'. #' #'@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) #'exp2 <- s2dv_cube(data = exp_original, lon = seq(-10, 10, 5), lat = c(45, 50)) #'class(exp2) #'exp3 <- s2dv_cube(data = exp_original, lon = seq(-10, 10, 5), lat = c(45, 50), #' Variable = list(varName = 'tas', level = '2m')) #'class(exp3) #'exp4 <- s2dv_cube(data = exp_original, lon = seq(-10, 10, 5), lat = c(45, 50), #' Variable = list(varName = 'tas', level = '2m'), #' Dates = list(start = paste0(rep("01", 10), rep("01", 10), 1990:1999), #' end = paste0(rep("31", 10), rep("01", 10), 1990:1999))) #'class(exp4) #'dates = as.POSIXct(paste0(rep("01", 10), rep("01", 10), 1990:1999), format = "%d%m%Y") #'dim(dates) <- c(time = 10) #'attr(dates, 'start') <- as.POSIXct(paste0(rep("01", 10), rep("01", 10), 1990:1999), format = "%d%m%Y") #'attr(dates, 'end') <- as.POSIXct(paste0(rep("31", 10), rep("01", 10), 1990:1999), format = "%d%m%Y") #'exp5 <- s2dv_cube(data = exp_original, lon = seq(-10, 10, 5), lat = c(45, 50), #' Variable = list(varName = 'tas', level = '2m'), #' Dates = dates, #' when = "2019-10-23 19:15:29 CET") #'class(exp5) #'exp6 <- s2dv_cube(data = exp_original, lon = seq(-10, 10, 5), lat = c(45, 50), #' Variable = list(varName = 'tas', level = '2m'), #' 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, lon = seq(-10, 10, 5), lat = c(45, 50), #' Variable = list(varName = 'tas', level = '2m'), #' 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, sdate = 2, ftime = 5, lat = 2, lon = 5) #'exp8 <- s2dv_cube(data = exp_original, lon = seq(-10, 10, 5), lat = c(45, 50), #' Variable = list(varName = 'tas', level = '2m'), #' Dates = dates) #'class(exp8) #'@export s2dv_cube <- function(data, lon = NULL, lat = NULL, other_coords = NULL, Variable = NULL, Datasets = NULL, Dates = NULL, time_dims = 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) # dims dims <- dim(data) ## other_coords coords <- sapply(names(dims), function(x) NULL) if (!is.null(other_coords)) { if (!is.list(other_coords)) { stop(paste0("Parameter 'other_coords' must be a named list with corresponding dimension ", "coordinates vectors.")) } if (any(names(other_coords) %in% names(dim(data)))) { other_coords <- other_coords[which(names(other_coords) %in% names(dim(data)))] } else { warning("Elements in 'other_coords' don't coincide with any dimensions in 'data'") } for (i_coord in names(dims)) { if (i_coord %in% names(other_coords)) { if (length(other_coords[[i_coord]]) == dims[i_coord]) { coords[[i_coord]] <- other_coords[[i_coord]] } } } } ## lon if (is.null(lon)) { if (any(.KnownLonNames() %in% names(dims))) { warning("Parameter 'lon' is not provided but data contains a ", "longitudinal dimension.") } else { warning("Parameter 'lon' is not provided so the data is from an ", "unknown location.") } } else { if (any(.KnownLonNames() %in% names(dims))) { name_lon <- names(dims[names(dims) %in% .KnownLonNames()]) if (dims[name_lon] != length(lon) & dims[name_lon] != 1) { stop("Length of parameter 'lon' doesn't match the length of ", "longitudinal dimension in parameter 'data'.") } if (!is.null(names(dim(lon))) && !identical(name_lon, names(dim(lon)))) { stop("The dimension name of parameter 'lon' is not consistent ", "with data dimension name for longitude.") } else { dim(lon) <- length(lon) names(dim(lon)) <- name_lon } } else if (!is.null(names(dim(lon))) && names(dim(lon)) %in% names(dims)) { name_lon <- names(dims[names(dim(lon))]) if (length(lon) != dims[name_lon]) { stop("The length of the longitudinal dimension doesn't match ", "with the length of 'lon' parameter.") } else { warning(paste0("Detected the longitude dimension name to be ", names(dim(lon)), ", which is not the expected names ('lon' or 'longitude') by s2dv_cube.")) } } else { stop("Parameter 'lon' is provided but data doesn't contain a ", "longitudinal dimension.") } coords[[name_lon]] <- lon } ## lat if (is.null(lat)) { if (any(.KnownLatNames() %in% names(dims))) { warning("Parameter 'lat' is not provided but data contains a ", "latitudinal dimension.") } else { warning("Parameter 'lat' is not provided so the data is from an ", "unknown location.") } } else { if (any(.KnownLatNames() %in% names(dims))) { name_lat <- names(dims[names(dims) %in% c('lat', 'latitude')]) if (dims[name_lat] != length(lat) & dims[name_lat] != 1) { stop("Length of parameter 'lat' doesn't match the length of ", "longitudinal dimension in parameter 'data'.") } if (!is.null(names(dim(lat))) && !identical(name_lat, names(dim(lat)))) { stop("The dimension name of parameter 'lat' is not consistent ", "with data dimension name for latitude.") } else { dim(lat) <- length(lat) names(dim(lat)) <- name_lat } } else if (!is.null(names(dim(lat))) && names(dim(lat)) %in% names(dims)) { name_lat <- names(dims[names(dim(lat))]) if (length(lat) != dims[name_lat]) { stop("The length of the latgitudinal dimension doesn't match ", "with the length of 'lat' parameter.") } else { warning(paste0("Detected the latitude dimension name to be ", names(dim(lat)), ", which is not the expected names ('lat' or 'latitude') by s2dv_cube.")) } } else { stop("Parameter 'lat' is provided but data doesn't contain a ", "latitudinal dimension.") } coords[[name_lat]] <- lat } # attrs attrs <- list() ## Variable if (is.null(Variable)) { warning("Parameter 'Variable' is not provided so the metadata ", "of 's2dv_cube' object will be incomplete.") } else { if (!is.list(Variable)) { Variable <- list(Variable) } # if (names(Variable)[1] != 'varName' | names(Variable)[2] != 'level') { # warning("The name of the first element of parameter 'Variable' is ", # "expected to be 'varName' and the second 'level'.") # } # if (!is.character(Variable[[1]])) { # warning("The element 'Varname' of parameter 'Variable' must be ", # "a character.") # } attrs[['Variable']] <- Variable } # Datasets if (is.null(Datasets)) { warning("Parameter 'Datasets' is not provided so the metadata ", "of 's2dv_cube' object will be incomplete.") } else { attrs[['Datasets']] <- Datasets } # time_dims if (!is.null(time_dims)) { warning(paste0("Parameter 'time_dims' is deprecated and will be removed in the next release.")) } # Dates if (is.null(Dates)) { if (any(.KnownTimeNames() %in% names(dims))) { warning("Parameter 'Dates' is not provided but data contains a ", "temporal dimension.") } } else { if (!is.array(Dates)) { stop("Parameter 'Dates' must be an array with named time dimensions.") } attrs[['Dates']] <- Dates } # when if (is.null(when)) { warning("Parameter 'when' is not provided so the metadata ", "of 's2dv_cube' object will be incomplete.") } else { attrs[['when']] <- when } # source_files if (is.null(source_files)) { warning("Parameter 'source_files' is not provided so the metadata ", "of 's2dv_cube' object will be incomplete.") } else { attrs[['source_files']] <- source_files } # object object <- list(data = data, dims = dims, coords = coords, attrs = attrs) class(object) <- 's2dv_cube' return(object) }