Commit d5c355a7 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

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

Showing with 26 additions and 8 deletions
+26 -8
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")),
......
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, ])
......
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