diff --git a/DESCRIPTION b/DESCRIPTION index ca9bb5c5d543fcdd5f46cde168ffe5a9fae6e98b..478ecfe7075f3c9fc1118887dc8846e23de97125 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 d1f0dcddf5422a7136b50b7513fa371c085e7bd2..d121cd305e77b0cf6eb58d441247e96001b169ad 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, ])