From e974451bca2217f43a84708a158fbfc1915e7cfa Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@irstea.fr>
Date: Thu, 4 Jun 2020 08:15:38 +0200
Subject: [PATCH] V1.6.1.15: refactor: rename QobsUpstr variable to Qupstream
Refs #34
---
DESCRIPTION | 10 ++++----
R/CreateInputsModel.R | 34 +++++++++++++-------------
R/RunModel.R | 38 +++++++++++++++---------------
tests/testthat/test-RunModel_LAG.R | 28 +++++++++++-----------
4 files changed, 55 insertions(+), 55 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 84f1b2f2..774120a4 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,23 +1,23 @@
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
diff --git a/R/CreateInputsModel.R b/R/CreateInputsModel.R
index ad3635eb..f7978318 100644
--- a/R/CreateInputsModel.R
+++ b/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))
}
diff --git a/R/RunModel.R b/R/RunModel.R
index 3fc49636..cd851b65 100644
--- a/R/RunModel.R
+++ b/R/RunModel.R
@@ -1,45 +1,45 @@
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
diff --git a/tests/testthat/test-RunModel_LAG.R b/tests/testthat/test-RunModel_LAG.R
index 3876ba9b..cd53e8ac 100644
--- a/tests/testthat/test-RunModel_LAG.R
+++ b/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(
--
GitLab