UtilsCalibOptions.R

.FunTransfo <- function(FeatFUN_MOD) {

  IsHyst <- FeatFUN_MOD$IsHyst
  IsSD <- FeatFUN_MOD$IsSD

  ## set FUN_GR
  if (FeatFUN_MOD$NameFunMod == "Cemaneige") {
    if (IsHyst) {
      FUN_GR <- TransfoParam_CemaNeigeHyst
    } else {
      FUN_GR <- TransfoParam_CemaNeige
    }
  } else {
    # fatal error if the TransfoParam function does not exist
    FUN_GR <- match.fun(sprintf("TransfoParam_%s", FeatFUN_MOD$CodeModHydro))
  }

  ## set FUN_SNOW
  if ("CemaNeige" %in% FeatFUN_MOD$Class) {
    if (IsHyst) {
      FUN_SNOW <- TransfoParam_CemaNeigeHyst
    } else {
      FUN_SNOW <- TransfoParam_CemaNeige
    }
  }

  ## set FUN_LAG
  if (IsSD) {
    FUN_LAG <- TransfoParam_Lag
  }

    ## set FUN_TRANSFO
  if (! "CemaNeige" %in% FeatFUN_MOD$Class) {
    if (!IsSD) {
      FUN_TRANSFO <- FUN_GR
    } else {
      FUN_TRANSFO <- function(ParamIn, Direction) {
        Bool <- is.matrix(ParamIn)
        if (!Bool) {
          ParamIn <- rbind(ParamIn)
        }
        ParamOut <- NA * ParamIn
        NParam   <- ncol(ParamIn)
        ParamOut[, 2:NParam] <- FUN_GR(ParamIn[, 2:NParam], Direction)
        ParamOut[, 1       ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
        if (!Bool) {
          ParamOut <- ParamOut[1, ]
        }
        return(ParamOut)
      }
    }
  } else {
    if (IsHyst & !IsSD) {
      FUN_TRANSFO <- function(ParamIn, Direction) {
        Bool <- is.matrix(ParamIn)
        if (!Bool) {
          ParamIn <- rbind(ParamIn)
        }
        ParamOut <- NA * ParamIn
        NParam   <- ncol(ParamIn)
        ParamOut[, 1:(NParam - 4)     ] <- FUN_GR(ParamIn[, 1:(NParam - 4)], Direction)
        ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction)
        if (!Bool) {
          ParamOut <- ParamOut[1, ]
        }
        return(ParamOut)
      }
    }
    if (!IsHyst & !IsSD) {
      FUN_TRANSFO <- function(ParamIn, Direction) {