/
adjusted.R
253 lines (250 loc) · 13.7 KB
/
adjusted.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
105
106
107
108
109
110
111
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
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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
## vim:textwidth=128:expandtab:shiftwidth=4:softtabstop=4:tw=120
# UNEXPORTED support function for useAdjusted() on single oce::argo object
useAdjustedSingle <- function(argo, fallback=FALSE, debug=0)
{
if (!(inherits(argo, "oce") && inherits(argo, "argo")))
stop("First argument must be an oce::argo object")
argoFloatsDebug(debug, "useAdjustedSingle(..., fallback=", fallback, ", debug=", debug, ") {\n", sep="", unindent=1, style="bold")
res <- argo
fn <- argo[["filename"]]
argoFloatsDebug(debug, "filename: \"", fn, "\"\n", sep="")
typeFromFilename <- switch(substring(gsub(".*/","",fn),1,1), "A"="adjusted", "D"="delayed", "R"="realtime")
varNames <- names(argo[["data"]])
adjustedNames <- grepl("Adjusted$", varNames)
varNamesRaw <- varNames[!adjustedNames]
varNamesAdjusted <- varNames[adjustedNames]
if (debug > 1) {
argoFloatsDebug(debug, "varNames: ", paste(varNames, collapse=" "), "\n", sep="")
argoFloatsDebug(debug, "varNamesRaw: ", paste(varNamesRaw, collapse=" "), "\n", sep="")
argoFloatsDebug(debug, "varNamesAdjusted: ", paste(varNamesAdjusted, collapse=" "), "\n", sep="")
}
nrow <- nrow(argo@data$pressure)
ncol <- ncol(argo@data$pressure)
# argoFloatsDebug(debug, "pressure is a ", ncol, "x", nrow, " matrix\n", sep="")
stationParameters <- argo@metadata$stationParameters
if (debug > 1) {
argoFloatsDebug(debug, "next is stationParameters\n")
print(stationParameters)
}
isBGC <- "parameterDataMode" %in% names(argo@metadata)
if (!isBGC) {
argoFloatsDebug(debug, "non-BGC file\n")
dataMode <- argo@metadata$dataMode
if (any(!dataMode %in% c("R", "A", "D"))) {
warning("skipping a cycle, because some dataMode values are not \"R\", \"A\" or \"D\"\n")
return(argo)
}
# Set up dnoRev, to find argoFloats name given NetCDF name
dno <- argo@metadata$dataNamesOriginal
dnoRev <- list()
for (name in names(dno))
dnoRev[[dno[[name]]]] <- name
if (debug > 1) { # show only at a high debug level
cat("dnoRev follows:\n")
cat(str(dnoRev))
}
#varNamesRaw <- unlist(lapply(parameters, function(n) dnoRev[[n]]))
for (icol in seq_len(ncol)) { # non-BGC case
mode <- dataMode[icol]
# Dewey Dunnington realized that 'stationParameters' is what we need next, not 'parameters'.
# (See https://github.com/ArgoCanada/argoFloats/issues/418 for discussion.)
parameters <- trimws(as.vector(argo@metadata$stationParameters[,icol]))
parameters <- parameters[nchar(parameters) > 0]
varNamesRaw <- unlist(lapply(parameters, function(n) dnoRev[[n]]))
argoFloatsDebug(debug, "Profile ", icol, " of ", ncol, "\n", sep="")
argoFloatsDebug(debug, " mode: \"", mode, "\"\n", sep="")
argoFloatsDebug(debug, " parameters: ", paste(parameters,collapse=" "), "\n", sep="")
# cat("next is varNamesAdjusted\n");print(varNamesAdjusted)
for (name in varNamesRaw) {
argoFloatsDebug(debug, " ", name, " (AKA ", dno[[name]], ")\n", sep="")
#argoFloatsDebug(debug, "name: \"", name, "\"", sep="")
adjustedName <- paste0(name, "Adjusted")
#argoFloatsDebug(debug, "name=\"", name, "\", adjustedName=\"", adjustedName, "\"\n", sep="")
# Can only copy if we have an Adjusted field (which is not always the case).
if (adjustedName %in% varNamesAdjusted) {
# Copy <PARAM>Adjusted into <PARAM> if either of the following is true.
# Case 1. fallback is FALSE
# Case 2. fallback is TRUE and mode is "A" or "D"
case <- if (fallback == FALSE) { 1 } else if (mode %in% c("A", "D")) { 2 } else { 0 }
if (case > 0) {
res@data[[name]][,icol] <- argo@data[[adjustedName]][,icol]
res@metadata$flags[[name]][,icol] <- argo@metadata$flags[[adjustedName]][,icol]
if (!fallback) {
argoFloatsDebug(debug, " copied ", adjustedName, " to ", name, ", since fallback=", fallback, "\n", sep="")
} else {
argoFloatsDebug(debug, " copied ", adjustedName, " to ", name, ", since fallback=", fallback, " and mode=", mode, "\n", sep="")
}
} else {
if (!fallback) {
argoFloatsDebug(debug, " retaining original, since fallback=", fallback, "\n", sep="")
} else {
argoFloatsDebug(debug, " retaining original, since fallback=", fallback, " and data-mode is ", pdmThis, "\n", sep="")
}
}
} else {
argoFloatsDebug(debug, " retaining original, since ", adjustedName, " is not present\n", sep="")
}
}
}
} else {
argoFloatsDebug(debug, "BGC (or synthetic) file\n")
# dnoRev is the reverse of dataNamesOriginal, and is for looking up
# items within parameterDataMode as we work through the columns (i.e.
# profiles).
dno <- argo@metadata$dataNamesOriginal
dnoRev <- list()
for (name in names(dno))
dnoRev[[dno[[name]]]] <- name
if (debug > 1) { # show only at a high debug level
cat("dnoRev follows:\n")
cat(str(dnoRev))
}
for (icol in seq_len(ncol)) { # BGC case
pdm <- argo@metadata$parameterDataMode[icol]
# Dewey Dunnington realized that 'stationParameters' is what we need next, not 'parameters'.
# (See https://github.com/ArgoCanada/argoFloats/issues/418 for discussion.)
parameters <- trimws(as.vector(argo@metadata$stationParameters[,icol]))
parameters <- parameters[nchar(parameters) > 0]
argoFloatsDebug(debug, "Profile ", icol, " of ", ncol, "\n", sep="")
argoFloatsDebug(debug, " mode: \"", pdm, "\"\n", sep="")
argoFloatsDebug(debug, " parameters: ", paste(parameters,collapse=" "), "\n", sep="")
varNamesRaw <- unlist(lapply(parameters, function(n) dnoRev[[n]]))
for (name in varNamesRaw) {
argoFloatsDebug(debug, " ", name, " (AKA ", dno[[name]], ")\n", sep="")
adjustedName <- paste0(name, "Adjusted")
# Can only copy if we have an Adjusted field (which is not always the case).
if (adjustedName %in% varNamesAdjusted) {
# Look up data-mode for this variable in this profile
w <- which(parameters == dno[name])
if (length(w)) {
pdmThis <- substr(pdm, w, w)
# Copy <PARAM>Adjusted into <PARAM> if either of the following is true.
# Case 1. fallback is FALSE
# Case 2. fallback is TRUE and mode is "A" or "D"
case <- if (!fallback) { 1 } else if (pdmThis %in% c("A", "D")) { 2 } else { 0 }
if (case > 0) {
res@data[[name]][,icol] <- argo@data[[adjustedName]][,icol]
res@metadata$flags[[name]][,icol] <- argo@metadata$flags[[adjustedName]][,icol]
if (!fallback) {
argoFloatsDebug(debug, " copied ", adjustedName, " to ", name, ", since fallback=", fallback, "\n", sep="")
} else {
argoFloatsDebug(debug, " copied ", adjustedName, " to ", name, ", since fallback=", fallback, " and mode=", pdmThis, "\n", sep="")
}
} else {
if (!fallback) {
argoFloatsDebug(debug, " retaining original, since fallback=", fallback, "\n", sep="")
} else {
argoFloatsDebug(debug, " retaining original, since fallback=", fallback, " and data-mode is ", pdmThis, "\n", sep="")
}
}
} else {
argoFloatsDebug(debug, " \"", name, "\" is not present in this profile\n")
}
} else {
argoFloatsDebug(debug, " retaining original, since ", adjustedName, " is not present\n", sep="")
}
}
# argoFloatsDebug(debug, "this cycle is of not of 'core' type; next is parameterDataMode:\n")
# if (debug)
# print(parameterDataMode)
}
}
res@processingLog <- oce::processingLogAppend(res@processingLog,
paste0("useAdjustedSingle(argo, fallback=\"", fallback, "\", debug=", debug, ")\n"))
argoFloatsDebug(debug, "} # useAdjustedSingle()\n", sep="", unindent=1, style="bold")
res
}
#' Switch [[ and Plot to Focus on Adjusted Data, if Available
#'
#' `useAdjusted` returns a copy of an [`argoFloats-class`] object
#' within which the individual
#' [oce::argo-class] objects may have been modified so that future calls to
#' \code{\link{[[,argoFloats-method}}
#' or \code{\link{plot,argoFloats-method}}
#' will focus with
#' *adjusted* versions of the data. (Note that this modification cannot
#' be done for fields that lack adjusted values, so in such cases future
#' calls to
#' \code{\link{[[,argoFloats-method}}
#' or
#' \code{\link{plot,argoFloats-method}}
#' work with the unadjusted fields.)
#' The procedure is done profile by profile and parameter by parameter.
#' The `fallback` argument offers a way to ''fall back'' to unadjusted
#' values, depending on the data-mode (real-time, adjusted or delayed)
#' for individual items; see \dQuote{Details}.
#'
#' There are two cases. First, if `fallback` is `FALSE` (which the default)
#' then the focus switches entirely
#' to the adjusted data. This improves the overall reliability of the results,
#' but at the cost of eliminating real-time data. This is because the
#' adjusted fields for real-time data are set to `NA` as a matter of policy (see
#' section 2.2.5 of reference 1).
#'
#' Wider data coverage is obtained if `fallback` is `TRUE`. In this
#' case, the focus is shifted to adjusted data *only if* the data-mode for
#' the individual profiles is `A` or `D`, indicating either Adjusted or
#' Delayed mode. Any profiles that are of the `R` (Realtime) data-mode are
#' left unaltered. This blending of adjusted and unadjusted data offers
#' improved spatial and temporal coverage, while reducing the overall
#' data quality, and so this approach should be used with caution. For more
#' on this function see section 3.4 of Kelley et. al (2021).
#'
#' @param argos an [`argoFloats-class`] object, as read by [readProfiles()].
#'
#' @param fallback a logical value indicating whether to 'fall back' from
#' adjusted data to raw data for profiles that are in real-time mode. By
#' default, `fallback` is `FALSE`, to focus entirely on
#' adjusted data. See \dQuote{Details}.
#'
#' @param debug an integer that controls whether debugging information is printed
#' during processing. If `debug` is 0 or less, then no information is printed.
#' If it is 1 then minimal overall information is printed. If it exceeds 1,
#' then information is printed for each Argo cycle contained in `argos`.
#'
#' @examples
#' library(argoFloats)
#' file <- "SD5903586_001.nc"
#' raw <- readProfiles(system.file("extdata", file, package="argoFloats"))
#' adj <- useAdjusted(raw)
#' # Autoscale with adjusted values so frame shows both raw and adjusted.
#' plot(adj, which="profile", profileControl=list(parameter="oxygen"), pch=2)
#' points(raw[[1]][["oxygen"]], raw[[1]][["pressure"]], pch=1)
#' legend("bottomright", pch=c(2,1), legend=c("Raw", "Adjusted"))
#'
#' @author Dan Kelley, Jaimie Harbin and Clark Richards
#'
#' @references
#' 1. Argo Data Management Team. "Argo User's Manual V3.4,"
#' January 20, 2021. `https://archimer.ifremer.fr/doc/00187/29825/`
#'
#' 2. Kelley, D. E., Harbin, J., & Richards, C. (2021). argoFloats: An R package for analyzing
#' Argo data. Frontiers in Marine Science, (8), 636922.
#' \doi{10.3389/fmars.2021.635922}
#'
#' @return `useAdjusted` returns an [`argoFloats-class`] object that is similar to
#' its first argument, but which is set up so that future calls to
#' \code{\link{[[,argoFloats-method}} or \code{\link{plot,argoFloats-method}}
#' will focus on the "adjusted" data stream.
#'
#' @importFrom utils str
#' @export
useAdjusted <- function(argos, fallback=FALSE, debug=0)
{
argoFloatsDebug(debug, "useAdjusted(..., fallback=", fallback, ", debug=", debug, ") {\n", sep="", unindent=1, style="bold")
if (!inherits(argos, "argoFloats"))
stop("'argos' must be an argoFloats object")
if ("argos" != argos@metadata$type)
stop("'argos' must be an argoFloats object created with argoFloats::readProfiles()")
if (!is.logical(fallback))
stop("fallback value \"", fallback, "\" is not understood. It must be TRUE or FALSE")
debug <- ifelse(debug > 3, 3L, as.integer(debug)) # limit depth
res <- argos
argoList <- argos[["argos"]]
for (i in seq_along(argoList)) {
res@data$argos[[i]] <- useAdjustedSingle(argoList[[i]], fallback=fallback, debug=debug-1)
}
res@processingLog <- oce::processingLogAppend(res@processingLog, paste(deparse(match.call()), sep="", collapse=""))
argoFloatsDebug(debug, "} # useAdjusted()\n", sep="", unindent=1, style="bold")
res
}