v1.6.3.2 feat(RunModel_LAG): Add argument checks and documentation

Refs #34

DESCRIPTION

 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")),

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)

NEWS.md

 ## 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
 
 ____________________________________________________________________________________
 

R/RunModel_LAG.R

 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)

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}.
 }
 
 

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{

man/RunModel_LAG.Rd

+\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}}.
+}
+

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