-
Notifications
You must be signed in to change notification settings - Fork 2
/
subsetParameters.R
104 lines (85 loc) · 2.87 KB
/
subsetParameters.R
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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
# "`-''-/").___..--''"`-._
# (`6_ 6 ) `-. ( ).`-.__.`) WE ARE ...
# (_Y_.)' ._ ) `._ `. ``-..-' PENN STATE!
# _ ..`--'_..-_/ /--'_.' ,'
# (il),-'' (li),' ((!.-'
#
# Author: Weiming Hu <weiming@psu.edu>
# Geoinformatics and Earth Observation Laboratory (http://geolab.psu.edu)
# Department of Geography and Institute for CyberScience
# The Pennsylvania State University
#
#' RAnEnExtra::subsetParameters
#'
#' RAnEnExtra::subsetParameters is a convevient function to subset parameters
#' from forecast and observation lists.
#'
#' @details
#' RAnEnExtra::subsetParameters will select the parameters based on the input
#' index from the following members of the input list (if they exist):
#'
#' - ParameterNames
#' - ParameterCirculars
#' - Data
#'
#' @param index An index vector for parameters to extract
#' @param l A forecast or observation list. For how to create such a
#' list, please see
#' [this tutorial](https://weiming-hu.github.io/AnalogsEnsemble/2019/11/18/format-obs.html).
#' For what members to include in the list, see
#' [this doc](https://weiming-hu.github.io/AnalogsEnsemble/2019/01/16/NetCDF-File-Types.html).
#' @param verbose Whether to print progress information.
#'
#' @return A forecast or observation list depending on your input
#' list type with the subset parameters.
#'
#' @seealso [RAnEnExtra::subsetStations] which shares a similar interface and has an usage example.
#'
#' @md
#' @export
subsetParameters <- function(index, l, verbose = T) {
# Sanity check
stopifnot(is.list(l))
stopifnot('Data' %in% names(l))
num_parameters <- dim(l$Data)[1]
if (max(index) > num_parameters) {
stop('Some indices are larger than the number of parameters.')
}
# These are the members to subset
names <- c('ParameterNames', 'Data')
for (name in names) {
if (name %in% names(l) & !is.null(l[[name]])) {
if (verbose) {
cat('Subset the list member', name, '...\n')
}
if (name == 'Data') {
if (length(dim(l[[name]])) == 3) {
l[[name]] <- l[[name]][index, , , drop = F]
} else if (length(dim(l[[name]])) == 4) {
l[[name]] <- l[[name]][index, , , , drop = F]
} else {
stop('The member Data should have either 3 or 4 dimensions.')
}
} else {
if (length(l[[name]]) != num_parameters) {
stop(paste('The member', name, 'has a different number of parameters.'))
}
l[[name]] <- as.vector(l[[name]])[index]
}
}
}
if ('ParameterCirculars' %in% names(l)) {
if (length(l$parameterCirculars) > 0) {
l$ParameterCirculars <- l$ParameterCirculars[l$ParameterCirculars %in% l$ParameterNames]
if (verbose) {
cat('Circular parameters have been subset\n')
}
}
}
# Clear memory
gc(reset = T)
if (verbose) {
cat('Done (subsetParameters)\n')
}
return(l)
}