fix: crash of CreateRunOptions with RunModel_Lag

- Temporary fix waiting for resolution of HYCAR-Hydro/airgr#167

Refs #107

R/CreateRunOptions.R

@@ -3,15 +3,22 @@
 #' This function can be used either for a catchment (with an \emph{InputsModel} object) or for a network (with a \emph{GRiwrmInputsModel} object)
 #'
 #' @template param_x
+#' @param InputsModel object of class \emph{InputsModel} (only used to be consistent
+#'        with the original [airGR::CreateRunOptions] which has `FUN_MOD` as first
+#'        parameter)
+#'        see [airGR::CreateInputsModel] for details
 #' @param ... arguments passed to [airGR::CreateRunOptions], see details
 #'
 #' @details See [airGR::CreateRunOptions] documentation for a complete list of arguments.
 #'
-#' If `InputsModel` argument is a \emph{GRiwrmInputsModel} object, `IniStates` must be a list of [numeric] object of class \emph{IniStates} with one item per modeled sub-catchment.
+#' If `x` argument is a \emph{GRiwrmInputsModel} object, `IniStates` must be a
+#' list of [numeric] object of class \emph{IniStates} with one item per modeled sub-catchment.
 #'
-#' With a \emph{GRiwrmInputsModel} object, all arguments are applied on each sub-catchments of the network.
+#' With a \emph{GRiwrmInputsModel} object, all arguments are applied on each
+#' sub-catchments of the network.
 #'
-#' @return Depending on the class of `InputsModel` argument (respectively \emph{InputsModel} and \emph{GRiwrmInputsModel} object), the returned value is respectively:
+#' @return Depending on the class of `InputsModel` argument (respectively
+#' \emph{InputsModel} and \emph{GRiwrmInputsModel} object), the returned value is respectively:
 #' - a `RunOptions` object (See [airGR::CreateRunOptions])
 #' - a `GRiwrmRunOptions` object which is a [list] of `RunOptions` objects with one item per modeled sub-catchment
 #'
@@ -25,28 +32,39 @@ CreateRunOptions <- function(x, ...) {
 #' @rdname CreateRunOptions
 #' @export
 CreateRunOptions.InputsModel <- function(x, ...) {
-  if (!exists("FUN_MOD") && !is.null(x$FUN_MOD)) {
-    airGR::CreateRunOptions(FUN_MOD = x$FUN_MOD,
-                            InputsModel = x,
-                            ...)
+  hasFUN_MOD <- "FUN_MOD" %in% names(list(...))
+  if (!hasFUN_MOD && !is.null(x$FUN_MOD)) {
+    CreateRunOptions(x,
+                     FUN_MOD = x$FUN_MOD,
+                     ...)
+  } else if (hasFUN_MOD){
+    # Temporary fix waiting for resolution of HYCAR-Hydro/airgr#167
+    if (identical(match.fun(x$FUN_MOD), RunModel_Lag)) {
+      dots <- list(...)
+      dots$InputsModel <- x
+      dots$IniStates <- CreateIniStates(RunModel_Lag, x)
+      do.call(airGR::CreateRunOptions, dots)
+    } else {
+      # End of temporary fix HYCAR-Hydro/airgr#167
+      airGR::CreateRunOptions(InputsModel = x, ...)
+    }
   } else {
-    airGR::CreateRunOptions(InputsModel = x,
-                            ...)
+    stop(" The parameter `FUN_MOD` must be defined")
   }
 }
 
 #' @rdname CreateRunOptions
 #' @export
-CreateRunOptions.character <- function(x, ...) {
-
-  airGR::CreateRunOptions(FUN_MOD = x,
-                          ...)
+CreateRunOptions.character <- function(x, InputsModel, ...) {
+  CreateRunOptions(x = InputsModel,
+                   FUN_MOD = x,
+                   ...)
 }
 
 #' @rdname CreateRunOptions
 #' @export
-CreateRunOptions.function <- function(x, ...) {
-
-  airGR::CreateRunOptions(FUN_MOD = x,
-                          ...)
+CreateRunOptions.function <- function(x, InputsModel, ...) {
+  CreateRunOptions(x = InputsModel,
+                   FUN_MOD = x,
+                   ...)
 }

tests/testthat/test-RunModel.R

@@ -141,4 +141,7 @@ test_that("RunModel_Lag should work", {
                           DatesR = DatesR,
                           Precip = Precip[, "54095", drop = FALSE],
                           PotEvap = PotEvap[, "54095", drop = FALSE])
+  RO <- CreateRunOptions(IM,
+                         IndPeriod_Run = IndPeriod_Run,
+                         IndPeriod_WarmUp = IndPeriod_WarmUp)
 })