fix: Allow to calibrate RunModel_Lag alone

Refs #108

R/Calibration_Michel.R

@@ -5,7 +5,8 @@ Calibration_Michel <- function(InputsModel,
                                FUN_MOD,
                                FUN_CRIT,           # deprecated
                                FUN_TRANSFO = NULL,
-                               verbose = TRUE) {
+                               verbose = TRUE,
+                               ...) {
 
 
   FUN_MOD  <- match.fun(FUN_MOD)
@@ -145,7 +146,7 @@ Calibration_Michel <- function(InputsModel,
     }
     ##Model_run
     Param <- CandidatesParamR[iNew, ]
-    OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD)
+    OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD, ...)
 
     ##Calibration_criterion_computation
     OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
@@ -294,7 +295,7 @@ Calibration_Michel <- function(InputsModel,
     for (iNew in 1:nrow(CandidatesParamR)) {
       ##Model_run
       Param <- CandidatesParamR[iNew, ]
-      OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD)
+      OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD, ...)
       ##Calibration_criterion_computation
       OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
       if (!is.na(OutputsCrit$CritValue)) {
@@ -355,7 +356,7 @@ Calibration_Michel <- function(InputsModel,
       CandidatesParamR <- FUN_TRANSFO(CandidatesParamT, "TR")
       ##Model_run
       Param <- CandidatesParamR[iNew, ]
-      OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD)
+      OutputsModel <- RunModel(InputsModel, RunOptions, Param, FUN_MOD = FUN_MOD, ...)
       ##Calibration_criterion_computation
       OutputsCrit <- ErrorCrit(InputsCrit, OutputsModel, verbose = FALSE)
       if (OutputsCrit$CritValue * OutputsCrit$Multiplier < CritOptim) {

R/CreateCalibOptions.R

@@ -76,6 +76,13 @@ CreateCalibOptions <- function(FUN_MOD,
     ObjectClass <- c(ObjectClass, "CemaNeigeGR6J")
     BOOL <- TRUE
   }
+  if (identical(FUN_MOD, RunModel_Lag)) {
+    ObjectClass <- c(ObjectClass, "Lag")
+    if (IsSD) {
+      stop("RunModel_Lag should not be used with 'isSD=TRUE'")
+    }
+    BOOL <- TRUE
+  }
   if (IsHyst) {
     ObjectClass <- c(ObjectClass, "hysteresis")
   }
@@ -136,6 +143,9 @@ CreateCalibOptions <- function(FUN_MOD,
         FUN_GR <- TransfoParam_CemaNeige
       }
     }
+    if (identical(FUN_MOD, RunModel_Lag)) {
+      FUN_GR <- TransfoParam_Lag
+    }
     if (is.null(FUN_GR)) {
       stop("'FUN_GR' was not found")
       return(NULL)
@@ -151,7 +161,7 @@ CreateCalibOptions <- function(FUN_MOD,
       FUN_LAG <- TransfoParam_Lag
     }
     ## set FUN_TRANSFO
-    if (sum(ObjectClass %in% c("GR4H", "GR5H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige")) > 0) {
+    if (sum(ObjectClass %in% c("GR4H", "GR5H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige", "Lag")) > 0) {
       if (!IsSD) {
         FUN_TRANSFO <- FUN_GR
       } else {
@@ -292,6 +302,10 @@ CreateCalibOptions <- function(FUN_MOD,
   if ("CemaNeigeGR6J" %in% ObjectClass) {
     NParam <- 8
   }
+  if ("Lag" %in% ObjectClass) {
+    NParam <- 1
+  }
+
   if (IsHyst) {
     NParam <- NParam + 2
   }

tests/testthat/test-RunModel_Lag.R

@@ -164,15 +164,16 @@ test_that("1 input with lag of 0.5 time step delay out gives an output delayed o
   expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs)
 })
 
+InputsCrit <- CreateInputsCrit(
+  FUN_CRIT = ErrorCrit_NSE,
+  InputsModel = InputsModel,
+  RunOptions = RunOptions,
+  VarObs = "Q",
+  Obs = (c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] +
+           BasinObs$Qmm[Ind_Run] * BasinAreas[2L]) / sum(BasinAreas)
+)
+
 test_that("Params from calibration with simulated data should be similar to initial params", {
-  InputsCrit <- CreateInputsCrit(
-    FUN_CRIT = ErrorCrit_NSE,
-    InputsModel = InputsModel,
-    RunOptions = RunOptions,
-    VarObs = "Q",
-    Obs = (c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] +
-             BasinObs$Qmm[Ind_Run] * BasinAreas[2L]) / sum(BasinAreas)
-  )
   CalibOptions <- CreateCalibOptions(
     FUN_MOD = RunModel_GR4J,
     FUN_CALIB = Calibration_Michel,
@@ -189,6 +190,23 @@ test_that("Params from calibration with simulated data should be similar to init
   expect_equal(OutputsCalib$ParamFinalR[1L], ParamSD[1L], tolerance = 2e-3)
 })
 
+test_that("Params from calibration with simulated data should be similar to initial params", {
+  CalibOptions <- CreateCalibOptions(
+    FUN_MOD = RunModel_Lag,
+    FUN_CALIB = Calibration_Michel,
+    IsSD = FALSE
+  )
+  OutputsCalib <- Calibration_Michel(
+    InputsModel = InputsModel,
+    RunOptions = RunOptions,
+    InputsCrit = InputsCrit,
+    CalibOptions = CalibOptions,
+    FUN_MOD = RunModel_Lag,
+    QcontribDown = OutputsGR4JOnly
+  )
+  expect_equal(OutputsCalib$ParamFinalR[1L], ParamSD[1L], tolerance = 2e-3)
+})
+
 test_that("1 no area input with lag of 1 time step delay out gives an output delayed of one time step converted to mm", {
   Qm3GR4Only <- OutputsGR4JOnly$Qsim * BasinAreas[2L] * 1e3
   # Specify that upstream flow is not related to an area