Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
#'Subset an object of class s2dv_cube
#'
#'@author Agudetse Roures Victoria, \email{victoria.agudetse@bsc.es}
#'This function allows to subset (i.e. slice, take a chunk of) the data inside
#'an object of class \code{s2dv_cube} and modify the dimensions, coordinates and
#'attributes accordingly, removing any variables, time steps and spatial
#'coordinates that are dropped when subsetting. It ensures that the information
#'inside the s2dv_cube remains coherent with the data it contains.\cr\cr
#'As in the function \code{Subset} from the ClimProjDiags package, the
#'dimensions to subset along can be specified via the parameter \code{along}
#'either with integer indices or by their name.\cr\cr
#'There are additional ways to adjust which dimensions are dropped in the
#'resulting object: 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
#'The \code{load_parameters} and \code{when} attributes of the original cube
#'are preserved. The \code{source_files} attribute is subset along the
#'\code{var_dim} and \code{dat_dim} dimensions.
#'
#'@param x An object of class \code{s2dv_cube} to be sliced.
#'@param along A vector with references to the dimensions to take the subset
#' from: either integers or dimension names.
#'@param indices A list of indices to take from each dimension specified in
#' 'along'. If a single dimension is specified in 'along', it can be directly
#' provided as an integer or a vector.
#'@param 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: 'all' or TRUE, 'none'
#' or FALSE, 'selected', and 'non-selected'. The default value is FALSE.
#'@param dat_dim A character string indicating the name of dataset dimension.
#' The default value is NULL.
#'@param var_dim A chatacter string indicating the name of the variable
#' dimension. The default value is NULL.
#'
#'@return An object of class \code{s2dv_cube} with similar data, coordinates and
#' attributes as the \code{x} input, but with trimmed or dropped dimensions.
#'
#'@examples
#'#Example synthetic data:
#'# Dimension has name already
#'data <- 1:(2 * 3 * 372 * 1)
#'dim(data) <- c(time = 372, lon = 2, lat = 3, model = 1)
#'data_subset <- Subset(data, c('time', 'model'),
#' list(1:10, TRUE), drop = 'selected')
#'dim(data_subset)
#'# Use attributes 'dimensions'
#'data <- array(1:(2 * 3 * 372 * 1), dim = c(2, 3, 372, 1))
#'attributes(data)[['dimensions']] <- c('lat', 'lon', 'time', 'model')
#'data_subset <- Subset(data, c('lon', 'lat'), list(1, 1), drop = TRUE)
#'dim(data_subset)
#'
CST_Subset <- function(x, along, indices, drop = FALSE,
var_dim = NULL,
dat_dim = NULL) {
# Check that x is s2dv_cube
if (!inherits(x, 's2dv_cube')) {
stop("Parameter 'x' must be of the class 's2dv_cube'")
}
# Check var_dim
if (!is.null(var_dim)) {
if ((!is.character(var_dim)) || (length(var_dim) > 1)) {
stop("Parameter 'var_dim' must be a character string.")
}
}
# Check dat_dim
if (!is.null(dat_dim)) {
if ((!is.character(dat_dim)) || (length(dat_dim) > 1)) {
stop("Parameter 'dat_dim' must be a character string.")
}
}
# Subset data
## TODO: Test other "drop" options
x$data <- ClimProjDiags::Subset(x$data,
along = along,
indices = indices,
drop = drop)
# Adjust dimensions
x$dims <- dim(x$data)
# Adjust coordinates
for (dimension in 1:length(along)) {
dim_name <- along[dimension]
index <- indices[[dimension]]
# Only rename coordinates that have not been dropped
if (dim_name %in% names(x$dims)) {
# Make coordinate 'sticky' to preserve attributes upon subsetting
x$coords[[dim_name]] <- sticky(x$coords[[dim_name]])
# Subset coordinate by indices
x$coords[[dim_name]] <- x$coords[[dim_name]][index]
# Remove 'sticky' class
x$coords[[dim_name]] <- unstick(x$coords[[dim_name]])
}
}
# Remove dropped coordinates
for (coordinate in names(x$coords)) {
if (!(coordinate %in% names(x$dims))) {
x$coords[[coordinate]] <- NULL
}
}
# Adjust attributes
## TODO: Correctly subset $Variable$metadata$time
## TODO: Change 'len'
# Variable
for (dimension in 1:length(along)) {
dim_name <- along[dimension]
index <- indices[[dimension]]
if ((!is.null(var_dim)) && (dim_name == var_dim)) {
x$attrs$Variable$varName <- x$coords[[dim_name]][1]
}
if ((!is.null(dat_dim)) && (dim_name == dat_dim)) {
x$attrs$Datasets <- x$attrs$Datasets[x$coords[[dim_name]][1]]
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
}
if ((!is.null(x$attrs$source_files)) &&
(dimension %in% dim(x$attrs$source_files))) {
x$attrs$source_files <- ClimProjDiags::Subset(x$attrs$source_files,
along = dim_name,
indices = index,
drop = drop)
}
if ((dim_name %in% names(x$dims)) &&
(dim_name %in% names(x$attrs$Variable$metadata))) {
# Make sticky
x$attrs$Variable$metadata[[dim_name]] <-
sticky(x$attrs$Variable$metadata[[dim_name]])
# Subset coords by indices
x$attrs$Variable$metadata[[dim_name]] <-
x$attrs$Variable$metadata[[dim_name]][index]
# Remove 'sticky' class
x$attrs$Variable$metadata[[dim_name]] <-
unstick(x$attrs$Variable$metadata[[dim_name]])
}
}
vars_to_keep <- na.omit(match(c(names(x$dims), (x$attrs$Variable$varName)),
names(x$attrs$Variable$metadata)))
x$attrs$Variable$metadata <- x$attrs$Variable$metadata[vars_to_keep]
# Subset Dates
time_along <- intersect(along, names(dim(x$attrs$Dates)))
if (!(length(time_along) == 0)) {
time_indices <- indices[match(time_along, along)]
original_dates <- x$attrs$Dates
x$attrs$Dates <- ClimProjDiags::Subset(x$attrs$Dates,
along = time_along,
indices = time_indices,
drop = drop)
}
return(x)
}