Commit 1dc1fd5f authored by Dorchies David's avatar Dorchies David
Browse files

test(calibration): add tests for all yearly, monthly, daily GR models with or without Cemaneige

- Test if the calibrated parameters has changed compared to the reference

Refs #120
parent a508fbcf
Pipeline #23637 passed with stages
in 10 minutes and 8 seconds
context("Calibration")
sModels <- c(
"name data aggreg ParamFinalR",
"GR1A L0123001 %Y 0.91125",
"GR2M L0123001 %Y%m 259.8228;0.9975",
"GR4J L0123001 NA 223.6315877;0.5781516;97.5143942;2.2177177",
"GR5J L0123001 NA 220.3863609;0.8944531;93.5640705;1.7628720;0.4846427",
"GR6J L0123001 NA 192.8761657;0.6933087;49.1783293;2.2145422;0.5088240;6.8146261",
"CemaNeigeGR4J L0123001 NA 2.043839e+02;5.781516e-01;1.025141e+02;2.217718e+00;1.501502e-03;1.432036e+01",
"CemaNeigeGR5J L0123001 NA 1.983434e+02;8.747758e-01;9.849443e+01;1.768769e+00;4.829830e-01;1.501502e-03;1.432036e+01",
"CemaNeigeGR6J L0123001 NA 184.9341841;0.5551637;59.7398917;2.2177177;0.4760000;6.0496475;0.0000000;14.4642868"
)
dfModels <- read.table(text = paste(sModels, collapse = "\n"), header = TRUE)
dates <- c("1985-01-01", "1985-12-31", "1986-01-01", "2012-12-31")
TestModelCalibration <- function(model) {
model <- as.list(model)
test_that(paste(model$name, "works"), {
skip_on_cran()
sModel <- paste0("RunModel_", model$name)
if(!is.na(model$aggreg)) {
sIM_FUN_MOD <- "RunModel_GR4J"
} else {
sIM_FUN_MOD <- sModel
}
## loading catchment data
data(list = model$data)
# preparation of the InputsModel object with daily time step data
InputsModel <- CreateInputsModel(FUN_MOD = sIM_FUN_MOD,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E,
TempMean = BasinObs$T,
ZInputs = median(BasinInfo$HypsoData),
HypsoData = BasinInfo$HypsoData,
NLayers = 5)
if(!is.na(model$aggreg)) {
# conversion of InputsModel to target time step
InputsModel <- SeriesAggreg(InputsModel, Format = model$aggreg)
dfQobs <- SeriesAggreg(data.frame(DatesR = BasinObs$DatesR, Qmm = BasinObs$Qmm),
Format = model$aggreg, ConvertFun = "sum")
Obs <- dfQobs$Qmm
} else {
Obs <- BasinObs$Qmm
}
# calibration period selection
if(is.na(model$aggreg)) {
date_format <- "%Y-%m-%d"
} else {
date_format <- model$aggreg
}
dates <- sapply(dates, function(x) format(as.Date(x), format = date_format))
Ind_WarmUp <- seq(
which(format(InputsModel$DatesR, format = date_format)==dates[1]),
which(format(InputsModel$DatesR, format = date_format)==dates[2])
)
Ind_Run <- seq(
which(format(InputsModel$DatesR, format = date_format)==dates[3]),
which(format(InputsModel$DatesR, format = date_format)==dates[4])
)
# preparation of the RunOptions object
suppressWarnings(
RunOptions <- CreateRunOptions(
FUN_MOD = sModel,
InputsModel = InputsModel,
IndPeriod_Run = Ind_Run,
IndPeriod_WarmUp = Ind_WarmUp
)
)
# calibration criterion: preparation of the InputsCrit object
InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel,
RunOptions = RunOptions, Obs = Obs[Ind_Run])
# preparation of CalibOptions object
CalibOptions <- CreateCalibOptions(sModel)
# calibration
OutputsCalib <- Calibration(InputsModel = InputsModel, RunOptions = RunOptions,
InputsCrit = InputsCrit, CalibOptions = CalibOptions,
FUN_MOD = sModel)
expect_equal(OutputsCalib$ParamFinalR,
as.numeric(strsplit(model$ParamFinalR, ";")[[1]]),
tolerance = 1E-6)
})
}
apply(dfModels, 1, TestModelCalibration)
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