diff --git a/R/CreateRunOptions.R b/R/CreateRunOptions.R index 48dfeca159a60f37504a9142d6577f60f1a61add..a7abda5d2a1bd45ed0e1c6f9d2437bfa9d5b044f 100644 --- a/R/CreateRunOptions.R +++ b/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, + ...) } diff --git a/tests/testthat/test-RunModel.R b/tests/testthat/test-RunModel.R index 0bbdc0c8855cfe9c3e1d9f167c519d1a14775413..cb29c0597a969b24af5e91054b22d9336ece6894 100644 --- a/tests/testthat/test-RunModel.R +++ b/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) })