From 143ad88501ac594737962eaaccea135ede6a7bb1 Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.priv>
Date: Fri, 22 Mar 2019 08:28:51 +0100
Subject: [PATCH] v1.2.11.1 UPDATE: Calibration_Michel now checks the use of
hysteresis from CalibOptions #5252
---
DESCRIPTION | 2 +-
NEWS.rmd | 2 +-
R/Calibration_Michel.R | 64 +++++++++++++++++++++++-------------------
3 files changed, 37 insertions(+), 31 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 5988d279..3c2f142a 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.2.11.0
+Version: 1.2.11.1
Date: 2019-03-22
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
diff --git a/NEWS.rmd b/NEWS.rmd
index 20bfb41e..23999779 100644
--- a/NEWS.rmd
+++ b/NEWS.rmd
@@ -13,7 +13,7 @@ output:
-### 1.2.11.0 Release Notes (2019-03-22)
+### 1.2.11.1 Release Notes (2019-03-22)
diff --git a/R/Calibration_Michel.R b/R/Calibration_Michel.R
index 6051506a..c04c333a 100644
--- a/R/Calibration_Michel.R
+++ b/R/Calibration_Michel.R
@@ -76,7 +76,7 @@ Calibration_Michel <- function(InputsModel,
FUN_TRANSFO <- TransfoParam_GR1A
}
if (identical(FUN_MOD, RunModel_CemaNeige )) {
- if (inherits(FUN_MOD, "hysteresis")) {
+ if (inherits(CalibOptions, "hysteresis")) {
FUN_TRANSFO <- TransfoParam_CemaNeigeHyst
} else {
FUN_TRANSFO <- TransfoParam_CemaNeige
@@ -92,25 +92,43 @@ Calibration_Michel <- function(InputsModel,
if (identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
FUN1 <- TransfoParam_GR6J
}
- if (inherits(FUN_MOD, "hysteresis")) {
+ if (inherits(CalibOptions, "hysteresis")) {
FUN2 <- TransfoParam_CemaNeigeHyst
} else {
FUN2 <- TransfoParam_CemaNeige
}
- FUN_TRANSFO <- function(ParamIn, Direction) {
- Bool <- is.matrix(ParamIn)
- if (Bool == FALSE) {
- ParamIn <- rbind(ParamIn)
+ if (inherits(CalibOptions, "hysteresis")) {
+ FUN_TRANSFO <- function(ParamIn, Direction) {
+ Bool <- is.matrix(ParamIn)
+ if (Bool == FALSE) {
+ ParamIn <- rbind(ParamIn)
+ }
+ ParamOut <- NA * ParamIn
+ NParam <- ncol(ParamIn)
+ ParamOut[, 1:(NParam-4)] <- FUN1(ParamIn[, 1:(NParam-4)], Direction)
+ ParamOut[, (NParam-3):NParam ] <- FUN2(ParamIn[, (NParam-3):NParam ], Direction)
+ if (Bool == FALSE) {
+ ParamOut <- ParamOut[1, ]
+ }
+ return(ParamOut)
}
- ParamOut <- NA * ParamIn
- NParam <- ncol(ParamIn)
- ParamOut[, 1:(NParam-2)] <- FUN1(ParamIn[, 1:(NParam-2)], Direction)
- ParamOut[, (NParam-1):NParam ] <- FUN2(ParamIn[, (NParam-1):NParam ], Direction)
- if (Bool == FALSE) {
- ParamOut <- ParamOut[1, ]
+ } else {
+ FUN_TRANSFO <- function(ParamIn, Direction) {
+ Bool <- is.matrix(ParamIn)
+ if (Bool == FALSE) {
+ ParamIn <- rbind(ParamIn)
+ }
+ ParamOut <- NA * ParamIn
+ NParam <- ncol(ParamIn)
+ ParamOut[, 1:(NParam-2)] <- FUN1(ParamIn[, 1:(NParam-2)], Direction)
+ ParamOut[, (NParam-1):NParam ] <- FUN2(ParamIn[, (NParam-1):NParam ], Direction)
+ if (Bool == FALSE) {
+ ParamOut <- ParamOut[1, ]
+ }
+ return(ParamOut)
}
- return(ParamOut)
}
+
}
if (is.null(FUN_TRANSFO)) {
stop("FUN_TRANSFO was not found (in Calibration function)")
@@ -203,12 +221,8 @@ Calibration_Michel <- function(InputsModel,
}
##Model_run
Param <- CandidatesParamR[iNew, ]
- if (inherits(FUN_MOD, "hysteresis")) {
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param, IsHyst = TRUE)
- } else {
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
- }
-
+ OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
+
##Calibration_criterion_computation
OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
if (!is.na(OutputsCrit$CritValue)) {
@@ -356,11 +370,7 @@ Calibration_Michel <- function(InputsModel,
for (iNew in 1:nrow(CandidatesParamR)) {
##Model_run
Param <- CandidatesParamR[iNew, ]
- if (inherits(FUN_MOD, "hysteresis")) {
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param, IsHyst = TRUE)
- } else {
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
- }
+ OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
##Calibration_criterion_computation
OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
if (!is.na(OutputsCrit$CritValue)) {
@@ -421,11 +431,7 @@ Calibration_Michel <- function(InputsModel,
CandidatesParamR <- FUN_TRANSFO(CandidatesParamT, "TR")
##Model_run
Param <- CandidatesParamR[iNew, ]
- if (inherits(FUN_MOD, "hysteresis")) {
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param, IsHyst = TRUE)
- } else {
- OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
- }
+ OutputsModel <- FUN_MOD(InputsModel, RunOptions, Param)
##Calibration_criterion_computation
OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
if (OutputsCrit$CritValue * OutputsCrit$Multiplier < CritOptim) {
--
GitLab