CreateInputsCrit.R

CreateInputsCrit <- function(FUN_CRIT,
                             InputsModel,
                             RunOptions,
                             Qobs,              # deprecated
                             Obs,
                             VarObs = "Q",
                             BoolCrit = NULL,
                             transfo = "",
                             Weights = NULL,
                             Ind_zeroes = NULL, # deprecated
                             epsilon = NULL,
                             warnings = TRUE,
                             verbose = TRUE) {
  
  
  ObjectClass <- NULL
  
  
  ## ---------- check arguments
  
  if (!missing(Qobs)) {
    if (missing(Obs)) {
      if (warnings) {
        warning("argument 'Qobs' is deprecated. Please use 'Obs' and 'VarObs' instead")
      }
      Obs <- Qobs
      # VarObs <- "Qobs"
    } else {
      warning("argument 'Qobs' is deprecated. The values set in 'Obs' will be used instead")
    }
  }
  if (!missing(Ind_zeroes) & warnings) {
    warning("deprecated 'Ind_zeroes' argument")
  }
  if (!missing(verbose)) {
    warning("deprecated 'verbose' argument. Use 'warnings', instead")
  }
  
  
  ## check 'InputsModel'
  if (!inherits(InputsModel, "InputsModel")) {
    stop("'InputsModel' must be of class 'InputsModel'")
  }
  
  
  ## length of index of period to be used for the model run
  LLL <- length(InputsModel$DatesR[RunOptions$IndPeriod_Run])
  
  
  ## check 'Obs' and definition of idLayer
  vecObs <- unlist(Obs)
  if (length(vecObs) %% LLL != 0 | !is.numeric(vecObs)) {
    stop(sprintf("'Obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE)
  }
  if (!is.list(Obs)) {
    idLayer <- list(1L)
    Obs <- list(Obs)
  } else {
    idLayer <- lapply(Obs, function(i) {
        if (is.list(i)) {
          length(i)
        } else {
          1L
        }
      })
    Obs <- lapply(Obs, function(x) rowMeans(as.data.frame(x)))
  }

  
  ## create list of arguments