CreateCalibOptions.R 4.17 KiB
#' Creation of the CalibOptions object
#'
#' 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 FixedParam a [numeric] [vector] as for [airGR::CreateCalibOptions],
#' or a [list] giving the values of non-optimized parameters (see details)
#' @param ... arguments passed to [airGR::CreateCalibOptions], see details
#'
#' @details See [airGR::CreateCalibOptions] documentation for a complete list of arguments.
#' With a \emph{GRiwrmInputsModel} object, all arguments are applied on each sub-catchments of the network
#' with some adaptation depending on the model used on each node.
#' If the argument `FixedParam` is a [numeric] [vector], it is applied to each node of
#' the network. Parameters are adapted depending on the use of the routing model
#' and the CemaNeige model on each node. If `FixedParam` is a [list] of [numeric],
#' each item of the list will be applied on corresponding nodes. Use the id "*" for applying
#' a setting on the remaining nodes. Example for applying one setting for all the
#' nodes except the id "54057":
#' ```
#' FixedParam <- list(`*` = c(NA, NA, NA, NA, NA, 0.25, NA, 10, NA),
#'                    `54057` = c(0.5, NA, NA, NA, NA, 0.25, NA, 10, NA))
#' ```
#' The argument `IsHyst` is ignored since it should be defined previously with [CreateInputsModel.GRiwrm].
#' @return Depending on the class of `InputsModel` argument (respectively `InputsModel` and `GRiwrmInputsModel` object), the returned value is respectively:
#' - a `CalibOptions` object (See [airGR::CreateCalibOptions])
#' - a `GRiwrmCalibOptions` object which is a [list] of `CalibOptions` object with one item per modeled sub-catchment
#' @seealso [CreateGRiwrm()], [CreateInputsModel.GRiwrm()], [CreateRunOptions()], [CreateInputsCrit()], [Calibration()]
#' @rdname CreateCalibOptions
#' @export
CreateCalibOptions <- function(x, FixedParam = NULL, ...) {
  UseMethod("CreateCalibOptions", x)
#' @rdname CreateCalibOptions
#' @export
CreateCalibOptions.InputsModel <- function(x, FixedParam = NULL, ...) {
  dots <- list(...)
  # Add FUN_MOD in parameters if carried by InputsModel
  if (!"FUN_MOD" %in% names(dots)) {
    if (!is.null(x$FUN_MOD)) {
      dots$FUN_MOD <- x$FUN_MOD
    } else {
      stop(" The parameter `FUN_MOD` must be defined")
  # Add FixedParam
  if (!is.null(FixedParam) && !any(is.na(FixedParam))) {
    dots$FixedParam <- NULL
  } else {
    dots$FixedParam <- FixedParam
  # Automatically define IsSD for intermediate basin GR models
  dots$IsSD = !is.null(x$Qupstream) & dots$FUN_MOD != "RunModel_Lag"
  # Add IsHyst in parameters if carried by InputsModel
  if (!is.null(x$model$IsHyst)) dots$IsHyst <- x$model$IsHyst
  # Call airGR function
  CalibOptions <- do.call(airGR::CreateCalibOptions, dots)
  # airGR::CreateCalibOptions don't like when there are no param to calibrate
  # But we need the full set of fixed parameters here for airGRiwrm Calibration
  if (!is.null(FixedParam) && !any(is.na(FixedParam))) {
    CalibOptions$FixedParam <- FixedParam
  return(CalibOptions)
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108
#' @rdname CreateCalibOptions #' @export CreateCalibOptions.character <- function(x, FixedParam = NULL, ...) { airGR::CreateCalibOptions( FUN_MOD = x, ... ) } #' @rdname CreateCalibOptions #' @export CreateCalibOptions.function <- function(x, FixedParam = NULL, ...) { airGR::CreateCalibOptions( FUN_MOD = x, ... ) } #' @rdname CreateCalibOptions #' @export CreateCalibOptions.RunModel_Reservoir <- function(x, FixedParam = NULL, ...) { stopifnot(inherits(x, "InputsModel")) CalibOptions <- CreateCalibOptions.InputsModel(x, FixedParam = NULL, ...) if (!is.null(FixedParam)) { CalibOptions$FixedParam <- FixedParam } else { warning( "The node '", x$id, "' which uses `RunModel_Reservoir` must have its parameters fixed: ", "\n", "You can either fix these parameters afterward by using the command:\n", "`CalibOptions[['", x$id, "']]$FixedParam <- c(Vmax, celerity)`\n", "Or by calling `CreateCalibOptions(InputsModel, FixedParam = list('", x$id, "' = c(Vmax, celerity)))`" ) } return(CalibOptions) }