From 143d21a9b69aecfd626a14be92807a08b70f1de8 Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.priv>
Date: Tue, 16 Apr 2019 17:24:43 +0200
Subject: [PATCH] v1.2.14.0 NEW: power transformation allowed in
CreateInputsCrit
---
DESCRIPTION | 4 ++--
NEWS.rmd | 17 ++++++++++++++---
R/CreateInputsCrit.R | 42 ++++++++++++++++++++++++++---------------
man/CreateInputsCrit.Rd | 2 +-
4 files changed, 44 insertions(+), 21 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 688b7a90..4f98a4d7 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.2.13.17
-Date: 2019-04-04
+Version: 1.2.14.0
+Date: 2019-04-16
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@irstea.fr"),
diff --git a/NEWS.rmd b/NEWS.rmd
index 7c6eab96..30cdf6b4 100644
--- a/NEWS.rmd
+++ b/NEWS.rmd
@@ -14,7 +14,19 @@ output:
-### 1.2.13.17 Release Notes (2019-04-04)
+### 1.2.14.0 Release Notes (2019-04-16)
+
+
+#### New features
+
+- <code>CreateInputsCrit()</code> now allows power transformation (as numeric or character values) in the <code>transfo</code> argument.
+
+
+#### Minor user-visible changes
+
+- <code>ErrorCrit_*()</code> functions now call <code>.ErrorCrit()</code> in order to check.
+
+____________________________________________________________________________________
### 1.2.13.16 Release Notes (2019-04-03)
@@ -43,7 +55,7 @@ output:
- <code>CreateInputsCrit()</code> now presents a <code>warnings</code> argument to replace the verbose action (the <code>verbose</code> argument is kept to print messages).
-- In <code>CreateInputsCrit()</code>, it is now possible to set the following arguments as atomic (as before) or as list: <code>FUN_CRIT</code>, <code>VarObs</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. XXXXX mélange new args et usage XXXX
+- In <code>CreateInputsCrit()</code>, it is now possible to set the following arguments as atomic (as before) or as list: <code>FUN_CRIT</code>, <code>VarObs</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>CreateRunOptions()</code>, <code>CreateIniStates()</code> and <code>CreateCalibOptions()</code> now present a <code>IsHyst</code> argument to give the possibility to use the Linear Hysteresis with CemaNeige. The objects returned present an <code>hysteresis</code> class.
@@ -58,7 +70,6 @@ output:
#### Major user-visible changes
-
- <code>CreateInputsCrit()</code> now return a list of <code>InputsCrit</code> (each element is of the <code>Single</code> class) in the cases of multiple or a composite criteria.
- <code>ErrorCrit_*()</code> functions now return an error message if the <code>InputsCrit</code> object is of class <code>Multi</code> or <code>Compo</code>.
diff --git a/R/CreateInputsCrit.R b/R/CreateInputsCrit.R
index 02880748..e7df0f07 100644
--- a/R/CreateInputsCrit.R
+++ b/R/CreateInputsCrit.R
@@ -57,15 +57,15 @@ CreateInputsCrit <- function(FUN_CRIT,
Obs <- list(Obs)
} else {
idLayer <- lapply(Obs, function(i) {
- if (is.list(i)) {
- length(i)
- } else {
- 1L
- }
- })
+ if (is.list(i)) {
+ length(i)
+ } else {
+ 1L
+ }
+ })
Obs <- lapply(Obs, function(x) rowMeans(as.data.frame(x)))
}
-
+
## create list of arguments
listArgs <- list(FUN_CRIT = FUN_CRIT,
@@ -73,7 +73,7 @@ CreateInputsCrit <- function(FUN_CRIT,
VarObs = VarObs,
BoolCrit = BoolCrit,
idLayer = idLayer,
- transfo = transfo,
+ transfo = as.character(transfo),
Weights = Weights,
epsilon = epsilon)
@@ -119,7 +119,7 @@ CreateInputsCrit <- function(FUN_CRIT,
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")
}
-
+
## check 'transfo'
if (missing(transfo)) {
@@ -146,7 +146,7 @@ CreateInputsCrit <- function(FUN_CRIT,
if (length(listArgs$Weights) > 1 & sum(unlist(listArgs$Weights)) == 0 & !any(sapply(listArgs$Weights, is.null))) {
stop("sum of 'Weights' cannot be equal to zero")
}
-
+
## ---------- reformat
@@ -157,8 +157,8 @@ CreateInputsCrit <- function(FUN_CRIT,
inVarObs <- c("Q", "SCA", "SWE")
msgVarObs <- "'VarObs' must be a (list of) character vector(s) and one of %s"
msgVarObs <- sprintf(msgVarObs, paste(sapply(inVarObs, shQuote), collapse = ", "))
- inTransfo <- c("", "sqrt", "log", "inv", "sort")
- msgTransfo <- "'transfo' must be a (list of) character vector(s) and one of %s"
+ inTransfo <- c("", "sqrt", "log", "inv", "sort") # pow is not checked by inTransfo, but appears in the warning message and checkef after (see ## check 'transfo')
+ msgTransfo <- "'transfo' must be a (list of) character vector(s) and one of %s, or numeric value for power transformation"
msgTransfo <- sprintf(msgTransfo, paste(sapply(inTransfo, shQuote), collapse = ", "))
@@ -216,6 +216,9 @@ CreateInputsCrit <- function(FUN_CRIT,
} else {
vecQSS <- unlist(iListArgs2$Obs[idQSS])
}
+ if (all(is.na(vecQSS))) {
+ stop("'Obs' contains only missing values", call. = FALSE)
+ }
if (min(vecQSS, na.rm = TRUE) < 0) {
stop(sprintf("'Obs' outside [0,Inf[ for \"%s\"", iListArgs2$VarObs), call. = FALSE)
}
@@ -223,9 +226,18 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'transfo'
- if (is.null(iListArgs2$transfo) | !is.vector(iListArgs2$transfo) | length(iListArgs2$transfo) != 1 | !is.character(iListArgs2$transfo) | !all(iListArgs2$transfo %in% inTransfo)) {
+ if (is.null(iListArgs2$transfo) | !is.vector(iListArgs2$transfo) | length(iListArgs2$transfo) != 1 | !is.character(iListArgs2$transfo)) {
stop(msgTransfo, call. = FALSE)
}
+ isNotInTransfo <- !(iListArgs2$transfo %in% inTransfo)
+ if (any(isNotInTransfo)) {
+ powTransfo <- iListArgs2$transfo[isNotInTransfo]
+ numExpTransfo <- suppressWarnings(as.numeric(powTransfo))
+ if (any(is.na(numExpTransfo))) {
+ stop(msgTransfo, call. = FALSE)
+ }
+ iListArgs2$transfo <- paste0("^", iListArgs2$transfo)
+ }
## check 'Weights'
if (!is.null(iListArgs2$Weights)) {
@@ -253,7 +265,7 @@ CreateInputsCrit <- function(FUN_CRIT,
warning(sprintf(warn_log_kge, "KGE'"), call. = FALSE)
}
}
-
+
## Create InputsCrit
iInputsCrit <- list(FUN_CRIT = iListArgs2$FUN_CRIT,
Obs = iListArgs2$Obs,
@@ -310,7 +322,7 @@ CreateInputsCrit <- function(FUN_CRIT,
}
}
}
-
+
## if only one criterion --> not a list of InputsCrit but directly an InputsCrit
if (length(InputsCrit) < 2) {
diff --git a/man/CreateInputsCrit.Rd b/man/CreateInputsCrit.Rd
index e35d4e29..07ee3b2b 100644
--- a/man/CreateInputsCrit.Rd
+++ b/man/CreateInputsCrit.Rd
@@ -32,7 +32,7 @@ CreateInputsCrit(FUN_CRIT, InputsModel, RunOptions,
\item{BoolCrit}{(optional) [boolean (atomic or list)] boolean (the same length as \code{Obs}) giving the time steps to consider in the computation (all time steps are considered by default)}
-\item{transfo}{(optional) [character (atomic or list)] name of the transformation (e.g. \code{""}, \code{"sqrt"}, \code{"log"}, \code{"inv"}, \code{"sort"})}
+\item{transfo}{(optional) [character (atomic or list)] name of the transformation (e.g. \code{""}, \code{"sqrt"}, \code{"log"}, \code{"inv"}, \code{"sort"} or numeric value for power transformation (see details))}
\item{Weights}{(optional) [numeric (atomic or list)] vector of weights necessary to calculate a composite criterion (the same length as \code{FUN_CRIT}) giving the weights to use for elements of \code{FUN_CRIT} [-]. See details}
--
GitLab