Skip to content
GitLab
Commit 1d026a06 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.2.12.23 CLEAN: varObs argument renamed into VarObs in CreateRunOptions

parent 7cc62c5a
dev 115-add-pcict-date-format-managment 118-plot-outputsmodel-remove-case-sensitivity-to-the-which-argument 136-decreased-performance-of-calibration-execution-time 60-migrate-transfoparam-functions-and-createcaliboptions-to-s3-methods 96-parallelize-the-grid-screening-step-during-calibration airGRplus cleanAirGRplus master CRAN_v1.7.0 CRAN_v1.6.12 CRAN_v1.6.11 CRAN_v1.6.10.4 CRAN_v1.6.9.27 CRAN_v1.6.9.24 CRAN_v1.6.9.23 CRAN_v1.6.9.21 CRAN_v1.4.3.65 CRAN_v1.4.3.60 CRAN_v1.4.3.52 CRAN_v1.3.2.42 CRAN_v1.3.2.41 CRAN_v1.3.2.40 CRAN_v1.3.2.39 CRAN_v1.3.2.23 CRAN_v1.3.2.17 CRAN_v1.2.13.16 CRAN_v1.2.13.13
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 33 additions and 33 deletions
+33 -33
DESCRIPTION
+ 1
− 1
View file @ 1d026a06
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.22 Version: 1.2.12.23
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")),
......
NEWS.rmd
+ 2
− 2
View file @ 1d026a06
...@@ -13,7 +13,7 @@ output: ...@@ -13,7 +13,7 @@ output:
### 1.2.12.22 Release Notes (2019-04-01) ### 1.2.12.23 Release Notes (2019-04-01)
...@@ -33,7 +33,7 @@ output: ...@@ -33,7 +33,7 @@ output:
- <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).
- <code>CreateInputsCrit()</code> now presents a <code>weights</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order to compute a composite criterion (<code>Compo</code> class) with <code>ErrorCrit()</code> or <code>Calibration_Michel()</code>. - <code>CreateInputsCrit()</code> now presents a <code>weights</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order to compute a composite criterion (<code>Compo</code> class) with <code>ErrorCrit()</code> or <code>Calibration_Michel()</code>.
......
R/CreateInputsCrit.R
+ 30
− 30
View file @ 1d026a06
...@@ -3,7 +3,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -3,7 +3,7 @@ CreateInputsCrit <- function(FUN_CRIT,
RunOptions, RunOptions,
Qobs, # deprecated Qobs, # deprecated
Obs, Obs,
varObs = "Q", VarObs = "Q",
BoolCrit = NULL, BoolCrit = NULL,
transfo = "", transfo = "",
weights = NULL, weights = NULL,
...@@ -21,10 +21,10 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -21,10 +21,10 @@ CreateInputsCrit <- function(FUN_CRIT,
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")
} }
...@@ -70,7 +70,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -70,7 +70,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## 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,
transfo = transfo, transfo = transfo,
...@@ -85,7 +85,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -85,7 +85,7 @@ CreateInputsCrit <- function(FUN_CRIT,
listArgs[[iArgs]] <- lapply(seq_along(listArgs$FUN_CRIT), function(x) NULL) listArgs[[iArgs]] <- lapply(seq_along(listArgs$FUN_CRIT), function(x) NULL)
} }
} }
if (iArgs %in% c("FUN_CRIT", "varObs", "transfo", "weights") & length(listArgs[[iArgs]]) > 1L) { if (iArgs %in% c("FUN_CRIT", "VarObs", "transfo", "weights") & length(listArgs[[iArgs]]) > 1L) {
listArgs[[iArgs]] <- as.list(listArgs[[iArgs]]) listArgs[[iArgs]] <- as.list(listArgs[[iArgs]])
} }
if (!is.list(listArgs[[iArgs]])) { if (!is.list(listArgs[[iArgs]])) {
...@@ -97,26 +97,26 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -97,26 +97,26 @@ CreateInputsCrit <- function(FUN_CRIT,
listArgs$FUN_CRIT <- lapply(listArgs$FUN_CRIT, FUN = match.fun) listArgs$FUN_CRIT <- lapply(listArgs$FUN_CRIT, FUN = match.fun)
## 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\"")
# } # }
} }
## check 'varObs' + 'RunOptions' ## check 'VarObs' + 'RunOptions'
if ("Q" %in% varObs & !inherits(RunOptions, "GR")) { if ("Q" %in% VarObs & !inherits(RunOptions, "GR")) {
stop("'varObs' cannot contain Q if a GR rainfall-runoff model is not used") stop("'VarObs' cannot contain Q if a GR rainfall-runoff model is not used")
} }
if (any(c("SCA", "SWE") %in% varObs) & !inherits(RunOptions, "CemaNeige")) { if (any(c("SCA", "SWE") %in% VarObs) & !inherits(RunOptions, "CemaNeige")) {
stop("'varObs' cannot contain SCA or SWE if CemaNeige is not used") stop("'VarObs' cannot contain SCA or SWE if CemaNeige is not used")
} }
if ("SCA" %in% varObs & inherits(RunOptions, "CemaNeige") & !"Gratio" %in% RunOptions$Outputs_Sim) { if ("SCA" %in% VarObs & inherits(RunOptions, "CemaNeige") & !"Gratio" %in% RunOptions$Outputs_Sim) {
stop("'Gratio' is missing in 'Outputs_Sim' of 'RunOptions', which is necessary to output SCA with CemaNeige") stop("'Gratio' is missing in 'Outputs_Sim' of 'RunOptions', which is necessary to output SCA with CemaNeige")
} }
if ("SWE" %in% varObs & inherits(RunOptions, "CemaNeige") & !"SnowPack" %in% RunOptions$Outputs_Sim) { if ("SWE" %in% VarObs & inherits(RunOptions, "CemaNeige") & !"SnowPack" %in% RunOptions$Outputs_Sim) {
stop("'SnowPack' is missing in 'Outputs_Sim' of 'RunOptions', which is necessary to output SWE with CemaNeige") stop("'SnowPack' is missing in 'Outputs_Sim' of 'RunOptions', which is necessary to output SWE with CemaNeige")
} }
...@@ -155,7 +155,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -155,7 +155,7 @@ CreateInputsCrit <- function(FUN_CRIT,
## preparation of warning messages ## preparation of warning messages
inVarObs <- c("Q", "SCA", "SWE") inVarObs <- c("Q", "SCA", "SWE")
msgVarObs <- "'varObs' must be a (list of) character vector(s) and one of %s" msgVarObs <- "'VarObs' must be a (list of) character vector(s) and one of %s"
msgVarObs <- sprintf(msgVarObs, paste(sapply(inVarObs, shQuote), collapse = ", ")) msgVarObs <- sprintf(msgVarObs, paste(sapply(inVarObs, shQuote), collapse = ", "))
inTransfo <- c("", "sqrt", "log", "inv", "sort") inTransfo <- c("", "sqrt", "log", "inv", "sort")
msgTransfo <- "'transfo' must be a (list of) character vector(s) and one of %s" msgTransfo <- "'transfo' must be a (list of) character vector(s) and one of %s"
...@@ -191,14 +191,14 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -191,14 +191,14 @@ CreateInputsCrit <- function(FUN_CRIT,
stop("'BoolCrit' and 'InputsModel' series must have the same length", call. = FALSE) stop("'BoolCrit' and 'InputsModel' series must have the same length", call. = FALSE)
} }
## check 'varObs' ## check 'VarObs'
if (!is.vector(iListArgs2$varObs) | length(iListArgs2$varObs) != 1 | !is.character(iListArgs2$varObs) | !all(iListArgs2$varObs %in% inVarObs)) { if (!is.vector(iListArgs2$VarObs) | length(iListArgs2$VarObs) != 1 | !is.character(iListArgs2$VarObs) | !all(iListArgs2$VarObs %in% inVarObs)) {
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 {
...@@ -209,15 +209,15 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -209,15 +209,15 @@ CreateInputsCrit <- function(FUN_CRIT,
} }
} }
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)
} }
} }
...@@ -257,7 +257,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -257,7 +257,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,
transfo = iListArgs2$transfo, transfo = iListArgs2$transfo,
...@@ -270,22 +270,22 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -270,22 +270,22 @@ CreateInputsCrit <- function(FUN_CRIT,
names(InputsCrit) <- paste0("IC", seq_along(InputsCrit)) names(InputsCrit) <- paste0("IC", seq_along(InputsCrit))
listVarObs <- sapply(InputsCrit, FUN = "[[", "varObs") listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs")
inCnVarObs <- c("SCA", "SWE") inCnVarObs <- c("SCA", "SWE")
if (!"ZLayers" %in% names(InputsModel)) { if (!"ZLayers" %in% names(InputsModel)) {
if(any(listVarObs %in% inCnVarObs)) { if(any(listVarObs %in% inCnVarObs)) {
stop(sprintf("'varObs' can not be equal to %i if CemaNeige is not used", stop(sprintf("'VarObs' can not be equal to %i if CemaNeige is not used",
paste(sapply(inCnVarObs, shQuote), collapse = " or "))) paste(sapply(inCnVarObs, shQuote), collapse = " or ")))
} }
} else { } else {
listGroupLayer0 <- sapply(InputsCrit, FUN = "[[", "idLayer") listGroupLayer0 <- sapply(InputsCrit, FUN = "[[", "idLayer")
listGroupLayer <- rep(listVarObs, times = listGroupLayer0) listGroupLayer <- rep(listVarObs, times = listGroupLayer0)
tabGroupLayer <- as.data.frame(table(listGroupLayer)) tabGroupLayer <- as.data.frame(table(listGroupLayer))
colnames(tabGroupLayer) <- c("varObs", "freq") colnames(tabGroupLayer) <- c("VarObs", "freq")
nLayers <- length(InputsModel$ZLayers) nLayers <- length(InputsModel$ZLayers)
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))
} }
} }
......
Supports Markdown
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