Failed to fetch fork details. Try again later.
-
Dorchies David authored
Refs #34
8534b839
Forked from
HYCAR-Hydro / airGR
Source project has a limited visibility.
context("RunModel_LAG")
data(L0123001)
test_that("'BasinAreas' must have one more element than 'LengthHydro'", {
expect_error(
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E,
Qupstream = matrix(BasinObs$Qmm, ncol = 1),
LengthHydro = 1,
BasinAreas = 1
),
regexp = "'BasinAreas' must have one more element than 'LengthHydro'"
)
})
BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea)
test_that("'Qupstream' cannot contain any NA value", {
expect_error(
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E,
Qupstream = matrix(BasinObs$Qmm, ncol = 1),
LengthHydro = 1,
BasinAreas = BasinAreas
),
regexp = "'Qupstream' cannot contain any NA value"
)
})
# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
Qupstream = floor((sin((1:length(BasinObs$Qmm)/365*2*3.14))+1)*mean(BasinObs$Qmm, na.rm = T))
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E,
Qupstream = matrix(Qupstream, ncol = 1),
LengthHydro = 1000,
BasinAreas = BasinAreas
)
Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
IndPeriod_Run = Ind_Run)
test_that("InputsModel parameter should contain an OutputsModel key", {
expect_error(
RunModel_LAG(InputsModel, RunOptions, 1),
regexp = "'InputsModel' should contain an 'OutputsModel' key"
)
})
Param = c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started
OutputsGR4JOnly <-
RunModel_GR4J(InputsModel = InputsModel,
RunOptions = RunOptions,
Param = Param)
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
test_that("InputsModel$OutputsModel should contain a Qsim key", {
InputsModel$OutputsModel <- OutputsGR4JOnly
InputsModel$OutputsModel$Qsim <- NULL
expect_error(
RunModel_LAG(InputsModel, RunOptions, 1),
regexp = "should contain a key 'Qsim'"
)
})
test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", {
InputsModel$OutputsModel <- OutputsGR4JOnly
InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0)
expect_error(
RunModel_LAG(InputsModel, RunOptions, 1),
regexp = "should have the same lenght as"
)
})
test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", {
InputsModel$OutputsModel <- OutputsGR4JOnly
InputsModel$OutputsModel$Qsim[10] <- NA
expect_error(
RunModel_LAG(InputsModel, RunOptions, 1),
regexp = "contain no NA"
)
})
test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
UpstBasinArea = InputsModel$BasinAreas[1]
InputsModel$BasinAreas[1] <- 0
OutputsSD <-
RunModel(InputsModel,
RunOptions,
Param = c(1, Param),
FUN_MOD = RunModel_GR4J)
expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim)
})
test_that(
"Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone",
{
InputsModel$LengthHydro <- 0
InputsModel$BasinAreas <- c(BasinInfo$BasinArea, 0)
OutputsSD <-
RunModel(InputsModel,
RunOptions,
Param = c(1, Param),
FUN_MOD = RunModel_GR4J)
expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run])
}
)
ParamSD = c(InputsModel$LengthHydro / (24 * 60 * 60), Param) # Speed corresponding to one time step delay
QlsGR4Only <-
OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2] * 1E6 / 86400
test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", {
OutputsSD <-
RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J)
QlsSdSim <-
OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400
QlsUpstLagObs <-
c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1] * 1E6 / 86400
expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs)
})
test_that("1 input with lag of 0.5 time step delay out gives an output delayed of 0.5 time step", {
OutputsSD <-
RunModel(InputsModel, RunOptions, Param = c(InputsModel$LengthHydro / (12 * 3600), Param), FUN_MOD = RunModel_GR4J)