From f6c9a2ed876075fa098cac962aff0738ca5ea946 Mon Sep 17 00:00:00 2001
From: David <david.dorchies@inrae.fr>
Date: Mon, 19 Jun 2023 17:58:09 +0200
Subject: [PATCH] fix: crash with hysteresis
- Add IsHyst parameter to CreateInputsModel
- Correct number of parameters in GetFeatModel
- Handle automatically IsHyst parameter in CreateRunOptions and CreateCalibOptions
Refs # 134
---
R/CreateCalibOptions.R | 24 ++++++++++++++----------
R/CreateInputsModel.GRiwrm.R | 19 +++++++++++++++----
R/CreateRunOptions.R | 2 ++
man/CreateInputsModel.GRiwrm.Rd | 4 ++++
4 files changed, 35 insertions(+), 14 deletions(-)
diff --git a/R/CreateCalibOptions.R b/R/CreateCalibOptions.R
index fc71940..d944d9d 100644
--- a/R/CreateCalibOptions.R
+++ b/R/CreateCalibOptions.R
@@ -23,17 +23,21 @@ CreateCalibOptions <- function(x, ...) {
#' @export
CreateCalibOptions.InputsModel <- function(x,
...) {
- if (!exists("FUN_MOD") && !is.null(x$FUN_MOD)) {
- airGR::CreateCalibOptions(
- FUN_MOD = x$FUN_MOD,
- IsSD = !is.null(x$Qupstream) & x$FUN_MOD != "RunModel_Lag",
- ...
- )
- } else {
- airGR::CreateCalibOptions(
- ...
- )
+ dots <- list(...)
+ # Add FUN_MOD in parameters if carried by InputsModel
+ if (!"FUN_MOD" %in% names(dots)) {
+ if(!is.null(x$FUN_MOD)) {
+ dots$FUN_MOD <- x$FUN_MOD
+ } else {
+ stop(" The parameter `FUN_MOD` must be defined")
+ }
}
+ # Automatically define IsSD for intermediate basin GR models
+ dots$IsSD = !is.null(x$Qupstream) & dots$FUN_MOD != "RunModel_Lag"
+ # Add IsHyst in parameters if carried by InputsModel
+ if (!is.null(x$model$IsHyst)) dots$IsHyst <- x$model$IsHyst
+ # Call airGR function
+ do.call(airGR::CreateCalibOptions, dots)
}
#' @rdname CreateCalibOptions
diff --git a/R/CreateInputsModel.GRiwrm.R b/R/CreateInputsModel.GRiwrm.R
index 50edf1f..e36d26b 100644
--- a/R/CreateInputsModel.GRiwrm.R
+++ b/R/CreateInputsModel.GRiwrm.R
@@ -35,6 +35,8 @@
#' @param NLayers (optional) named [vector] of [numeric] integer giving the number
#' of elevation layers requested [-], required to create CemaNeige module
#' inputs, default=5
+#' @param IsHyst [boolean] boolean indicating if the hysteresis version of
+#' CemaNeige is used. See details of [airGR::CreateRunOptions].
#' @param ... used for compatibility with S3 methods
#'
#' @details Meteorological data are needed for the nodes of the network that
@@ -70,7 +72,8 @@ CreateInputsModel.GRiwrm <- function(x, DatesR,
PrecipScale = TRUE,
TempMean = NULL, TempMin = NULL,
TempMax = NULL, ZInputs = NULL,
- HypsoData = NULL, NLayers = 5, ...) {
+ HypsoData = NULL, NLayers = 5,
+ IsHyst = FALSE, ...) {
# Check and format inputs
varNames <- c("Precip", "PotEvap", "TempMean", "Qobs", "Qmin",
@@ -326,7 +329,7 @@ CreateOneGRiwrmInputsModel <- function(id, griwrm, ..., Qobs, Qmin) {
# Add the model function
InputsModel$FUN_MOD <- FUN_MOD
- featModel <- .GetFeatModel(InputsModel)
+ featModel <- .GetFeatModel(InputsModel, IsHyst)
InputsModel$isUngauged <- griwrm$model[griwrm$id == id] == "Ungauged"
InputsModel$gaugedId <- griwrm$donor[griwrm$id == id]
InputsModel$hasUngaugedNodes <- hasUngaugedNodes(id, griwrm)
@@ -335,7 +338,8 @@ CreateOneGRiwrmInputsModel <- function(id, griwrm, ..., Qobs, Qmin) {
indexParamUngauged = ifelse(inherits(InputsModel, "SD"), 0, 1) +
seq.int(featModel$NbParam),
hasX4 = grepl("RunModel_GR[456][HJ]", FUN_MOD),
- iX4 = ifelse(inherits(InputsModel, "SD"), 5, 4)
+ iX4 = ifelse(inherits(InputsModel, "SD"), 5, 4),
+ IsHyst = featModel$IsHyst
)
InputsModel$hasDiversion <- np$Diversion
InputsModel$isReservoir <- np$Reservoir
@@ -446,7 +450,7 @@ hasUngaugedNodes <- function(id, griwrm) {
#' function to extract model features partially copied from airGR:::.GetFeatModel
#' @importFrom utils tail
#' @noRd
-.GetFeatModel <- function(InputsModel) {
+.GetFeatModel <- function(InputsModel, IsHyst) {
path <- system.file("modelsFeatures/FeatModelsGR.csv", package = "airGR")
FeatMod <- read.table(path, header = TRUE, sep = ";", stringsAsFactors = FALSE)
NameFunMod <- ifelse(test = FeatMod$Pkg %in% "airGR",
@@ -461,6 +465,13 @@ hasUngaugedNodes <- function(id, griwrm) {
if (FeatMod$IsSD) {
FeatMod$NbParam <- FeatMod$NbParam + 1
}
+ FeatMod$IsHyst <- FALSE
+ if (grepl("CemaNeige", FeatMod$NameMod)) {
+ FeatMod$IsHyst <- IsHyst
+ if (IsHyst) {
+ FeatMod$NbParam <- FeatMod$NbParam + 2
+ }
+ }
return(FeatMod)
}
diff --git a/R/CreateRunOptions.R b/R/CreateRunOptions.R
index e676239..c74cc68 100644
--- a/R/CreateRunOptions.R
+++ b/R/CreateRunOptions.R
@@ -43,6 +43,8 @@ CreateRunOptions.InputsModel <- function(x, ...) {
stop(" The parameter `FUN_MOD` must be defined")
}
}
+ # Add IsHyst in parameters if carried by InputsModel
+ if (!is.null(x$model$IsHyst)) dots$IsHyst <- x$model$IsHyst
# Temporary fix waiting for resolution of HYCAR-Hydro/airgr#167
if (identical(match.fun(dots$FUN_MOD), RunModel_Lag)) {
diff --git a/man/CreateInputsModel.GRiwrm.Rd b/man/CreateInputsModel.GRiwrm.Rd
index f77b5ce..f0aa1bc 100644
--- a/man/CreateInputsModel.GRiwrm.Rd
+++ b/man/CreateInputsModel.GRiwrm.Rd
@@ -18,6 +18,7 @@
ZInputs = NULL,
HypsoData = NULL,
NLayers = 5,
+ IsHyst = FALSE,
...
)
}
@@ -70,6 +71,9 @@ if not defined a single elevation is used for CemaNeige}
of elevation layers requested \link{-}, required to create CemaNeige module
inputs, default=5}
+\item{IsHyst}{\link{boolean} boolean indicating if the hysteresis version of
+CemaNeige is used. See details of \link[airGR:CreateRunOptions]{airGR::CreateRunOptions}.}
+
\item{...}{used for compatibility with S3 methods}
}
\value{
--
GitLab