From d5c355a790b5c6954ccd74d67c6e480c3ff45fc5 Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.priv>
Date: Mon, 22 Oct 2018 17:27:28 +0200
Subject: [PATCH] v1.1.2.0 NEW: Calibration_Michel can run using a composite
criterion
---
DESCRIPTION | 2 +-
R/Calibration_Michel.R | 32 +++++++++++++++++++++++++-------
2 files changed, 26 insertions(+), 8 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index ca9bb5c5..478ecfe7 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
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")),
diff --git a/R/Calibration_Michel.R b/R/Calibration_Michel.R
index d1f0dcdd..d121cd30 100644
--- a/R/Calibration_Michel.R
+++ b/R/Calibration_Michel.R
@@ -1,5 +1,5 @@
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, ])
--
GitLab