Failed to fetch fork details. Try again later.
-
Dorchies David authored
Refs #108
ae70dd4b
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)
# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
Qupstream <- floor((sin((seq_along(BasinObs$Qmm)/365*2*3.14))+1) * mean(BasinObs$Qmm, na.rm = TRUE))
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E,
Qupstream = matrix(Qupstream, ncol = 1),
LengthHydro = 1,
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 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
IndPeriod_Run = Ind_Run))
test_that("QcontribDown parameter should be a numeric vector or an OutputModel object", {
regexp = "'QcontribDown' must be a numeric vector or a 'OutputsModel' object"
expect_error(
RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = "A"),
regexp = regexp
)
expect_error(
RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = NULL),
regexp = regexp
)
expect_error(
RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = matrix(1, ncol = 1)),
regexp = regexp
)
})
Param <- c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started
OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel,
RunOptions = RunOptions,
Param = Param)
test_that("QcontribDown should contain a Qsim key", {
QcontribDown <- OutputsGR4JOnly
QcontribDown$Qsim <- NULL
expect_error(
RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
regexp = "should contain a key 'Qsim'"
)
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
})
test_that("'QcontribDown$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", {
QcontribDown <- OutputsGR4JOnly
QcontribDown$Qsim <- c(QcontribDown$Qsim, 0)
expect_error(
RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
regexp = "should have the same lenght as"
)
})
test_that("RunModel(FUN=RunModel_Lag) should give same result as RunModel_Lag", {
QcontribDown <- OutputsGR4JOnly
Output_RunModel_Lag <- RunModel_Lag(InputsModel = InputsModel,
RunOptions = RunOptions,
Param = 1,
QcontribDown = QcontribDown)
Output_RunModel <- RunModel(InputsModel = InputsModel,
RunOptions = RunOptions,
Param = 1,
FUN_MOD = RunModel_Lag,
QcontribDown = QcontribDown)
expect_equal(Output_RunModel, Output_RunModel_Lag)
})
test_that("'Qupstream' contain NA values", {
expect_warning(
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' contains NA values: model outputs will contain NAs"
)
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
IndPeriod_Run = Ind_Run))
QcontribDown <- OutputsGR4JOnly
# Warning with RunModel_Lag
expect_warning(
RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
regexp = "time steps with NA values"
)
# No warning during calibration
RunOptions$Outputs_Sim <- RunOptions$Outputs_Cal
expect_warning(
RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1, QcontribDown = QcontribDown),
regexp = NA
)
})
test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
UpstBasinArea <- InputsModel$BasinAreas[1L]
InputsModel$BasinAreas[1L] <- 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,