V1.6.1.15: refactor: rename QobsUpstr variable to Qupstream

Refs #34

DESCRIPTION

 Package: airGR
 Type: Package
 Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.6.1.14
-Date: 2020-05-27
+Version: 1.6.1.15
+Date: 2020-06-04
 Authors@R: c(
   person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
   person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
   person("Guillaume", "Thirel", role = c("aut"), comment = c(ORCID = "0000-0002-1444-1830")),
   person("Charles", "Perrin", role = c("aut", "ths"), comment = c(ORCID = "0000-0001-8552-1881")),
   person("Claude", "Michel", role = c("aut", "ths")),
-  person("Vazken", "Andréassian", role = c("ctb", "ths"), comment = c(ORCID = "0000-0001-7124-9303")),
-  person("François", "Bourgin", role = c("ctb"), comment = c(ORCID = "0000-0002-2820-7260", vignette = "'Parameter estimation' vignettes")),
+  person("Vazken", "Andréassian", role = c("ctb", "ths"), comment = c(ORCID = "0000-0001-7124-9303")),
+  person("François", "Bourgin", role = c("ctb"), comment = c(ORCID = "0000-0002-2820-7260", vignette = "'Parameter estimation' vignettes")),
   person("Pierre", "Brigode", role = c("ctb"), comment = c(ORCID = "0000-0001-8257-0741")),
   person("Nicolas", "Le Moine", role = c("ctb")),
   person("Thibaut", "Mathevet", role = c("ctb"), comment = c(ORCID = "0000-0002-4142-4454")),
   person("Safouane", "Mouelhi", role = c("ctb")),
   person("Ludovic", "Oudin", role = c("ctb"), comment = c(ORCID = "0000-0002-3712-0933")),
   person("Raji", "Pushpalatha", role = c("ctb")),
-  person("Audrey", "Valéry", role = c("ctb"))
+  person("Audrey", "Valéry", role = c("ctb"))
   )
 Depends: R (>= 3.0.1)
 Suggests: knitr, rmarkdown, coda, DEoptim, dplyr, FME, ggmcmc, hydroPSO, Rmalschains, testthat

R/CreateInputsModel.R

@@ -4,7 +4,7 @@ CreateInputsModel <- function(FUN_MOD,
                               PotEvap = NULL,
                               TempMean = NULL, TempMin = NULL, TempMax = NULL,
                               ZInputs = NULL, HypsoData = NULL, NLayers = 5,
-                              QobsUpstr = NULL, LengthHydro = NULL, BasinAreas = NULL,
+                              Qupstream = NULL, LengthHydro = NULL, BasinAreas = NULL,
                               verbose = TRUE) {
 
 
@@ -185,35 +185,35 @@ CreateInputsModel <- function(FUN_MOD,
     }
 
     ## check semi-distributed mode
-    if (!is.null(QobsUpstr) & !is.null(LengthHydro) & !is.null(BasinAreas)) {
+    if (!is.null(Qupstream) & !is.null(LengthHydro) & !is.null(BasinAreas)) {
       ObjectClass <- c(ObjectClass, "SD")
-    } else if (verbose & !all(c(is.null(QobsUpstr), is.null(LengthHydro), is.null(BasinAreas)))) {
-      warning("Missing argument: 'QobsUpstr', 'LengthHydro' and 'BasinAreas' must all be set to run in a semi-distributed mode. The lumped mode will be used")
+    } else if (verbose & !all(c(is.null(Qupstream), is.null(LengthHydro), is.null(BasinAreas)))) {
+      warning("Missing argument: 'Qupstream', 'LengthHydro' and 'BasinAreas' must all be set to run in a semi-distributed mode. The lumped mode will be used")
     }
     if ("SD" %in% ObjectClass) {
       if (!("daily" %in% ObjectClass) & !("hourly" %in% ObjectClass)) {
         stop("Only daily and hourly time steps can be used in a semi-distributed mode")
       }
-      if (!is.matrix(QobsUpstr) | !is.matrix(LengthHydro) | !is.matrix(BasinAreas)) {
-        stop("'QobsUpstr', 'LengthHydro' and 'BasinAreas' must be matrices of numeric values")
+      if (!is.matrix(Qupstream) | !is.matrix(LengthHydro) | !is.matrix(BasinAreas)) {
+        stop("'Qupstream', 'LengthHydro' and 'BasinAreas' must be matrices of numeric values")
       }
-      if (!is.numeric(QobsUpstr) | !is.numeric(LengthHydro) | !is.numeric(BasinAreas)) {
-        stop("'QobsUpstr', 'LengthHydro' and 'BasinAreas' must be matrices of numeric values")
+      if (!is.numeric(Qupstream) | !is.numeric(LengthHydro) | !is.numeric(BasinAreas)) {
+        stop("'Qupstream', 'LengthHydro' and 'BasinAreas' must be matrices of numeric values")
       }
-      if (ncol(QobsUpstr) != ncol(LengthHydro)) {
-        stop("'QobsUpstr' and 'LengthHydro' must have the same number of columns")
+      if (ncol(Qupstream) != ncol(LengthHydro)) {
+        stop("'Qupstream' and 'LengthHydro' must have the same number of columns")
       }
-      if (ncol(QobsUpstr)+1 != ncol(BasinAreas)) {
-        stop("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'")
+      if (ncol(Qupstream)+1 != ncol(BasinAreas)) {
+        stop("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'")
       }
-      if (nrow(QobsUpstr) != LLL) {
-        stop("'QobsUpstr' must have same number of rows as 'DatesR' length")
+      if (nrow(Qupstream) != LLL) {
+        stop("'Qupstream' must have same number of rows as 'DatesR' length")
       }
       if (nrow(LengthHydro) != 1 | nrow(BasinAreas) != 1) {
         stop("'LengthHydro' and 'BasinAreas' must have only one row")
       }
-      if(any(is.na(QobsUpstr))) {
-        stop("'QobsUpstr' cannot contain any NA value")
+      if(any(is.na(Qupstream))) {
+        stop("'Qupstream' cannot contain any NA value")
       }
     }
 
@@ -330,7 +330,7 @@ CreateInputsModel <- function(FUN_MOD,
                                          ZLayers              = RESULT$ZLayers))
     }
     if ("SD" %in% ObjectClass) {
-      InputsModel <- c(InputsModel, list(QobsUpstr = QobsUpstr,
+      InputsModel <- c(InputsModel, list(Qupstream = Qupstream,
                                          LengthHydro   = LengthHydro,
                                          BasinAreas = BasinAreas))
     }

R/RunModel.R

 RunModel <- function (InputsModel, RunOptions, Param, FUN_MOD) {
-  
+
   FUN_MOD <- match.fun(FUN_MOD)
-  
+
   if (inherits(InputsModel, "SD")) {
-    OutputsModelDown <- FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions, 
+    OutputsModelDown <- FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions,
                                 Param = Param[-length(Param)])
     OutputsModelDown$QsimDown <- OutputsModelDown$Qsim
-    
+
     if (inherits(InputsModel, "daily")) {
       TimeStep <- 60 * 60 * 24
     }
     if (inherits(InputsModel, "hourly")) {
       TimeStep <- 60 * 60
     }
-    
-    # total area 
+
+    # total area
     AreaTot <- sum(InputsModel$BasinAreas)
-    
+
     # propagation time from upstream meshes to outlet
     PT <- InputsModel$LengthHydro[1, ] / Param[length(Param)] / TimeStep
     HUTRANS <- rbind(1 - (PT - floor(PT)), PT - floor(PT))
-    
+
     NbUpBasins <- length(InputsModel$LengthHydro)
     LengthTs <- length(OutputsModelDown$QsimDown)
     OutputsModelDown$Qsim <- OutputsModelDown$QsimDown * InputsModel$BasinAreas[length(InputsModel$BasinAreas)] / AreaTot
-    
+
     for (upstream_basin in seq_len(NbUpBasins)) {
-      QobsUpstr <- InputsModel$QobsUpstr[RunOptions$IndPeriod_Run, upstream_basin]
-      OutputsModelDown$Qsim <- OutputsModelDown$Qsim + 
-        c(rep(0, floor(PT[upstream_basin])), 
-          QobsUpstr[(1 + floor(PT[upstream_basin])):LengthTs]) *
-        HUTRANS[1, upstream_basin] * InputsModel$BasinAreas[upstream_basin] / AreaTot + 
-        c(rep(0, floor(PT[upstream_basin] + 1)), 
-          QobsUpstr[(2 + floor(PT[upstream_basin])):LengthTs]) *
+      Qupstream <- InputsModel$Qupstream[RunOptions$IndPeriod_Run, upstream_basin]
+      OutputsModelDown$Qsim <- OutputsModelDown$Qsim +
+        c(rep(0, floor(PT[upstream_basin])),
+          Qupstream[(1 + floor(PT[upstream_basin])):LengthTs]) *
+        HUTRANS[1, upstream_basin] * InputsModel$BasinAreas[upstream_basin] / AreaTot +
+        c(rep(0, floor(PT[upstream_basin] + 1)),
+          Qupstream[(2 + floor(PT[upstream_basin])):LengthTs]) *
         HUTRANS[2, upstream_basin] * InputsModel$BasinAreas[upstream_basin] / AreaTot
     }
-    
+
   } else {
-    
+
     OutputsModelDown <- FUN_MOD(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param)
-    
+
   }
   return(OutputsModelDown)
 }
\ No newline at end of file

tests/testthat/test-RunModel_LAG.R

@@ -3,45 +3,45 @@ context("RunModel_LAG")
 data(L0123001)
 
 
-test_that("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'", {
+test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'", {
   expect_error(
     InputsModel <- CreateInputsModel(
       FUN_MOD = RunModel_GR4J,
       DatesR = BasinObs$DatesR,
       Precip = BasinObs$P,
       PotEvap = BasinObs$E,
-      QobsUpstr = matrix(BasinObs$Qmm, ncol = 1),
+      Qupstream = matrix(BasinObs$Qmm, ncol = 1),
       LengthHydro = matrix(c(1), nrow = 1),
       BasinAreas = matrix(c(1), nrow = 1)
     ),
-    regexp = "'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'"
+    regexp = "'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'"
   )
 })
 
-test_that("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'", {
+test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'", {
   expect_error(
     InputsModel <- CreateInputsModel(
       FUN_MOD = RunModel_GR4J,
       DatesR = BasinObs$DatesR,
       Precip = BasinObs$P,
       PotEvap = BasinObs$E,
-      QobsUpstr = matrix(BasinObs$Qmm, ncol = 1),
+      Qupstream = matrix(BasinObs$Qmm, ncol = 1),
       LengthHydro = matrix(c(1), nrow = 1),
       BasinAreas = matrix(c(1, 2), nrow = 1)
     ),
-    regexp = "'QobsUpstr' cannot contain any NA value"
+    regexp = "'Qupstream' cannot contain any NA value"
   )
 })
 
-QobsUpstr = BasinObs$Qmm
-QobsUpstr[is.na(QobsUpstr)] = mean(QobsUpstr, na.rm = TRUE)
+Qupstream = BasinObs$Qmm
+Qupstream[is.na(Qupstream)] = mean(Qupstream, na.rm = TRUE)
 
 InputsModel <- CreateInputsModel(
   FUN_MOD = RunModel_GR4J,
   DatesR = BasinObs$DatesR,
   Precip = BasinObs$P,
   PotEvap = BasinObs$E,
-  QobsUpstr = matrix(QobsUpstr, ncol = 1),
+  Qupstream = matrix(Qupstream, ncol = 1),
   LengthHydro = matrix(c(1000), nrow = 1),
   BasinAreas = matrix(c(
     BasinInfo$BasinArea * 2, BasinInfo$BasinArea
@@ -83,7 +83,7 @@ test_that(
       DatesR = BasinObs$DatesR,
       Precip = BasinObs$P,
       PotEvap = BasinObs$E,
-      QobsUpstr = matrix(QobsUpstr, ncol = 1),
+      Qupstream = matrix(Qupstream, ncol = 1),
       LengthHydro = matrix(c(0), nrow = 1),
       BasinAreas = matrix(c(BasinInfo$BasinArea, 0), nrow = 1)
     )
@@ -92,7 +92,7 @@ test_that(
                RunOptions,
                Param = c(Param, 1),
                FUN_MOD = RunModel_GR4J)
-    expect_equal(OutputsSD$Qsim, QobsUpstr[Ind_Run])
+    expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run])
   }
 )
 
@@ -106,7 +106,7 @@ test_that("1 input with lag of 1 time step delay out gives an output delayed of
   QlsSdSim <-
     OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400
   QlsUpstLagObs <-
-    c(0, QobsUpstr[Ind_Run[1:(length(Ind_Run) - 1)] + 1]) * InputsModel$BasinAreas[1] * 1E6 / 86400
+    c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)] + 1]) * InputsModel$BasinAreas[1] * 1E6 / 86400
   expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs)
 })
 
@@ -119,8 +119,8 @@ test_that("Params from calibration with simulated data should be similar to init
     Obs = BasinObs$Qmm[Ind_Run]
   )
   CalibOptions <- CreateCalibOptions(
-    FUN_MOD = RunModel_GR4J, 
-    FUN_CALIB = Calibration_Michel, 
+    FUN_MOD = RunModel_GR4J,
+    FUN_CALIB = Calibration_Michel,
     IsSD = TRUE
   )
   OutputsCalib <- Calibration_Michel(