diff --git a/DESCRIPTION b/DESCRIPTION index 5988d2795f72ef389de32dccdbe4b60114e86f2a..3c2f142af4f66754938d3025a34746dc15a48aa3 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 20bfb41e7f63f52e1d322e54e4808e9ff1bc0480..23999779f1034f38e0bef48a9f5cdf19df572181 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 6051506a144fc67c96e10e9a168fe7c8dcef587a..c04c333ae73a2fb01944ed4bc8d95b4d1f9f8079 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) {