diff --git a/tests/testthat/test-Calibration.R b/tests/testthat/test-Calibration.R new file mode 100644 index 0000000000000000000000000000000000000000..504ecefdcfb5ea51eddc6e1469fefe79750d64d7 --- /dev/null +++ b/tests/testthat/test-Calibration.R @@ -0,0 +1,97 @@ +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)