From c056397ca2b36717c02a06ff2316c6602c878f7e Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@inrae.fr>
Date: Thu, 24 Jun 2021 12:36:23 +0200
Subject: [PATCH] fix(ErroCrit_GAPX): parameter range of 20 instead of 40
- also add a test on a priori parameter set with NA
Refs #111
---
R/CreateErrorCrit_GAPX.R | 2 +-
tests/testthat/test-CreateErrorCrit_GAPX.R | 13 ++++++++++++-
2 files changed, 13 insertions(+), 2 deletions(-)
diff --git a/R/CreateErrorCrit_GAPX.R b/R/CreateErrorCrit_GAPX.R
index 706c407a..33b424fa 100644
--- a/R/CreateErrorCrit_GAPX.R
+++ b/R/CreateErrorCrit_GAPX.R
@@ -18,7 +18,7 @@ CreateErrorCrit_GAPX <- function(FUN_TRANSFO) {
ParamOpt <- EC$VarSim[!EC$TS_ignore]
## ErrorCrit
- Crit <- 1 - sum(((ParamApr - ParamOpt) / 40)^2)^0.5
+ Crit <- 1 - sum(((ParamApr - ParamOpt) / 20)^2)^0.5
if (is.numeric(Crit) & is.finite(Crit)) {
CritValue <- Crit
diff --git a/tests/testthat/test-CreateErrorCrit_GAPX.R b/tests/testthat/test-CreateErrorCrit_GAPX.R
index 60ad4fe6..3b41c843 100644
--- a/tests/testthat/test-CreateErrorCrit_GAPX.R
+++ b/tests/testthat/test-CreateErrorCrit_GAPX.R
@@ -28,5 +28,16 @@ test_that("ErrorCrit should return 1 for same parameters", {
test_that("ErrorCrit should return 1-nbParam^0.5/40 for ParamT shifted by 1", {
ParamT <- ParamT + 1
IC <- CreateInputsCrit(ErrorCrit_GAPX, InputsModel, RunOptions, Obs = ParamT, VarObs = "ParamT")
- expect_equal(ErrorCrit_GAPX(IC, OutputsModel)$CritValue, 1 - RunOptions$FeatFUN_MOD$NbParam^0.5 / 40)
+ expect_equal(ErrorCrit_GAPX(IC, OutputsModel)$CritValue,
+ 1 - RunOptions$FeatFUN_MOD$NbParam^0.5 / 20)
+})
+
+test_that("ErrorCrit should return 1-(nbParam-1)^0.5/40 for ParamT shifted by 1 with one NA", {
+ ParamT <- ParamT + 1
+ ParamT[1] <- NA
+ IC <- CreateInputsCrit(ErrorCrit_GAPX, InputsModel, RunOptions, Obs = ParamT, VarObs = "ParamT")
+ expect_equal(suppressWarnings(ErrorCrit_GAPX(IC, OutputsModel)$CritValue),
+ 1 - (RunOptions$FeatFUN_MOD$NbParam - 1)^0.5 / 20)
+ expect_warning(ErrorCrit_GAPX(IC, OutputsModel)$CritValue,
+ regexp = "criterion GAPX computed on less than 4 parameters")
})
--
GitLab