feat(RunModel_Lag): Add argument `QcontribDown`

Refs #109

R/RunModel.R

 RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) {
-  
+
   FUN_MOD <- match.fun(FUN_MOD)
-  
+
   if (inherits(InputsModel, "SD")) {
     # Lag model take one parameter at the beginning of the vector
     iFirstParamRunOffModel <- 2
@@ -9,13 +9,12 @@ RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) {
     # All parameters
     iFirstParamRunOffModel <- 1
   }
-  
+
   OutputsModel <- FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions,
                           Param = Param[iFirstParamRunOffModel:length(Param)])
-  
+
   if (inherits(InputsModel, "SD")) {
-    InputsModel$OutputsModel <- OutputsModel
-    OutputsModel <- RunModel_Lag(InputsModel, RunOptions, Param[1])
+    OutputsModel <- RunModel_Lag(InputsModel, RunOptions, Param[1], OutputsModel)
   }
   return(OutputsModel)
-}
\ No newline at end of file
+}

R/RunModel_Lag.R

-RunModel_Lag <- function(InputsModel, RunOptions, Param) {
+RunModel_Lag <- function(InputsModel, RunOptions, Param, QcontribDown) {
   NParam <- 1
 
   ##Arguments_check
@@ -17,19 +17,23 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param) {
   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 (inherits(QcontribDown, "OutputsModel")) {
+    if (is.null(QcontribDown$Qsim)) {
+      stop("'QcontribDown' should contain a key 'Qsim' containing the output of the runoff of the downstream subcatchment")
+    }
+    OutputsModel <- QcontribDown
+    OutputsModel$QsimDown <- OutputsModel$Qsim
+  } else if (is.vector(QcontribDown) && is.numeric(QcontribDown)) {
+    OutputsModel <- list()
+    class(OutputsModel) <- c("OutputsModel", class(OutputsModel))
+    OutputsModel$QsimDown <- QcontribDown
+  } else {
+    stop("'QcontribDown' must be a numeric vector or a 'OutputsModel' object")
   }
-  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")
+  if (length(OutputsModel$QsimDown) != length(RunOptions$IndPeriod_Run)) {
+    stop("Time series in 'QcontribDown' should have the same lenght as 'RunOptions$IndPeriod_Run'")
   }
 
-  OutputsModel <- InputsModel$OutputsModel
-  OutputsModel$QsimDown <- OutputsModel$Qsim
-
   if (inherits(InputsModel, "hourly")) {
     TimeStep <- 60 * 60
   } else if (inherits(InputsModel, "daily")) {

man/RunModel_Lag.Rd

@@ -14,26 +14,29 @@ Function which performs a single run for the Lag model over the test period.
 
 
 \usage{
-RunModel_Lag(InputsModel, RunOptions, Param)
+RunModel_Lag(InputsModel, RunOptions, Param, QcontribDown)
 }
 
 
 \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 subcatchment runoff.}
+  \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 subcatchment runoff.}
 
-\item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
+  \item{RunOptions}{[object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details}
+
+  \item{Param}{[numeric] vector of 1 parameter
+    \tabular{ll}{
+      Velocity \tab Mean flow velocity [m/s]
+    }
+  }
+  \item{QcontribDown}{[numeric] vector or [OutputsModel] containing the time series of the runoff contribution of the downstream sub-basin}
 
-\item{Param}{[numeric] vector of 1 parameter
-  \tabular{ll}{
-    Velocity \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 \code{InputsModel$OutputsModel$Qsim}, a numeric series of simulated discharge [mm/time step] related to the runoff contribution of the downstream sub-catchment.
+The list value contains an extra item named \code{QsimDown} which is a copy of the runoff contribution of the downstream sub-basin contained in argument \code{QcontribDown} in [mm/time step].
 }
 
 
@@ -88,12 +91,11 @@ OutputsModelDown <- RunModel_GR4J(InputsModel = InputsModel,
 ## with a delay of 2 days for 150 km, the flow velocity is 75 km per day
 Velocity <- (LengthHydro * 1e3 / 2) / (24 * 60 * 60) ## Conversion km/day -> m/s
 
-## add the output of the precipitation-runoff model in the InputsModel object
-InputsModel$OutputsModel <- OutputsModelDown
-
 ## run the lag model which routes precipitation-runoff model and upstream flows
 OutputsModel <- RunModel_Lag(InputsModel = InputsModel,
-                             RunOptions = RunOptions, Param = Velocity)
+                             RunOptions = RunOptions,
+                             Param = Velocity,
+                             QcontribDown = OutputsModelDown)
 
 ## results preview of comparison between naturalised (observed) and influenced flow (simulated)
 plot(OutputsModel, Qobs = OutputsModel$QsimDown)

tests/testthat/test-RunModel_Lag.R

@@ -39,10 +39,19 @@ RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
                                                 InputsModel = InputsModel,
                                                 IndPeriod_Run = Ind_Run))
 
-test_that("InputsModel parameter should contain an OutputsModel key", {
+test_that("QcontribDown parameter should be a numeric vector or an OutputModel object", {
+  regexp = "'QcontribDown' must be a numeric vector or a 'OutputsModel' object"
   expect_error(
-    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
-    regexp = "'InputsModel' should contain an 'OutputsModel' key"
+    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = "A"),
+    regexp = regexp
+  )
+  expect_error(
+    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = NULL),
+    regexp = regexp
+  )
+  expect_error(
+    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = matrix(1, ncol = 1)),
+    regexp = regexp
   )
 })
 
@@ -52,33 +61,24 @@ OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel,
                                  RunOptions = RunOptions,
                                  Param = Param)
 
-test_that("InputsModel$OutputsModel should contain a Qsim key", {
-  InputsModel$OutputsModel <- OutputsGR4JOnly
-  InputsModel$OutputsModel$Qsim <- NULL
+test_that("QcontribDown should contain a Qsim key", {
+  QcontribDown <- OutputsGR4JOnly
+  QcontribDown$Qsim <- NULL
   expect_error(
-    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
     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)
+test_that("'QcontribDown$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", {
+  QcontribDown <- OutputsGR4JOnly
+  QcontribDown$Qsim <- c(QcontribDown$Qsim, 0)
   expect_error(
-    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
     regexp = "should have the same lenght as"
   )
 })
 
-test_that("'InputsModel$OutputsModel$Qsim' should contain no NA'", {
-  InputsModel$OutputsModel <- OutputsGR4JOnly
-  InputsModel$OutputsModel$Qsim[10L] <- NA
-  expect_error(
-    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
-    regexp = "contain no NA"
-  )
-})
-
 test_that("'Qupstream' contain NA values", {
   expect_warning(
     InputsModel <- CreateInputsModel(
@@ -96,16 +96,16 @@ test_that("'Qupstream' contain NA values", {
   RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
                                                   InputsModel = InputsModel,
                                                   IndPeriod_Run = Ind_Run))
-  InputsModel$OutputsModel <- OutputsGR4JOnly
+  QcontribDown <- OutputsGR4JOnly
   # Warning with RunModel
   expect_warning(
-    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
     regexp = "time steps with NA values"
   )
   # No warning during calibration
   RunOptions$Outputs_Sim <- RunOptions$Outputs_Cal
   expect_warning(
-    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
+    RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
     regexp = NA
   )
 })