Newer
Older
#'Convert seasonal to decadal data to a 's2dv_cube' class
#'
#'@description This function allows to convert data to 's2dv_cube' class if the data hasn't been loaded using CST_Load or has been transformed with other methods. A 's2dv_cube' object has many different components including metadata. This function will allow to create partial 's2dv_cube' objects and for each expected missed parameter a warning message will be displayed.
#'
#'@author Perez-Zanon Nuria, \email{nuria.perez@bsc.es}
#'
#'@param data an array with any number of named dimensions, tipically and 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 longitudes and attributes: dim, cdo_grid_name, first_lat, last_lat and projection.
#'@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, 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 vertor with the member names (i.e.: "Member_1")
#'@param Dates a named list of two elements: \code{start}, an array of dimensions (sdate, time) with the POSIX initial date of each forecast time of each starting date, and \code{end}, an array of dimensions (sdate, time) with the POSIX final date of each forecast time of each starting date.
#'@param when a time stamp of the date the Load() call to obtain the data was issued.
#'@param source_files a vector of character strings with complete paths to all the found files involved in the Load() call.
#'
#'@return a object of class 's2dv_cube'.
#'
#'@seealso \code{\link[s2dverification]{Load}} and \code{\link{CST_Load}}
#'@examples
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
#'exp_original <- 1:100
#'dim(exp_original) <- c(lat = 2, time = 10, lon = 5)
#'exp1 <- as.s2dv_cube(data = exp_original)
#'class(exp1)
#'exp2 <- as.s2dv_cube(data = exp_original, lon = seq(-10, 10, 5), lat = c(45, 50))
#'class(exp2)
#'exp3 <- as.s2dv_cube(data = exp_original, lon = seq(-10, 10, 5), lat = c(45, 50),
#' Variable = list(varName = 'tas', level = '2m'))
#'class(exp3)
#'exp4 <- as.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)
#'exp5 <- as.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)),
#' when = "2019-10-23 19:15:29 CET")
#'class(exp5)
#'exp6 <- as.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)),
#' when = "2019-10-23 19:15:29 CET",
#' source_files = c("/path/to/file1.nc", "/path/to/file2.nc"))
#'class(exp6)
#'exp7 <- as.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)),
#' 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 <- as.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(exp8)
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#'@export
as.s2dv_cube <- function(data, lon = NULL, lat = NULL, Variable = NULL, Datasets = NULL,
Dates = NULL, when = NULL, source_files = NULL) {
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)
if (is.null(lon)) {
if (!any(c('lon', 'longitude') %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 a ",
"unknown location.")
}
}
if (is.null(lat)) {
if (!any(c('lat', 'latitude') %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 a ",
"unknown location.")
}
}
if (is.null(Variable)) {
warning("Parameter 'Variable' is not provided so the metadata",
"of 's2dv_cube' object will be incomplete.")
}
if (is.null(Datasets)) {
warning("Parameter 'Datasets' is not provided so the metadata",
"of 's2dv_cube' object will be incomplete.")
}
if (is.null(Dates)) {
if (!any(c('time', 'ftime', 'sdate') %in% names(dims))) {
warning("Parameter 'Dates' is not provided but data contains a ",
"temporal dimension.")
} else {
warning("Parameter 'Dates' is not provided so the data is from a ",
"unknown time period.")
}
}
if (is.null(when)) {
warning("Parameter 'when' is not provided so the metadata",
"of 's2dv_cube' object will be incomplete.")
}
if (is.null(source_files)) {
warning("Parameter 'source_files' is not provided so the metadata",
"of 's2dv_cube' object will be incomplete.")
}
if (!is.null(Variable)) {
if (!is.list(Variable)) {
Variable <- list(Variable)
}
if (names(Variable)[1] != 'varName' | names(Variable)[2] != 'level') {
warning("The name of the first elment 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.")
}
}
# Dimensions comparison
if (!is.null(lon)) {
if (any(names(dims) %in% c('lon', 'longitude'))) {
if (dims[(names(dims) %in% c('lon', 'longitude'))] != length(lon) &
dims[(names(dims) %in% c('lon', 'longitude'))] != 1) {
stop("Length of parameter 'lon' doesn't match the length of ",
"longitudinal dimension in parameter 'data'.")
}
}
}
if (!is.null(lat)) {
if (any(names(dims) %in% c('lat', 'latitude'))) {
if (dims[(names(dims) %in% c('lat', 'latitude'))] != length(lat) &
dims[(names(dims) %in% c('lat', 'latitude'))] != 1) {
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
stop("Length of parameter 'lat' doesn't match the length of ",
"latitudinal dimension in parameter 'data'.")
}
}
}
if (!is.null(Dates)) {
if (!is.list(Dates)) {
stop("Paramter 'Dates' must be a list.")
} else {
if (length(Dates) > 2) {
warning("Parameter 'Dates' is a list with more than 2 ",
"elements and only the first two will be used.")
Dates <- Dates[1 : 2]
}
if (names(Dates)[1] != 'start' | names(Dates)[2] != 'end') {
warning("The name of the first element of parameter 'Dates' ",
"is expected to be 'start' and the second 'end'.")
}
if (length(Dates[[1]]) != length(Dates[[2]]) &
length(Dates) == 2) {
stop("The length of the element in parameter 'Dates' must ",
"be equal.")
}
time_dims <- dims[names(dims) %in% c('sdate', 'time', 'ftime')]
if (prod(time_dims) != length(Dates[[1]])) {
stop("The length of the temporal dimension doesn't match ",
" with the length of elements in parameter 'Dates'.")
}
}
}
object <- list(data = data, lon = lon, lat = lat, Variable = Variable,
Datasets = Datasets, Dates = Dates, when = when,
source_files = source_files)
class(object) <- 's2dv_cube'
return(object)
}