From e611fca1339e17468c539a1b4a3387b5f1819e5c Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@inrae.fr>
Date: Fri, 3 Sep 2021 18:00:08 +0200
Subject: [PATCH] fix(CreateInputsCrit): wrong data in Lavenne criterion
function
Closes #57
---
R/CreateInputsCrit.GRiwrmInputsModel.R | 30 +++++++++++++++++++-------
tests/testthat/test-CreateInputsCrit.R | 9 +++++++-
2 files changed, 30 insertions(+), 9 deletions(-)
diff --git a/R/CreateInputsCrit.GRiwrmInputsModel.R b/R/CreateInputsCrit.GRiwrmInputsModel.R
index 59e976e..8bc3c72 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 c77d454..866f434 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,
--
GitLab