Commit 143ad885 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.2.11.1 UPDATE: Calibration_Michel now checks the use of hysteresis from CalibOptions #5252

Showing with 37 additions and 31 deletions
+37 -31
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")),
......
......@@ -13,7 +13,7 @@ output:
### 1.2.11.0 Release Notes (2019-03-22)
### 1.2.11.1 Release Notes (2019-03-22)
......
......@@ -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) {
......
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