UtilsErrorCrit.R

## =================================================================================
## function to manage inputs of specific ErrorCrit_*() functions
## =================================================================================

.ErrorCrit <- function(InputsCrit, Crit, OutputsModel, warnings) {

  ## Arguments check
  if (!inherits(InputsCrit, "InputsCrit")) {
    stop("'InputsCrit' must be of class 'InputsCrit'", call. = FALSE)
  }
  if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) {
    if (Crit == "RMSE") {
      stop("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' with RMSE", call. = FALSE)
    } else {
      stop(paste0("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' or 'Compo' with ", Crit), call. = FALSE)
    }
  }


  ## Initialisation
  CritName <- NA
  CritVar  <- InputsCrit$VarObs
  if (InputsCrit$transfo == "") {
    CritName <- paste0(Crit, "[CritVar]")
  }
  if (InputsCrit$transfo %in% c("sqrt", "log", "sort", "boxcox")) {
    CritName <- paste0(Crit, "[", InputsCrit$transfo, "(CritVar)]")
  }
  if (InputsCrit$transfo == "inv") {
    CritName <- paste0(Crit, "[1/CritVar]")
  }
  if (grepl("\\^", InputsCrit$transfo)) {
    transfoPow <- suppressWarnings(as.numeric(gsub("\\^", "", InputsCrit$transfo)))
    CritName <- paste0(Crit, "[CritVar^", transfoPow, "]")
  }
  CritName  <- gsub(pattern = "CritVar", replacement = CritVar, x = CritName)
  CritValue <- NA
  if (Crit %in% c("RMSE")) {
    CritBestValue <- +1
    Multiplier    <- +1
  }
  if (Crit %in% c("NSE", "KGE", "KGE2")) {
    CritBestValue <- +1
    Multiplier    <- -1
  }


  ## Data preparation
  VarObs <- InputsCrit$Obs
  VarObs[!InputsCrit$BoolCrit] <- NA
  if (InputsCrit$VarObs == "Q") {
    VarSim <- OutputsModel$Qsim
  }
  if (InputsCrit$VarObs == "SCA") {
    VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio"))
  }
  if (InputsCrit$VarObs == "SWE") {
    VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack"))
  }
  VarSim[!InputsCrit$BoolCrit] <- NA


  ## Data transformation
  if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) {
    if (any(VarObs %in% 0)) {
      warning("zeroes detected in 'Qobs': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
    }
    if (any(VarSim %in% 0)) {
      warning("zeroes detected in 'Qsim': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
    }