diff --git a/tests/testthat/helper_1_RunModel.R b/tests/testthat/helper_1_RunModel.R index 565d840b3609b927d2f389ba54df9d02106b9e62..3e9acbede60e83b4f6ad62b24b4d4f1a59ce50fb 100644 --- a/tests/testthat/helper_1_RunModel.R +++ b/tests/testthat/helper_1_RunModel.R @@ -15,7 +15,8 @@ setupRunModel <- runRunOptions = TRUE, runRunModel = TRUE, griwrm = NULL, - Qobs2 = NULL) { + Qobs2 = NULL, + IsHyst = FALSE) { data(Severn) @@ -43,12 +44,20 @@ setupRunModel <- # Convert meteo data to SD (remove upstream areas) Precip <- ConvertMeteoSD(griwrm, PrecipTot) PotEvap <- ConvertMeteoSD(griwrm, PotEvapTot) + if (IsHyst) { + TempMean <- PotEvap+5 # Fake temperatures + } else { + TempMean <- NULL + } # set up inputs if (!runInputsModel) return(environment()) InputsModel <- - suppressWarnings(CreateInputsModel(griwrm, DatesR, Precip, PotEvap, Qobs = Qobs2)) + suppressWarnings(CreateInputsModel(griwrm, DatesR, Precip, PotEvap, + TempMean = TempMean, + Qobs = Qobs2, + IsHyst = IsHyst)) # RunOptions if (!runRunOptions) diff --git a/tests/testthat/helper_Calibration.R b/tests/testthat/helper_Calibration.R index c2928118c67bc5c677964329fa5947a110a2e6bb..08dc63672e9cff31494c3ebff5f344520423ed00 100644 --- a/tests/testthat/helper_Calibration.R +++ b/tests/testthat/helper_Calibration.R @@ -1,14 +1,19 @@ runCalibration <- function(nodes = NULL, Qobs2 = NULL, InputsCrit = NULL, + CalibOptions = NULL, FUN_CRIT = ErrorCrit_KGE2, - runRunModel = FALSE) { + runRunModel = FALSE, + IsHyst = FALSE) { if (is.null(nodes)) { griwrm <- NULL } else { griwrm <- CreateGRiwrm(nodes) } - e <- setupRunModel(griwrm = griwrm, runRunModel = runRunModel, Qobs2 = Qobs2) + e <- setupRunModel(griwrm = griwrm, + runRunModel = runRunModel, + Qobs2 = Qobs2, + IsHyst = IsHyst) for(x in ls(e)) assign(x, get(x, e)) rm(e) np <- getAllNodesProperties(griwrm) @@ -22,7 +27,8 @@ runCalibration <- function(nodes = NULL, ) } - CalibOptions <- CreateCalibOptions(InputsModel) + if (is.null(CalibOptions)) CalibOptions <- CreateCalibOptions(InputsModel) + OutputsCalib <- Calibration(InputsModel, RunOptions, InputsCrit, CalibOptions) Param <- sapply(OutputsCalib, "[[", "ParamFinalR") return(environment()) diff --git a/tests/testthat/test-RunModel_Ungauged.R b/tests/testthat/test-RunModel_Ungauged.R index 1a03a4fd329df7e13dfe3432a35fe881dad652f0..1030fd1966f64f4677b44aca56bf52040949b764 100644 --- a/tests/testthat/test-RunModel_Ungauged.R +++ b/tests/testthat/test-RunModel_Ungauged.R @@ -233,3 +233,52 @@ test_that("Donor node with diversion should work", { for(x in ls(e)) assign(x, get(x, e)) expect_equal(OC_ref$`54032`$CritFinal, OutputsCalib$`54032`$CritFinal, tolerance = 1E-3) }) + +test_that("Cemaneige with hysteresis works", { + nodes <- loadSevernNodes() + nodes <- nodes[nodes$id %in% c("54057", "54032", "54001"), ] + nodes$model <- "RunModel_CemaNeigeGR4J" + nodes$model[nodes$id != 54057] <- "Ungauged" + griwrm <- CreateGRiwrm(nodes) + + # # The custom ErrorCrit function !!! + ErrorCrit_KGE3 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE) { + OutputsCritQ <- suppressMessages( + ErrorCrit_KGE2(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE) + ) + InputsCrit$Obs <- InputsCrit$SCA #a adapter + OutputsModel$Qsim <- OutputsModel$CemaNeigeLayers[[1]]$Gratio #a adapter + OutputsCritSCA <- suppressMessages( + ErrorCrit_KGE2(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE) + ) + OutputsCritQ$CritValue <- + (OutputsCritQ$CritValue + OutputsCritSCA$CritValue) / 2 + OutputsCritQ$CritName <- "(0.5 * KGE2[Q] + 0.5 * KGE2[SCA])" + return(OutputsCritQ) + } + class(ErrorCrit_KGE3) <- c("FUN_CRIT", class(ErrorCrit_KGE3)) + + e <- setupRunModel(griwrm = griwrm, runRunModel = FALSE, IsHyst = TRUE) + for(x in ls(e)) assign(x, get(x, e)) + np <- getAllNodesProperties(griwrm) + InputsCrit <- CreateInputsCrit( + InputsModel, + FUN_CRIT = ErrorCrit_KGE3, + RunOptions = RunOptions, + Obs = Qobs[IndPeriod_Run, np$id[np$RunOff & np$calibration == "Gauged"], drop = FALSE], + ) + InputsCrit$`54057`$SCA <- runif(length(IndPeriod_Run)) # Fake SCA + CalibOptions <- CreateCalibOptions(InputsModel) + CO <- lapply(CalibOptions, function(x) { + x$StartParamList <- matrix( + c(0.605, 320.596, -0.042, 37.991, 2.221, 0.705, 6.764, 85.000, 0.850), + nrow = 1) + x$StartParamDistrib <- NULL + x + }) + class(CO) <- class(CalibOptions) + e <- runCalibration(nodes, InputsCrit = InputsCrit, CalibOptions = CO, IsHyst = TRUE) + for(x in ls(e)) assign(x, get(x, e)) + expect_equal(sapply(Param, length), + c("54057" = 9, "54032" = 9, "54001" = 8)) +})