refactor(CreateCalibOptions): separate creation of FUN_CRIT + clean the code

Refs #111

R/CreateCalibOptions.R

@@ -21,67 +21,15 @@ CreateCalibOptions <- function(FUN_MOD,
   if (!is.logical(IsSD) | length(IsSD) != 1L) {
     stop("'IsSD' must be a logical of length 1")
   }
+
   ## check FUN_MOD
-  BOOL <- FALSE
+  FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD)
+  FeatFUN_MOD$IsHyst <- IsHyst
+  FeatFUN_MOD$IsSD <- IsSD
+  ObjectClass <- FeatFUN_MOD$Class
 
-  if (identical(FUN_MOD, RunModel_GR4H)) {
-    ObjectClass <- c(ObjectClass, "GR4H")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_GR5H)) {
-    ObjectClass <- c(ObjectClass, "GR5H")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_GR4J)) {
-    ObjectClass <- c(ObjectClass, "GR4J")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_GR5J)) {
-    ObjectClass <- c(ObjectClass, "GR5J")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_GR6J)) {
-    ObjectClass <- c(ObjectClass, "GR6J")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_GR2M)) {
-    ObjectClass <- c(ObjectClass, "GR2M")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_GR1A)) {
-    ObjectClass <- c(ObjectClass, "GR1A")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_CemaNeige)) {
-    ObjectClass <- c(ObjectClass, "CemaNeige")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
-    ObjectClass <- c(ObjectClass, "CemaNeigeGR4H")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
-    ObjectClass <- c(ObjectClass, "CemaNeigeGR5H")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
-    ObjectClass <- c(ObjectClass, "CemaNeigeGR4J")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
-    ObjectClass <- c(ObjectClass, "CemaNeigeGR5J")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
-    ObjectClass <- c(ObjectClass, "CemaNeigeGR6J")
-    BOOL <- TRUE
-  }
-  if (identical(FUN_MOD, RunModel_Lag)) {
-    ObjectClass <- c(ObjectClass, "Lag")
-    if (IsSD) {
+  if (identical(FUN_MOD, RunModel_Lag) && IsSD) {
       stop("RunModel_Lag should not be used with 'isSD=TRUE'")
-    }
-    BOOL <- TRUE
   }
   if (IsHyst) {
     ObjectClass <- c(ObjectClass, "hysteresis")
@@ -89,10 +37,6 @@ CreateCalibOptions <- function(FUN_MOD,
   if (IsSD) {
     ObjectClass <- c(ObjectClass, "SD")
   }
-  if (!BOOL) {
-    stop("incorrect 'FUN_MOD' for use in 'CreateCalibOptions'")
-    return(NULL)
-  }
 
   ## check FUN_CALIB
   BOOL <- FALSE
@@ -109,202 +53,11 @@ CreateCalibOptions <- function(FUN_MOD,
 
   ## check FUN_TRANSFO
   if (is.null(FUN_TRANSFO)) {
-    ## set FUN1
-    if (identical(FUN_MOD, RunModel_GR4H) |
-        identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
-      FUN_GR <- TransfoParam_GR4H
-    }
-    if (identical(FUN_MOD, RunModel_GR5H) |
-        identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
-      FUN_GR <- TransfoParam_GR5H
-    }
-    if (identical(FUN_MOD, RunModel_GR4J) |
-        identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
-      FUN_GR <- TransfoParam_GR4J
-    }
-    if (identical(FUN_MOD, RunModel_GR5J) |
-        identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
-      FUN_GR <- TransfoParam_GR5J
-    }
-    if (identical(FUN_MOD, RunModel_GR6J) |
-        identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
-      FUN_GR <- TransfoParam_GR6J
-    }
-    if (identical(FUN_MOD, RunModel_GR2M)) {
-      FUN_GR <- TransfoParam_GR2M
-    }
-    if (identical(FUN_MOD, RunModel_GR1A)) {
-      FUN_GR <- TransfoParam_GR1A
-    }
-    if (identical(FUN_MOD, RunModel_CemaNeige)) {
-      if (IsHyst) {
-        FUN_GR <- TransfoParam_CemaNeigeHyst
-      } else {
-        FUN_GR <- TransfoParam_CemaNeige
-      }
-    }
-    if (identical(FUN_MOD, RunModel_Lag)) {
-      FUN_GR <- TransfoParam_Lag
-    }
-    if (is.null(FUN_GR)) {
-      stop("'FUN_GR' was not found")
-      return(NULL)
-    }
-    ## set FUN2
-    if (IsHyst) {
-      FUN_SNOW <- TransfoParam_CemaNeigeHyst
-    } else {
-      FUN_SNOW <- TransfoParam_CemaNeige
-    }
-    ## set FUN_LAG
-    if (IsSD) {
-      FUN_LAG <- TransfoParam_Lag
-    }
-    ## set FUN_TRANSFO
-    if (sum(ObjectClass %in% c("GR4H", "GR5H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige", "Lag")) > 0) {
-      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) {
-          Bool <- is.matrix(ParamIn)
-          if (!Bool) {
-            ParamIn <- rbind(ParamIn)
-          }
-          ParamOut <- NA * ParamIn
-          NParam   <- ncol(ParamIn)
-          if (NParam <= 3) {
-            ParamOut[, 1:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 1:(NParam - 2)]), Direction)
-          } else {
-            ParamOut[, 1:(NParam - 2)] <- FUN_GR(ParamIn[, 1:(NParam - 2)], Direction)
-          }
-          ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
-          if (!Bool) {
-            ParamOut <- ParamOut[1, ]
-          }
-          return(ParamOut)
-        }
-      }
-      if (IsHyst & IsSD) {
-        FUN_TRANSFO <- function(ParamIn, Direction) {
-          Bool <- is.matrix(ParamIn)
-          if (!Bool) {
-            ParamIn <- rbind(ParamIn)
-          }
-          ParamOut <- NA * ParamIn
-          NParam   <- ncol(ParamIn)
-          ParamOut[, 2:(NParam - 4)     ] <- FUN_GR(ParamIn[, 2:(NParam - 4)], Direction)
-          ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction)
-          ParamOut[, 1                  ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
-          if (!Bool) {
-            ParamOut <- ParamOut[1, ]
-          }
-          return(ParamOut)
-        }
-      }
-      if (!IsHyst & IsSD) {
-        FUN_TRANSFO <- function(ParamIn, Direction) {
-          Bool <- is.matrix(ParamIn)
-          if (!Bool) {
-            ParamIn <- rbind(ParamIn)
-          }
-          ParamOut <- NA * ParamIn
-          NParam   <- ncol(ParamIn)
-          if (NParam <= 3) {
-            ParamOut[, 2:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 2:(NParam - 2)]), Direction)
-          } else {
-            ParamOut[, 2:(NParam - 2)] <- FUN_GR(ParamIn[, 2:(NParam - 2)],  Direction)
-          }
-          ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
-          ParamOut[, 1                  ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
-          if (!Bool) {
-            ParamOut <- ParamOut[1, ]
-          }
-          return(ParamOut)
-        }
-      }
-    }
-  }
-  if (is.null(FUN_TRANSFO)) {
-    stop("'FUN_TRANSFO' was not found")
-    return(NULL)
+    FUN_TRANSFO <- .FunTransfo(FeatFUN_MOD)
   }
 
   ## NParam
-  if ("GR4H" %in% ObjectClass) {
-    NParam <- 4
-  }
-  if ("GR5H" %in% ObjectClass) {
-    NParam <- 5
-  }
-  if ("GR4J" %in% ObjectClass) {
-    NParam <- 4
-  }
-  if ("GR5J" %in% ObjectClass) {
-    NParam <- 5
-  }
-  if ("GR6J" %in% ObjectClass) {
-    NParam <- 6
-  }
-  if ("GR2M" %in% ObjectClass) {
-    NParam <- 2
-  }
-  if ("GR1A" %in% ObjectClass) {
-    NParam <- 1
-  }
-  if ("CemaNeige" %in% ObjectClass) {
-    NParam <- 2
-  }
-  if ("CemaNeigeGR4H" %in% ObjectClass) {
-    NParam <- 6
-  }
-  if ("CemaNeigeGR5H" %in% ObjectClass) {
-    NParam <- 7
-  }
-  if ("CemaNeigeGR4J" %in% ObjectClass) {
-    NParam <- 6
-  }
-  if ("CemaNeigeGR5J" %in% ObjectClass) {
-    NParam <- 7
-  }
-  if ("CemaNeigeGR6J" %in% ObjectClass) {
-    NParam <- 8
-  }
-  if ("Lag" %in% ObjectClass) {
-    NParam <- 1
-  }
+  NParam <- FeatFUN_MOD$NbParam
 
   if (IsHyst) {
     NParam <- NParam + 2
@@ -357,80 +110,80 @@ CreateCalibOptions <- function(FUN_MOD,
 
   ## check StartParamList and StartParamDistrib default values
   if (("HBAN"  %in% ObjectClass & is.null(StartParamList) & is.null(StartParamDistrib))) {
-    if ("GR4H" %in% ObjectClass) {
+    if ("GR4H" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+5.12, -1.18, +4.34, -9.69,
                          +5.58, -0.85, +4.74, -9.47,
                          +6.01, -0.50, +5.14, -8.87), ncol = 4, byrow = TRUE)
     }
-    if (("GR5H" %in% ObjectClass) & ("interception" %in% ObjectClass)) {
+    if (("GR5H" == FeatFUN_MOD$CodeMod) & ("interception" %in% ObjectClass)) {
       ParamT <- matrix(c(+3.46, -1.25, +4.04, -9.53, -9.34,
                          +3.74, -0.41, +4.78, -8.94, -3.33,
                          +4.29, +0.16, +5.39, -7.39, +3.33), ncol = 5, byrow = TRUE)
     }
-    if (("GR5H" %in% ObjectClass) & !("interception" %in% ObjectClass)) {
+    if (("GR5H" == FeatFUN_MOD$CodeMod) & !("interception" %in% ObjectClass)) {
       ParamT <- matrix(c(+3.28, -0.39, +4.14, -9.54, -7.49,
                          +3.62, -0.19, +4.80, -9.00, -6.31,
                          +4.01, -0.04, +5.43, -7.53, -5.33), ncol = 5, byrow = TRUE)
     }
-    if ("GR4J" %in% ObjectClass) {
+    if ("GR4J" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05,
                          +5.51, -0.61, +3.74, -8.51,
                          +6.07, -0.02, +4.42, -8.06), ncol = 4, byrow = TRUE)
     }
-    if ("GR5J" %in% ObjectClass) {
+    if ("GR5J" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45,
                          +5.55, -0.46, +3.75, -9.09, -4.69,
                          +6.10, -0.11, +4.43, -8.60, -0.66), ncol = 5, byrow = TRUE)
 
     }
-    if ("GR6J" %in% ObjectClass) {
+    if ("GR6J" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00,
                          +3.90, -0.50, +4.10, -8.70, +0.10, +4.00,
                          +4.50, +0.50, +5.00, -8.10, +1.10, +5.00), ncol = 6, byrow = TRUE)
     }
-    if ("GR2M" %in% ObjectClass) {
+    if ("GR2M" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+5.03, -7.15,
                          +5.22, -6.74,
                          +5.85, -6.37), ncol = 2, byrow = TRUE)
     }
-    if ("GR1A" %in% ObjectClass) {
+    if ("GR1A" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(-1.69,
                          -0.38,
                          +1.39), ncol = 1, byrow = TRUE)
     }
 
 
-    if ("CemaNeige" %in% ObjectClass) {
+    if ("CemaNeige" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(-9.96, +6.63,
                          -9.14, +6.90,
                          +4.10, +7.21), ncol = 2, byrow = TRUE)
     }
-    if ("CemaNeigeGR4H" %in% ObjectClass) {
+    if ("CemaNeigeGR4H" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+5.12, -1.18, +4.34, -9.69, -9.96, +6.63,
                          +5.58, -0.85, +4.74, -9.47, -9.14, +6.90,
                          +6.01, -0.50, +5.14, -8.87, +4.10, +7.21), ncol = 6, byrow = TRUE)
     }
-    if (("CemaNeigeGR5H" %in% ObjectClass) & ("interception" %in% ObjectClass)) {
+    if (("CemaNeigeGR5H" == FeatFUN_MOD$CodeMod) & ("interception" %in% ObjectClass)) {
       ParamT <- matrix(c(+3.46, -1.25, +4.04, -9.53, -9.34, -9.96, +6.63,
                          +3.74, -0.41, +4.78, -8.94, -3.33, -9.14, +6.90,
                          +4.29, +0.16, +5.39, -7.39, +3.33, +4.10, +7.21), ncol = 7, byrow = TRUE)
     }
-    if (("CemaNeigeGR5H" %in% ObjectClass) & !("interception" %in% ObjectClass)) {
+    if (("CemaNeigeGR5H" == FeatFUN_MOD$CodeMod) & !("interception" %in% ObjectClass)) {
       ParamT <- matrix(c(+3.28, -0.39, +4.14, -9.54, -7.49, -9.96, +6.63,
                          +3.62, -0.19, +4.80, -9.00, -6.31, -9.14, +6.90,
                          +4.01, -0.04, +5.43, -7.53, -5.33, +4.10, +7.21), ncol = 7, byrow = TRUE)
     }
-    if ("CemaNeigeGR4J" %in% ObjectClass) {
+    if ("CemaNeigeGR4J" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63,
                          +5.51, -0.61, +3.74, -8.51, -9.14, +6.90,
                          +6.07, -0.02, +4.42, -8.06, +4.10, +7.21), ncol = 6, byrow = TRUE)
     }
-    if ("CemaNeigeGR5J" %in% ObjectClass) {
+    if ("CemaNeigeGR5J" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+5.17, -1.13, +3.08, -9.37, -7.45, -9.96, +6.63,
                          +5.55, -0.46, +3.75, -9.09, -4.69, -9.14, +6.90,
                          +6.10, -0.11, +4.43, -8.60, -0.66, +4.10, +7.21), ncol = 7, byrow = TRUE)
     }
-    if ("CemaNeigeGR6J" %in% ObjectClass) {
+    if ("CemaNeigeGR6J" == FeatFUN_MOD$CodeMod) {
       ParamT <- matrix(c(+3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -9.96, +6.63,
                          +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -9.14, +6.90,
                          +4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.10, +7.21), ncol = 8, byrow = TRUE)

R/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) {
+        Bool <- is.matrix(ParamIn)
+        if (!Bool) {
+          ParamIn <- rbind(ParamIn)
+        }
+        ParamOut <- NA * ParamIn
+        NParam   <- ncol(ParamIn)
+        if (NParam <= 3) {
+          ParamOut[, 1:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 1:(NParam - 2)]), Direction)
+        } else {
+          ParamOut[, 1:(NParam - 2)] <- FUN_GR(ParamIn[, 1:(NParam - 2)], Direction)
+        }
+        ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
+        if (!Bool) {
+          ParamOut <- ParamOut[1, ]
+        }
+        return(ParamOut)
+      }
+    }
+    if (IsHyst & IsSD) {
+      FUN_TRANSFO <- function(ParamIn, Direction) {
+        Bool <- is.matrix(ParamIn)
+        if (!Bool) {
+          ParamIn <- rbind(ParamIn)
+        }
+        ParamOut <- NA * ParamIn
+        NParam   <- ncol(ParamIn)
+        ParamOut[, 2:(NParam - 4)     ] <- FUN_GR(ParamIn[, 2:(NParam - 4)], Direction)
+        ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction)
+        ParamOut[, 1                  ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
+        if (!Bool) {
+          ParamOut <- ParamOut[1, ]
+        }
+        return(ParamOut)
+      }
+    }
+    if (!IsHyst & IsSD) {
+      FUN_TRANSFO <- function(ParamIn, Direction) {
+        Bool <- is.matrix(ParamIn)
+        if (!Bool) {
+          ParamIn <- rbind(ParamIn)
+        }
+        ParamOut <- NA * ParamIn
+        NParam   <- ncol(ParamIn)
+        if (NParam <= 3) {
+          ParamOut[, 2:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 2:(NParam - 2)]), Direction)
+        } else {
+          ParamOut[, 2:(NParam - 2)] <- FUN_GR(ParamIn[, 2:(NParam - 2)],  Direction)
+        }
+        ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
+        ParamOut[, 1                  ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
+        if (!Bool) {
+          ParamOut <- ParamOut[1, ]
+        }
+        return(ParamOut)
+      }
+    }
+  }
+  if (is.null(FUN_TRANSFO)) {
+    stop("'FUN_TRANSFO' was not found")
+  }
+  return(FUN_TRANSFO)
+}