From 8534b839f084677da7e5dc16c3a7a18c02b6b560 Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@irstea.fr>
Date: Mon, 5 Oct 2020 17:37:18 +0200
Subject: [PATCH] v1.6.3.2 feat(RunModel_LAG): Add argument checks and
documentation
Refs #34
---
DESCRIPTION | 2 +-
NAMESPACE | 1 +
NEWS.md | 4 +-
R/RunModel_LAG.R | 21 ++++++-
man/CreateCalibOptions.Rd | 2 +-
man/RunModel.Rd | 2 +-
man/RunModel_LAG.Rd | 98 ++++++++++++++++++++++++++++++
tests/testthat/test-RunModel_LAG.R | 34 +++++++++++
8 files changed, 159 insertions(+), 5 deletions(-)
create mode 100644 man/RunModel_LAG.Rd
diff --git a/DESCRIPTION b/DESCRIPTION
index 5f014f72..b41a2496 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.6.3.1
+Version: 1.6.3.2
Date: 2020-10-05
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
diff --git a/NAMESPACE b/NAMESPACE
index 858dd293..2842ced5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -45,6 +45,7 @@ export(RunModel_GR5H)
export(RunModel_GR4J)
export(RunModel_GR5J)
export(RunModel_GR6J)
+export(RunModel_LAG)
export(SeriesAggreg)
export(TransfoParam)
export(TransfoParam_CemaNeige)
diff --git a/NEWS.md b/NEWS.md
index 842f8784..460eee0e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,10 +1,12 @@
## Release History of the airGR Package
-### 1.6.3.1 Release Notes (2020-10-05)
+### 1.6.3.2 Release Notes (2020-10-05)
#### New features
- Change order of parameters: LAG is now the first parameter instead of the last
+- Add argument checks in RunModel_LAG
+- Add Documentation page with example for RunModel_LAG
____________________________________________________________________________________
diff --git a/R/RunModel_LAG.R b/R/RunModel_LAG.R
index 3f06a19d..20d858fd 100644
--- a/R/RunModel_LAG.R
+++ b/R/RunModel_LAG.R
@@ -1,5 +1,24 @@
RunModel_LAG <- function(InputsModel,RunOptions,Param) {
+ NParam <- 1
+
+ ##Arguments_check
+ if(inherits(InputsModel,"InputsModel")==FALSE){ stop("'InputsModel' must be of class 'InputsModel'") }
+ if(inherits(InputsModel,"SD" )==FALSE){ stop("'InputsModel' must be of class 'SD'") }
+ if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("'RunOptions' must be of class 'RunOptions'") }
+ if(!is.vector(Param) | !is.numeric(Param)){ stop("'Param' must be a numeric vector") }
+ if(sum(!is.na(Param))!=NParam){ stop(paste("'Param' must be a vector of length",NParam,"and contain no NA")) }
+
+ if(is.null(InputsModel$OutputsModel)) {
+ stop("'InputsModel' should contain an 'OutputsModel' key containing the output of the runoff of the downstream subcatchment")
+ }
+ if(is.null(InputsModel$OutputsModel$Qsim)) {
+ stop("'InputsModel$OutputsModel' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment")
+ }
+ if(sum(!is.na(InputsModel$OutputsModel$Qsim)) != length(RunOptions$IndPeriod_Run)) {
+ stop("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run' and contain no NA")
+ }
+
OutputsModel <- InputsModel$OutputsModel
OutputsModel$QsimDown <- OutputsModel$Qsim
@@ -11,7 +30,7 @@ RunModel_LAG <- function(InputsModel,RunOptions,Param) {
}
# propagation time from upstream meshes to outlet
- PT <- InputsModel$LengthHydro / Param[length(Param)] / TimeStep
+ PT <- InputsModel$LengthHydro / Param[1] / TimeStep
HUTRANS <- rbind(1 - (PT - floor(PT)), PT - floor(PT))
NbUpBasins <- length(InputsModel$LengthHydro)
diff --git a/man/CreateCalibOptions.Rd b/man/CreateCalibOptions.Rd
index d250d6e6..0d9bbf3f 100644
--- a/man/CreateCalibOptions.Rd
+++ b/man/CreateCalibOptions.Rd
@@ -85,7 +85,7 @@ the package must create their own \code{CalibOptions} object accordingly. \cr
If \code{IsHyst = FALSE}, the original CemaNeige version from Valéry et al. (2014) is used. \cr
If \code{IsHyst = TRUE}, the CemaNeige version from Riboust et al. (2019) is used. Compared to the original version, this version of CemaNeige needs two more parameters and it includes a representation of the hysteretic relationship between the Snow Cover Area (SCA) and the Snow Water Equivalent (SWE) in the catchment. The hysteresis included in airGR is the Modified Linear hysteresis (LH*); it is represented on panel b) of Fig. 3 in Riboust et al. (2019). Riboust et al. (2019) advise to use the LH* version of CemaNeige with parameters calibrated using an objective function combining 75 \% of KGE calculated on discharge simulated from a rainfall-runoff model compared to observed discharge and 5 \% of KGE calculated on SCA on 5 CemaNeige elevation bands compared to satellite (e.g. MODIS) SCA (see Eq. (18), Table 3 and Fig. 6). Riboust et al. (2019)'s tests were realized with GR4J as the chosen rainfall-runoff model. \cr
-If \code{InputsModel} parameter has been created for using a semi-distributed (SD) lag model (See \code{\link{CreateInputsModel}}), the parameter \code{isSD} should be set to \code{TRUE}.
+If \code{InputsModel} parameter has been created for using a semi-distributed (SD) model (See \code{\link{CreateInputsModel}}), the parameter \code{isSD} should be set to \code{TRUE}.
}
diff --git a/man/RunModel.Rd b/man/RunModel.Rd
index fab3924e..ceae5f1d 100644
--- a/man/RunModel.Rd
+++ b/man/RunModel.Rd
@@ -37,7 +37,7 @@ If \code{InputsModel} parameter has been created for using a semi-distributed (S
}
\details{
-If \code{InputsModel} parameter has been created for using a semi-distributed (SD) lag model (See \code{\link{CreateInputsModel}}), \code{Param} parameter should contain one extra last parameter corresponding to a constant lag parameter expressed as a velocity in m/s.
+If \code{InputsModel} parameter has been created for using a semi-distributed (SD) lag model (See \code{\link{CreateInputsModel}}), the first item of \code{Param} parameter should contain a constant lag parameter expressed as a velocity in m/s, parameters for the hydrological model are then shift one position to the right.
}
\examples{
diff --git a/man/RunModel_LAG.Rd b/man/RunModel_LAG.Rd
new file mode 100644
index 00000000..fb3a5008
--- /dev/null
+++ b/man/RunModel_LAG.Rd
@@ -0,0 +1,98 @@
+\encoding{UTF-8}
+
+
+\name{RunModel_LAG}
+\alias{RunModel_LAG}
+
+
+\title{Run with the LAG model}
+
+
+\description{
+Function which performs a single run for the LAG model over the test period.
+}
+
+
+\usage{
+RunModel_LAG(InputsModel, RunOptions, Param)
+}
+
+
+\arguments{
+\item{InputsModel}{[object of class \emph{InputsModel}] created with SD model inputs, see \code{\link{CreateInputsModel}} for details. The object should also contain a key \emph{OutputsModel}] of class \code{\link{CreateInputsModel}} coming from the simulation of the downstream subcatchement runoff.}
+
+\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
+
+\item{Param}{[numeric] vector of 1 parameter
+ \tabular{ll}{
+ LAG \tab Mean flow velocity [m/s]
+ }}
+}
+
+
+\value{
+[list] see \code{\link{RunModel_GR4J}} or \code{\link{RunModel_CemaNeigeGR4J}} for details.
+
+The list value contains an extra item named \code{QsimDown} which is a copy of InputsModel\$OutputsModel\$Qsim, a numeric series of simulated discharge [mm/time step] related to the run-off contribution of the downstream sub-catchment.
+}
+
+
+\examples{
+library(airGR)
+
+## loading catchment data
+data(L0123001)
+
+## Simulating a reservoir
+# Withdrawing 1 m3/s with an instream flow of 1 m3/s
+Qupstream <- matrix(- unlist(lapply(BasinObs$Qls / 1000 - 1, function(x) {min(1, max(0,x, na.rm = TRUE))})), ncol = 1)
+# Except between July and November when releasing 3 m3/s
+month <- as.numeric(format(BasinObs$DatesR,"\%m"))
+Qupstream[month >= 7 & month <= 9] <- 3
+# Conversion in m3/day
+Qupstream <- Qupstream * 86400
+
+## The reservoir is not an upstream subcachment: its areas is NA
+BasinAreas <- c(NA, BasinInfo$BasinArea)
+
+## Delay time between the reservoir and the catchment outlet is 2 days and the distance is 150 km
+LenghtHydro <- 150
+LAG <- LenghtHydro / 2 / 86400 * 1000 # Conversion km/day -> m/s
+
+## preparation of the InputsModel object
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+ Precip = BasinObs$P, PotEvap = BasinObs$E,
+ Qupstream = Qupstream, LengthHydro = LenghtHydro,
+ BasinAreas = BasinAreas)
+
+## run period selection
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"),
+ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31"))
+
+## preparation of the RunOptions object
+RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+ InputsModel = InputsModel, IndPeriod_Run = Ind_Run)
+
+## simulation of dowstream subcatchment
+Param <- c(X1 = 257.238, X2 = 1.012, X3 = 88.235, X4 = 2.208)
+OutputsModelDown <- RunModel_GR4J(InputsModel = InputsModel,
+ RunOptions = RunOptions, Param = Param)
+
+InputsModel$OutputsModel <- OutputsModelDown
+OutputsModel <- RunModel_LAG(InputsModel = InputsModel,
+ RunOptions = RunOptions, Param = LAG)
+
+## results preview of comparison between naturalised (observed) and influenced flow (simulated)
+plot(OutputsModel, Qobs = OutputsModel$QsimDown)
+}
+
+
+\author{
+Olivier Delaigue, David Dorchies
+}
+
+
+\seealso{
+\code{\link{RunModel}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}.
+}
+
diff --git a/tests/testthat/test-RunModel_LAG.R b/tests/testthat/test-RunModel_LAG.R
index f46338dc..4dafb2f8 100644
--- a/tests/testthat/test-RunModel_LAG.R
+++ b/tests/testthat/test-RunModel_LAG.R
@@ -54,6 +54,13 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)
+test_that("InputsModel parameter should contain an OutputsModel key", {
+ expect_error(
+ RunModel_LAG(InputsModel, RunOptions, 1),
+ regexp = "'InputsModel' should contain an 'OutputsModel' key"
+ )
+})
+
Param = c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started
OutputsGR4JOnly <-
@@ -61,6 +68,33 @@ OutputsGR4JOnly <-
RunOptions = RunOptions,
Param = Param)
+test_that("InputsModel$OutputsModel should contain a Qsim key", {
+ InputsModel$OutputsModel <- OutputsGR4JOnly
+ InputsModel$OutputsModel$Qsim <- NULL
+ expect_error(
+ RunModel_LAG(InputsModel, RunOptions, 1),
+ regexp = "should contain a key 'Qsim'"
+ )
+})
+
+test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", {
+ InputsModel$OutputsModel <- OutputsGR4JOnly
+ InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0)
+ expect_error(
+ RunModel_LAG(InputsModel, RunOptions, 1),
+ regexp = "should have the same lenght as"
+ )
+})
+
+test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", {
+ InputsModel$OutputsModel <- OutputsGR4JOnly
+ InputsModel$OutputsModel$Qsim[10] <- NA
+ expect_error(
+ RunModel_LAG(InputsModel, RunOptions, 1),
+ regexp = "contain no NA"
+ )
+})
+
test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
UpstBasinArea = InputsModel$BasinAreas[1]
InputsModel$BasinAreas[1] <- 0
--
GitLab