Commit 73f199a8 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.2.12.21 CLEAN: obs argument renamed into Obs in CreateRunOptions

parent 9cc16f77
Package: airGR Package: airGR
Type: Package Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.2.12.20 Version: 1.2.12.21
Date: 2019-04-01 Date: 2019-04-01
Authors@R: c( Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
...@@ -13,13 +13,13 @@ output: ...@@ -13,13 +13,13 @@ output:
### 1.2.12.20 Release Notes (2019-04-01) ### 1.2.12.21 Release Notes (2019-04-01)
#### Deprecated and defunct #### Deprecated and defunct
- The <code>Qobs</code> argument is now deprecated in <code>CreateRunOptions()</code> and has been renamed <code>obs</code>. - The <code>Qobs</code> argument is now deprecated in <code>CreateRunOptions()</code> and has been renamed <code>Obs</code>.
- The <code>FUN_CRIT</code> argument is now deprecated in <code>ErrorCrit()</code>. This function now gets this information from the <code>InputsCrit</code> argument. - The <code>FUN_CRIT</code> argument is now deprecated in <code>ErrorCrit()</code>. This function now gets this information from the <code>InputsCrit</code> argument.
...@@ -31,7 +31,7 @@ output: ...@@ -31,7 +31,7 @@ output:
#### New features #### New features
- <code>CreateInputsCrit()</code> now can prepare an <code>InputsCrit</code> object in order to compute a single criterion (<code>Single</code> class), multiple criteria (<code>Multi</code> class) with the <code>ErrorCrit()</code> function. So it is now possible to set the following arguments as atomic (as before) or as list: <code>FUN_CRIT</code>, <code>obs</code>, <code>BoolCrit</code>, <code>transfo</code>, <code>weights</code>. If the list format is chosen, all the lists must have the same length. - <code>CreateInputsCrit()</code> now can prepare an <code>InputsCrit</code> object in order to compute a single criterion (<code>Single</code> class), multiple criteria (<code>Multi</code> class) with the <code>ErrorCrit()</code> function. So it is now possible to set the following arguments as atomic (as before) or as list: <code>FUN_CRIT</code>, <code>Obs</code>, <code>BoolCrit</code>, <code>transfo</code>, <code>weights</code>. If the list format is chosen, all the lists must have the same length.
- <code>CreateInputsCrit()</code> now presents a <code>varObs</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order run a criterion on other variable than observed discharges with the <code>ErrorCrit()</code> function (e.g. SCA, SWE). - <code>CreateInputsCrit()</code> now presents a <code>varObs</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order run a criterion on other variable than observed discharges with the <code>ErrorCrit()</code> function (e.g. SCA, SWE).
......
...@@ -2,7 +2,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -2,7 +2,7 @@ CreateInputsCrit <- function(FUN_CRIT,
InputsModel, InputsModel,
RunOptions, RunOptions,
Qobs, # deprecated Qobs, # deprecated
obs, Obs,
varObs = "Q", varObs = "Q",
BoolCrit = NULL, BoolCrit = NULL,
transfo = "", transfo = "",
...@@ -19,14 +19,14 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -19,14 +19,14 @@ CreateInputsCrit <- function(FUN_CRIT,
## ---------- check arguments ## ---------- check arguments
if (!missing(Qobs)) { if (!missing(Qobs)) {
if (missing(obs)) { if (missing(Obs)) {
if (warnings) { if (warnings) {
warning("argument 'Qobs' is deprecated. Please use 'obs' and 'varObs' instead") warning("argument 'Qobs' is deprecated. Please use 'Obs' and 'varObs' instead")
} }
obs <- Qobs Obs <- Qobs
# varObs <- "Qobs" # varObs <- "Qobs"
} else { } else {
warning("argument 'Qobs' is deprecated. The values set in 'obs' will be used instead") warning("argument 'Qobs' is deprecated. The values set in 'Obs' will be used instead")
} }
} }
if (!missing(Ind_zeroes) & warnings) { if (!missing(Ind_zeroes) & warnings) {
...@@ -47,29 +47,29 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -47,29 +47,29 @@ CreateInputsCrit <- function(FUN_CRIT,
LLL <- length(InputsModel$DatesR[RunOptions$IndPeriod_Run]) LLL <- length(InputsModel$DatesR[RunOptions$IndPeriod_Run])
## check 'obs' and definition of idLayer ## check 'Obs' and definition of idLayer
vecObs <- unlist(obs) vecObs <- unlist(Obs)
if (length(vecObs) %% LLL != 0 | !is.numeric(vecObs)) { if (length(vecObs) %% LLL != 0 | !is.numeric(vecObs)) {
stop(sprintf("'obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE) stop(sprintf("'Obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE)
} }
if (!is.list(obs)) { if (!is.list(Obs)) {
idLayer <- list(1L) idLayer <- list(1L)
obs <- list(obs) Obs <- list(Obs)
} else { } else {
idLayer <- lapply(obs, function(i) { idLayer <- lapply(Obs, function(i) {
if (is.list(i)) { if (is.list(i)) {
length(i) length(i)
} else { } else {
1L 1L
} }
}) })
obs <- lapply(obs, function(x) rowMeans(as.data.frame(x))) Obs <- lapply(Obs, function(x) rowMeans(as.data.frame(x)))
} }
## create list of arguments ## create list of arguments
listArgs <- list(FUN_CRIT = FUN_CRIT, listArgs <- list(FUN_CRIT = FUN_CRIT,
obs = obs, Obs = Obs,
varObs = varObs, varObs = varObs,
BoolCrit = BoolCrit, BoolCrit = BoolCrit,
idLayer = idLayer, idLayer = idLayer,
...@@ -99,7 +99,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -99,7 +99,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'varObs' ## check 'varObs'
if (missing(varObs)) { if (missing(varObs)) {
listArgs$varObs <- as.list(rep("Q", times = length(listArgs$obs))) listArgs$varObs <- as.list(rep("Q", times = length(listArgs$Obs)))
# if (warnings) { # if (warnings) {
# warning("'varObs' automatically set to \"Q\"") # warning("'varObs' automatically set to \"Q\"")
# } # }
...@@ -123,7 +123,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -123,7 +123,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'transfo' ## check 'transfo'
if (missing(transfo)) { if (missing(transfo)) {
listArgs$transfo <- as.list(rep("", times = length(listArgs$obs))) listArgs$transfo <- as.list(rep("", times = length(listArgs$Obs)))
# if (warnings) { # if (warnings) {
# warning("'transfo' automatically set to \"\"") # warning("'transfo' automatically set to \"\"")
# } # }
...@@ -175,14 +175,14 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -175,14 +175,14 @@ CreateInputsCrit <- function(FUN_CRIT,
stop("calculating a composite criterion with the RMSE is not allowed since RMSE is not a dimensionless metric", call. = FALSE) stop("calculating a composite criterion with the RMSE is not allowed since RMSE is not a dimensionless metric", call. = FALSE)
} }
## check 'obs' ## check 'Obs'
if (!is.vector(iListArgs2$obs) | length(iListArgs2$obs) != LLL | !is.numeric(iListArgs2$obs)) { if (!is.vector(iListArgs2$Obs) | length(iListArgs2$Obs) != LLL | !is.numeric(iListArgs2$Obs)) {
stop(sprintf("'obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE) stop(sprintf("'Obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE)
} }
## check 'BoolCrit' ## check 'BoolCrit'
if (is.null(iListArgs2$BoolCrit)) { if (is.null(iListArgs2$BoolCrit)) {
iListArgs2$BoolCrit <- rep(TRUE, length(iListArgs2$obs)) iListArgs2$BoolCrit <- rep(TRUE, length(iListArgs2$Obs))
} }
if (!is.logical(iListArgs2$BoolCrit)) { if (!is.logical(iListArgs2$BoolCrit)) {
stop("'BoolCrit' must be a (list of) vector(s) of boolean", call. = FALSE) stop("'BoolCrit' must be a (list of) vector(s) of boolean", call. = FALSE)
...@@ -196,28 +196,28 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -196,28 +196,28 @@ CreateInputsCrit <- function(FUN_CRIT,
stop(msgVarObs, call. = FALSE) stop(msgVarObs, call. = FALSE)
} }
## check 'varObs' + 'obs' ## check 'varObs' + 'Obs'
if (any(iListArgs2$varObs %in% "SCA")) { if (any(iListArgs2$varObs %in% "SCA")) {
idSCA <- which(iListArgs2$varObs == "SCA") idSCA <- which(iListArgs2$varObs == "SCA")
if (length(idSCA) == 1L) { if (length(idSCA) == 1L) {
vecSCA <- iListArgs2$obs vecSCA <- iListArgs2$Obs
} else { } else {
vecSCA <- unlist(iListArgs2$obs[idSCA]) vecSCA <- unlist(iListArgs2$Obs[idSCA])
} }
if (min(vecSCA, na.rm = TRUE) < 0 | max(vecSCA, na.rm = TRUE) > 1) { if (min(vecSCA, na.rm = TRUE) < 0 | max(vecSCA, na.rm = TRUE) > 1) {
stop("'obs' outside [0,1] for \"SCA\"", call. = FALSE) stop("'Obs' outside [0,1] for \"SCA\"", call. = FALSE)
} }
} }
inPosVarObs <- c("Q", "SWE") inPosVarObs <- c("Q", "SWE")
if (any(iListArgs2$varObs %in% inPosVarObs)) { if (any(iListArgs2$varObs %in% inPosVarObs)) {
idQSS <- which(iListArgs2$varObs %in% inPosVarObs) idQSS <- which(iListArgs2$varObs %in% inPosVarObs)
if (length(idQSS) == 1L) { if (length(idQSS) == 1L) {
vecQSS <- iListArgs2$obs vecQSS <- iListArgs2$Obs
} else { } else {
vecQSS <- unlist(iListArgs2$obs[idQSS]) vecQSS <- unlist(iListArgs2$Obs[idQSS])
} }
if (min(vecQSS, na.rm = TRUE) < 0) { if (min(vecQSS, na.rm = TRUE) < 0) {
stop(sprintf("'obs' outside [0,Inf[ for \"%s\"", iListArgs2$varObs), call. = FALSE) stop(sprintf("'Obs' outside [0,Inf[ for \"%s\"", iListArgs2$varObs), call. = FALSE)
} }
} }
...@@ -239,13 +239,13 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -239,13 +239,13 @@ CreateInputsCrit <- function(FUN_CRIT,
if (!is.vector(iListArgs2$epsilon) | length(iListArgs2$epsilon) != 1 | !is.numeric(iListArgs2$epsilon) | any(iListArgs2$epsilon <= 0)) { if (!is.vector(iListArgs2$epsilon) | length(iListArgs2$epsilon) != 1 | !is.numeric(iListArgs2$epsilon) | any(iListArgs2$epsilon <= 0)) {
stop("'epsilon' must be a single (list of) positive value(s)", call. = FALSE) stop("'epsilon' must be a single (list of) positive value(s)", call. = FALSE)
} }
} else if (iListArgs2$transfo %in% c("log", "inv") & any(iListArgs2$obs %in% 0) & warnings) { } else if (iListArgs2$transfo %in% c("log", "inv") & any(iListArgs2$Obs %in% 0) & warnings) {
warning("zeroes detected in obs: the corresponding time-steps will be excluded by the 'ErrorCrit*' functions as the epsilon argument was set to NULL", call. = FALSE) warning("zeroes detected in Obs: the corresponding time-steps will be excluded by the 'ErrorCrit*' functions as the epsilon argument was set to NULL", call. = FALSE)
} }
## check 'transfo' + 'FUN_CRIT' ## check 'transfo' + 'FUN_CRIT'
if (iListArgs2$transfo == "log" & warnings) { if (iListArgs2$transfo == "log" & warnings) {
warn_log_kge <- "we do not advise using the %s with a log transformation on obs (see the details section in the 'CreateInputsCrit' help)" warn_log_kge <- "we do not advise using the %s with a log transformation on Obs (see the details section in the 'CreateInputsCrit' help)"
if (identical(iListArgs2$FUN_CRIT, ErrorCrit_KGE)) { if (identical(iListArgs2$FUN_CRIT, ErrorCrit_KGE)) {
warning(sprintf(warn_log_kge, "KGE"), call. = FALSE) warning(sprintf(warn_log_kge, "KGE"), call. = FALSE)
} }
...@@ -256,7 +256,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -256,7 +256,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## Create InputsCrit ## Create InputsCrit
iInputsCrit <- list(FUN_CRIT = iListArgs2$FUN_CRIT, iInputsCrit <- list(FUN_CRIT = iListArgs2$FUN_CRIT,
obs = iListArgs2$obs, Obs = iListArgs2$Obs,
varObs = iListArgs2$varObs, varObs = iListArgs2$varObs,
BoolCrit = iListArgs2$BoolCrit, BoolCrit = iListArgs2$BoolCrit,
idLayer = iListArgs2$idLayer, idLayer = iListArgs2$idLayer,
...@@ -286,7 +286,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -286,7 +286,7 @@ CreateInputsCrit <- function(FUN_CRIT,
for (iInCnVarObs in inCnVarObs) { for (iInCnVarObs in inCnVarObs) {
if (any(listVarObs %in% iInCnVarObs)) { if (any(listVarObs %in% iInCnVarObs)) {
if (tabGroupLayer[tabGroupLayer$varObs %in% iInCnVarObs, "freq"] != nLayers) { if (tabGroupLayer[tabGroupLayer$varObs %in% iInCnVarObs, "freq"] != nLayers) {
stop(sprintf("'obs' must contain %i vector(s) about %s", nLayers, iInCnVarObs)) stop(sprintf("'Obs' must contain %i vector(s) about %s", nLayers, iInCnVarObs))
} }
} }
} }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment