CreateInputsCrit.R

CreateInputsCrit <- function(FUN_CRIT,
                             InputsModel,
                             RunOptions,
                             Qobs,
                             obs,
                             varObs = "Q",
                             BoolCrit = NULL,
                             transfo = "",
                             # groupLayer,
                             weights = NULL,
                             Ind_zeroes = NULL,
                             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' \n")
    return(NULL)
  }
  
  
  ## length of index of period to be used for the model run
  LLL <- length(InputsModel$DatesR[RunOptions$IndPeriod_Run])
  
  
  ## check 'obs'
  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 \n", LLL), call. = FALSE)
  }
  if (!is.list(obs)) {
    obs <- list(obs)
  } else {
    obs <- lapply(obs, function(x) rowMeans(as.data.frame(x)))
  }
  
  
  ## create list of arguments
  listArgs <- list(FUN_CRIT   = FUN_CRIT,
                   obs        = obs,
                   varObs     = varObs,
                   BoolCrit   = BoolCrit,
                   transfo    = transfo,
                   # groupLayer = groupLayer,
                   weights    = weights,