V1.6.1.16: refactor: use vectors for LengthHydro and BasinAreas instead of matrices

Refs #34

DESCRIPTION

 Package: airGR
 Type: Package
 Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.6.1.15
+Version: 1.6.1.16
 Date: 2020-06-04
 Authors@R: c(
   person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),

R/CreateInputsModel.R

@@ -194,24 +194,21 @@ CreateInputsModel <- function(FUN_MOD,
       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(Qupstream) | !is.matrix(LengthHydro) | !is.matrix(BasinAreas)) {
-        stop("'Qupstream', 'LengthHydro' and 'BasinAreas' must be matrices of numeric values")
+      if (!is.matrix(Qupstream) | !is.numeric(Qupstream)) {
+        stop("'Qupstream' must be a matrice 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 (!is.vector(LengthHydro) | !is.vector(BasinAreas) | !is.numeric(LengthHydro) | !is.numeric(BasinAreas)) {
+        stop("'LengthHydro' and 'BasinAreas' must be vectors of numeric values")
       }
-      if (ncol(Qupstream) != ncol(LengthHydro)) {
-        stop("'Qupstream' and 'LengthHydro' must have the same number of columns")
+      if (ncol(Qupstream) != length(LengthHydro)) {
+        stop("'Qupstream' number of columns and 'LengthHydro' length must be equal")
       }
-      if (ncol(Qupstream)+1 != ncol(BasinAreas)) {
-        stop("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'")
+      if (length(LengthHydro) + 1 != length(BasinAreas)) {
+        stop("'BasinAreas' must have one more element than 'LengthHydro'")
       }
       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(Qupstream))) {
         stop("'Qupstream' cannot contain any NA value")
       }

R/RunModel.R

@@ -18,7 +18,7 @@ RunModel <- function (InputsModel, RunOptions, Param, FUN_MOD) {
     AreaTot <- sum(InputsModel$BasinAreas)
 
     # propagation time from upstream meshes to outlet
-    PT <- InputsModel$LengthHydro[1, ] / Param[length(Param)] / TimeStep
+    PT <- InputsModel$LengthHydro / Param[length(Param)] / TimeStep
     HUTRANS <- rbind(1 - (PT - floor(PT)), PT - floor(PT))
 
     NbUpBasins <- length(InputsModel$LengthHydro)

tests/testthat/test-RunModel_LAG.R

@@ -3,7 +3,7 @@ context("RunModel_LAG")
 data(L0123001)
 
 
-test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'", {
+test_that("'BasinAreas' must have one more element than 'LengthHydro'", {
   expect_error(
     InputsModel <- CreateInputsModel(
       FUN_MOD = RunModel_GR4J,
@@ -11,14 +11,14 @@ test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHy
       Precip = BasinObs$P,
       PotEvap = BasinObs$E,
       Qupstream = matrix(BasinObs$Qmm, ncol = 1),
-      LengthHydro = matrix(c(1), nrow = 1),
-      BasinAreas = matrix(c(1), nrow = 1)
+      LengthHydro = 1,
+      BasinAreas = 1
     ),
-    regexp = "'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'"
+    regexp = "'BasinAreas' must have one more element than 'LengthHydro'"
   )
 })
 
-test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHydro'", {
+test_that("'Qupstream' cannot contain any NA value", {
   expect_error(
     InputsModel <- CreateInputsModel(
       FUN_MOD = RunModel_GR4J,
@@ -26,8 +26,8 @@ test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHy
       Precip = BasinObs$P,
       PotEvap = BasinObs$E,
       Qupstream = matrix(BasinObs$Qmm, ncol = 1),
-      LengthHydro = matrix(c(1), nrow = 1),
-      BasinAreas = matrix(c(1, 2), nrow = 1)
+      LengthHydro = 1,
+      BasinAreas = c(1, 2)
     ),
     regexp = "'Qupstream' cannot contain any NA value"
   )
@@ -42,10 +42,8 @@ InputsModel <- CreateInputsModel(
   Precip = BasinObs$P,
   PotEvap = BasinObs$E,
   Qupstream = matrix(Qupstream, ncol = 1),
-  LengthHydro = matrix(c(1000), nrow = 1),
-  BasinAreas = matrix(c(
-    BasinInfo$BasinArea * 2, BasinInfo$BasinArea
-  ), nrow = 1)
+  LengthHydro = 1000,
+  BasinAreas = c(BasinInfo$BasinArea * 2, BasinInfo$BasinArea)
 )
 
 Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
@@ -64,15 +62,15 @@ OutputsGR4JOnly <-
 
 
 test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
-  UpstBasinArea = InputsModel$BasinAreas[1, 1]
-  InputsModel$BasinAreas[1, 1] <<- 0
+  UpstBasinArea = InputsModel$BasinAreas[1]
+  InputsModel$BasinAreas[1] <<- 0
   OutputsSD <-
     RunModel(InputsModel,
              RunOptions,
              Param = c(Param, 1),
              FUN_MOD = RunModel_GR4J)
   expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim)
-  InputsModel$BasinAreas[1, 1] <<- UpstBasinArea
+  InputsModel$BasinAreas[1] <<- UpstBasinArea
 })
 
 test_that(
@@ -84,8 +82,8 @@ test_that(
       Precip = BasinObs$P,
       PotEvap = BasinObs$E,
       Qupstream = matrix(Qupstream, ncol = 1),
-      LengthHydro = matrix(c(0), nrow = 1),
-      BasinAreas = matrix(c(BasinInfo$BasinArea, 0), nrow = 1)
+      LengthHydro = 0,
+      BasinAreas = c(BasinInfo$BasinArea, 0)
     )
     OutputsSD <-
       RunModel(InputsModelZeroDown,