Skip to content

GitLab

Commit e974451b authored by Dorchies David's avatar Dorchies David
Browse files

V1.6.1.15: refactor: rename QobsUpstr variable to Qupstream 

Refs #34
parent 088a5ddb
Hide whitespace changes
Inline Side-by-side
DESCRIPTION
View file @ e974451b
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
View file @ e974451b
......@@ -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
View file @ e974451b
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
View file @ e974451b
......@@ -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(
......
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