Commit 9a99a6c5 authored by Dorchies David's avatar Dorchies David

test(sd): Add calibration test

- Check if calibrated params from simulation are equal to initial parameters
- typo corrections

Refs #34
parent 031b0716
Pipeline #12837 passed with stages
in 12 minutes and 38 seconds
...@@ -4,82 +4,131 @@ data(L0123001) ...@@ -4,82 +4,131 @@ data(L0123001)
test_that("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'", { test_that("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'", {
expect_error( expect_error(
InputsModel <- CreateInputsModel( InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, FUN_MOD = RunModel_GR4J,
Precip = BasinObs$P, PotEvap = BasinObs$E, DatesR = BasinObs$DatesR,
QobsUpstr = matrix(BasinObs$Qmm * 2,ncol=1), Precip = BasinObs$P,
LengthHydro = matrix(c(1),nrow=1), PotEvap = BasinObs$E,
BasinAreas = matrix(c(1),nrow=1) QobsUpstr = matrix(BasinObs$Qmm, ncol = 1),
), LengthHydro = matrix(c(1), nrow = 1),
regexp = "'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'" BasinAreas = matrix(c(1), nrow = 1)
) ),
regexp = "'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'"
)
}) })
test_that("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'", { test_that("'BasinAreas' must have one column more than 'QobsUpstr' and 'LengthHydro'", {
expect_error( expect_error(
InputsModel <- CreateInputsModel( InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, FUN_MOD = RunModel_GR4J,
Precip = BasinObs$P, PotEvap = BasinObs$E, DatesR = BasinObs$DatesR,
QobsUpstr = matrix(BasinObs$Qmm, ncol = 1), Precip = BasinObs$P,
LengthHydro = matrix(c(1), nrow = 1), PotEvap = BasinObs$E,
BasinAreas = matrix(c(1, 2),nrow = 1) QobsUpstr = matrix(BasinObs$Qmm, ncol = 1),
), LengthHydro = matrix(c(1), nrow = 1),
regexp = "'QobsUpstr' cannot contain any NA value" BasinAreas = matrix(c(1, 2), nrow = 1)
) ),
regexp = "'QobsUpstr' cannot contain any NA value"
)
}) })
QobsUpstr = BasinObs$Qmm QobsUpstr = BasinObs$Qmm
QobsUpstr[is.na(QobsUpstr)] = mean(QobsUpstr, na.rm = TRUE) QobsUpstr[is.na(QobsUpstr)] = mean(QobsUpstr, na.rm = TRUE)
InputsModel <- CreateInputsModel( InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, FUN_MOD = RunModel_GR4J,
Precip = BasinObs$P, PotEvap = BasinObs$E, DatesR = BasinObs$DatesR,
QobsUpstr = matrix(QobsUpstr,ncol=1), Precip = BasinObs$P,
LengthHydro = matrix(c(1),nrow=1), PotEvap = BasinObs$E,
BasinAreas = matrix(c(BasinInfo$BasinArea,BasinInfo$BasinArea),nrow=1) QobsUpstr = matrix(QobsUpstr, ncol = 1),
LengthHydro = matrix(c(1), nrow = 1),
BasinAreas = matrix(c(
BasinInfo$BasinArea * 2, BasinInfo$BasinArea
), nrow = 1)
) )
Ind_Run <- seq( Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"), which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1999-12-31")
)
RunOptions <- CreateRunOptions( RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
FUN_MOD = RunModel_GR4J, InputsModel = InputsModel,
InputsModel = InputsModel, IndPeriod_Run = Ind_Run IndPeriod_Run = Ind_Run)
)
Param = c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started Param = c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started
OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param) OutputsGR4JOnly <-
RunModel_GR4J(InputsModel = InputsModel,
RunOptions = RunOptions,
Param = Param)
test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
UpstBasinArea = InputsModel$BasinAreas[1,1] UpstBasinArea = InputsModel$BasinAreas[1, 1]
InputsModel$BasinAreas[1,1] <<- 0 InputsModel$BasinAreas[1, 1] <<- 0
OutputsSD <- RunModel(InputsModel, RunOptions, Param = c(Param, 1), FUN_MOD = RunModel_GR4J) OutputsSD <-
RunModel(InputsModel,
RunOptions,
Param = c(Param, 1),
FUN_MOD = RunModel_GR4J)
expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim) expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim)
InputsModel$BasinAreas[1,1] <<- UpstBasinArea InputsModel$BasinAreas[1, 1] <<- UpstBasinArea
}) })
test_that("Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", { test_that(
InputsModel <- CreateInputsModel( "Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone",
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, {
Precip = BasinObs$P, PotEvap = BasinObs$E, InputsModelZeroDown <- CreateInputsModel(
QobsUpstr = matrix(QobsUpstr,ncol=1), FUN_MOD = RunModel_GR4J,
LengthHydro = matrix(c(0),nrow=1), DatesR = BasinObs$DatesR,
BasinAreas = matrix(c(BasinInfo$BasinArea,0),nrow=1) Precip = BasinObs$P,
) PotEvap = BasinObs$E,
OutputsSD <- RunModel(InputsModel, RunOptions, Param = c(Param, 1), FUN_MOD = RunModel_GR4J) QobsUpstr = matrix(QobsUpstr, ncol = 1),
expect_equal(OutputsSD$Qsim, QobsUpstr[Ind_Run]) LengthHydro = matrix(c(0), nrow = 1),
}) BasinAreas = matrix(c(BasinInfo$BasinArea, 0), nrow = 1)
)
OutputsSD <-
RunModel(InputsModelZeroDown,
RunOptions,
Param = c(Param, 1),
FUN_MOD = RunModel_GR4J)
expect_equal(OutputsSD$Qsim, QobsUpstr[Ind_Run])
}
)
ParamSD = c(Param, InputsModel$LengthHydro * 1000 / (24 * 60 * 60))
OutputsSD <-
RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J)
test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", { test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", {
QlsGR4Only <- OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2] * 1E6 / 86400 QlsGR4Only <-
ParamSD = c(Param, InputsModel$LengthHydro * 1000 / (24 * 60 * 60)) OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2] * 1E6 / 86400
OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) QlsSdSim <-
QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400 OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1E6 / 86400
QlsUpstLagObs <- c(0, QobsUpstr[Ind_Run[1:(length(Ind_Run)-1)] + 1]) * InputsModel$BasinAreas[1] * 1E6 / 86400 QlsUpstLagObs <-
expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) c(0, QobsUpstr[Ind_Run[1:(length(Ind_Run) - 1)] + 1]) * InputsModel$BasinAreas[1] * 1E6 / 86400
expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs)
})
test_that("Params from calibration with simulated data should be similar to initial params", {
InputsCrit <- CreateInputsCrit(
FUN_CRIT = ErrorCrit_NSE,
InputsModel = InputsModel,
RunOptions = RunOptions,
VarObs = "Q",
Obs = BasinObs$Qmm[Ind_Run]
)
CalibOptions <- CreateCalibOptions(
FUN_MOD = RunModel_GR4J,
FUN_CALIB = Calibration_Michel,
IsSD = TRUE
)
OutputsCalib <- Calibration_Michel(
InputsModel = InputsModel,
RunOptions = RunOptions,
InputsCrit = InputsCrit,
CalibOptions = CalibOptions,
FUN_MOD = RunModel_GR4J
)
expect_equal(OutputsCalib$ParamFinalR, ParamSD, tolerance = 1E-3)
}) })
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