Commit 67ce1ead authored by Dorchies David's avatar Dorchies David

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

Refs #34
parent e974451b
Pipeline #13361 passed with stages
in 11 minutes and 53 seconds
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")),
......
......@@ -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")
}
......
......@@ -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)
......
......@@ -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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment