v1.1.2.0 NEW: Calibration_Michel can run using a composite criterion

DESCRIPTION

 Package: airGR
 Type: Package
 Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.1.1.0
+Version: 1.1.2.0
 Date: 2018-10-22
 Authors@R: c(
   person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),

R/Calibration_Michel.R

 Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions,
-                               FUN_MOD, FUN_CRIT, FUN_TRANSFO = NULL, verbose = TRUE) {
+                                    FUN_MOD, FUN_CRIT, FUN_TRANSFO = NULL, verbose = TRUE) {
   
   
   ##_____Arguments_check_____________________________________________________________________
@@ -14,7 +14,11 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
   if (!inherits(InputsCrit, "InputsCrit")) {
     stop("InputsCrit must be of class 'InputsCrit' \n")
     return(NULL)
-  }  
+  }
+  if (inherits(InputsCrit, "Multi")) {
+    stop("InputsCrit must be of class 'Single' or 'Compo' \n")
+    return(NULL)
+  }
   if (!inherits(CalibOptions, "CalibOptions")) {
     stop("CalibOptions must be of class 'CalibOptions' \n")
     return(NULL)
@@ -22,7 +26,11 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
   if (!inherits(CalibOptions, "HBAN")) {
     stop("CalibOptions must be of class 'HBAN' if Calibration_Michel is used \n")
     return(NULL)
+  }
+  if (!missing(FUN_CRIT)) {
+    warning("argument 'FUN_CRIT' is deprecated. The error criterion function is now automatically get from the 'InputsCrit' object", call. = FALSE)
   }  
+
   
   
   ##_check_FUN_TRANSFO
@@ -171,7 +179,7 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
     Param <- CandidatesParamR[iNew, ]
     OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
     ##Calibration_criterion_computation
-    OutputsCrit <- FUN_CRIT(InputsCrit, OutputsModel, verbose = FALSE)      
+    OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)      
     if (!is.na(OutputsCrit$CritValue)) {
       if (OutputsCrit$CritValue * OutputsCrit$Multiplier < CritOptim) {
         CritOptim <- OutputsCrit$CritValue * OutputsCrit$Multiplier
@@ -206,7 +214,7 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
       message("\t Starting point for steepest-descent local search:")
     }
     message("\t     Param = ", paste(sprintf("%8.3f", ParamStartR), collapse = " , "))
-    message(sprintf("\t     Crit %-12s = %.4f", CritName, CritStart * Multiplier))
+    message(sprintf("\t     Crit. %-12s = %.4f", CritName, CritStart * Multiplier), "\n")
   }
   ##Results_archiving________________________________________________________
   HistParamR[1, ] <- ParamStartR
@@ -321,7 +329,7 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
       Param <- CandidatesParamR[iNew, ]
       OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
       ##Calibration_criterion_computation
-      OutputsCrit <- FUN_CRIT(InputsCrit, OutputsModel, verbose = FALSE)      
+      OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)      
       if (!is.na(OutputsCrit$CritValue)) {
         if (OutputsCrit$CritValue * OutputsCrit$Multiplier < CritOptim) {
           CritOptim <- OutputsCrit$CritValue * OutputsCrit$Multiplier
@@ -382,7 +390,7 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
       Param <- CandidatesParamR[iNew, ]
       OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
       ##Calibration_criterion_computation
-      OutputsCrit <- FUN_CRIT(InputsCrit, OutputsModel, verbose = FALSE)
+      OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
       if (OutputsCrit$CritValue * OutputsCrit$Multiplier < CritOptim) {
         CritOptim <- OutputsCrit$CritValue * OutputsCrit$Multiplier
         iNewOptim <- iNew
@@ -422,7 +430,17 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
   if (verbose) { 
     message(sprintf("\t Calibration completed (%s iterations, %s runs)", NIter, NRuns))
     message("\t     Param = ", paste(sprintf("%8.3f", ParamFinalR), collapse = " , "))
-    message(sprintf("\t     Crit %-12s = %.4f", CritName, CritFinal * Multiplier))
+    message(sprintf("\t     Crit. %-12s = %.4f", CritName, CritFinal * Multiplier), "\n")
+    if (inherits(InputsCrit, "Compo")) {
+      listweights  <- OutputsCrit$CritCompo$MultiCritWeights
+      listNameCrit <- OutputsCrit$CritCompo$MultiCritNames
+      msgForm <- paste(sprintf("%.2f", listweights), listNameCrit, sep = " * ", collapse = ", ")
+      msgForm <- unlist(strsplit(msgForm, split = ","))
+      msgFormSep <- rep(c(",", ",", ",\n\t\t     "), times = ceiling(length(msgForm)/3))[1: length(msgForm)]
+      msgForm <- paste(msgForm, msgFormSep, sep = "", collapse = "")
+      msgForm <- gsub("\\,\\\n\\\t\\\t     $|\\,$", "", msgForm)
+      message("\tFormula: mean(", msgForm, ")\n")
+    }
   }
   ##Results_archiving_______________________________________________________
   HistParamR <- cbind(HistParamR[1:NIter, ])