diff --git a/R/CreateInputsCrit.GRiwrmInputsModel.R b/R/CreateInputsCrit.GRiwrmInputsModel.R
index 59e976e86b0b63fe11eea8937ee060b31e1b810d..8bc3c7269c936f942baa1101c812d88e0561b643 100644
--- a/R/CreateInputsCrit.GRiwrmInputsModel.R
+++ b/R/CreateInputsCrit.GRiwrmInputsModel.R
@@ -82,15 +82,29 @@ CreateInputsCrit.GRiwrmInputsModel <- function(InputsModel,
return(InputsCrit)
}
+#' Generate a `CreateInputsCrit_Lavenne` function which embeds know parameters
+#'
+#' The created function will be used in calibration for injecting necessary `AprParamR` and `AprCrit`
+#' parameters, which can be known only during calibration process, in the call of `CreateInputsCrit_Lavenne`.
+#'
+#' @param InputsModel See [CreateInputsCrit] parameters
+#' @param FUN_CRIT See [CreateInputsCrit] parameters
+#' @param RunOptions See [CreateInputsCrit] parameters
+#' @param Obs See [CreateInputsCrit] parameters
+#' @param k See [CreateInputsCrit] parameters
+#' @param ... further arguments for [airGR::CreateInputsCrit_Lavenne]
+#'
+#' @return A function with `AprParamR` and `AprCrit`
+#' @noRd
+#'
CreateLavenneFunction <- function(InputsModel, FUN_CRIT, RunOptions, Obs, k, ...) {
+ # The following line solve the issue #57 by forcing the evaluation of all the parameters.
+ # See also: https://stackoverflow.com/questions/69016698/is-there-a-bug-on-closures-embedded-in-a-list-in-r/69028161#69028161
+ arguments <- c(as.list(environment()), list(...))
function(AprParamR, AprCrit) {
- CreateInputsCrit_Lavenne(FUN_CRIT = FUN_CRIT,
- InputsModel = InputsModel,
- RunOptions = RunOptions,
- Obs = Obs,
- AprParamR = AprParamR,
- AprCrit = AprCrit,
- k = k,
- ...)
+ do.call(
+ CreateInputsCrit_Lavenne,
+ c(arguments, list(AprParamR = AprParamR, AprCrit = AprCrit))
+ )
}
}
diff --git a/tests/testthat/test-CreateInputsCrit.R b/tests/testthat/test-CreateInputsCrit.R
index c77d4548633688a56ede0b3427712fa80147260a..866f434651ef1041e45a0b40b077d31749150206 100644
--- a/tests/testthat/test-CreateInputsCrit.R
+++ b/tests/testthat/test-CreateInputsCrit.R
@@ -37,7 +37,14 @@ test_that("De Lavenne criterion is OK", {
expect_s3_class(IC57, "Compo")
})
-test_that("De Lavenne criterion: wrong sub-catchment order should throw error", {
+test_that("Lavenne embedded data is correct #57", {
+ lapply(names(AprioriIds), function(id) {
+ p <- as.list(environment(attr(IC[[id]], "Lavenne_FUN")))
+ expect_equal(id, p$InputsModel$id)
+ })
+})
+
+test_that("Lavenne criterion: wrong sub-catchment order should throw error", {
expect_error(
CreateInputsCrit(InputsModel = InputsModel,
RunOptions = RunOptions,