v1.2.14.0 NEW: power transformation allowed in CreateInputsCrit

DESCRIPTION

 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"),

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_&#42;()</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_&#42;()</code> functions now return an error message if the <code>InputsCrit</code> object is of class <code>Multi</code> or <code>Compo</code>.

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) {

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}