An error occurred while loading the file. Please try again.
-
Delaigue Olivier authored0fc1747e
CreateCalibOptions <- function(FUN_MOD, FUN_CALIB = Calibration_Michel, FUN_TRANSFO = NULL, FixedParam = NULL, SearchRanges = NULL, StartParamList = NULL, StartParamDistrib = NULL) { ObjectClass <- NULL ##check_FUN_MOD BOOL <- FALSE if (identical(FUN_MOD, RunModel_GR4H)) { ObjectClass <- c(ObjectClass, "GR4H") 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_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 (!BOOL) { stop("incorrect FUN_MOD for use in CreateCalibOptions \n") return(NULL) } ##check_FUN_CALIB BOOL <- FALSE if (identical(FUN_CALIB, Calibration_Michel)) { ObjectClass <- c(ObjectClass, "HBAN") BOOL <- TRUE } if (!BOOL) { stop("incorrect FUN_CALIB for use in CreateCalibOptions \n") return(NULL)7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
}
##check_FUN_TRANSFO
if (is.null(FUN_TRANSFO)) {
##_set_FUN1
if (identical(FUN_MOD, RunModel_GR4H)) {
FUN1 <- TransfoParam_GR4H
}
if (identical(FUN_MOD, RunModel_GR4J) |
identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
FUN1 <- TransfoParam_GR4J
}
if (identical(FUN_MOD, RunModel_GR5J) |
identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
FUN1 <- TransfoParam_GR5J
}
if (identical(FUN_MOD, RunModel_GR6J) |
identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
FUN1 <- TransfoParam_GR6J
}
if (identical(FUN_MOD, RunModel_GR2M)) {
FUN1 <- TransfoParam_GR2M
}
if (identical(FUN_MOD, RunModel_GR1A)) {
FUN1 <- TransfoParam_GR1A
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
FUN1 <- TransfoParam_CemaNeige
}
if (is.null(FUN1)) {
stop("FUN1 was not found \n")
return(NULL)
}
##_set_FUN2
FUN2 <- TransfoParam_CemaNeige
##_set_FUN_TRANSFO
if (sum(ObjectClass %in% c("GR4H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige")) > 0) {
FUN_TRANSFO <- FUN1
} else {
FUN_TRANSFO <- function(ParamIn, Direction) {
Bool <- is.matrix(ParamIn)
if (Bool == FALSE) {
ParamIn <- rbind(ParamIn)
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
if (NParam <= 3) {
ParamOut[, 1:(NParam - 2)] <- FUN1(cbind(ParamIn[, 1:(NParam - 2)]), Direction)
} else {
ParamOut[, 1:(NParam - 2)] <- FUN1(ParamIn[, 1:(NParam - 2)], Direction)
}
ParamOut[, (NParam - 1):NParam] <- FUN2(ParamIn[, (NParam - 1):NParam], Direction)
if (Bool == FALSE) {
ParamOut <- ParamOut[1, ]
}
return(ParamOut)
}
}
}
if (is.null(FUN_TRANSFO)) {
stop("FUN_TRANSFO was not found \n")
return(NULL)
}
##NParam
if ("GR4H" %in% ObjectClass) {
NParam <- 4
}
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
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 ("CemaNeigeGR4J" %in% ObjectClass) {
NParam <- 6
}
if ("CemaNeigeGR5J" %in% ObjectClass) {
NParam <- 7
}
if ("CemaNeigeGR6J" %in% ObjectClass) {
NParam <- 8
}
##check_FixedParam
if (is.null(FixedParam)) {
FixedParam <- rep(NA, NParam)
} else {
if (!is.vector(FixedParam)) {
stop("FixedParam must be a vector \n")
return(NULL)
}
if (length(FixedParam) != NParam) {
stop("Incompatibility between FixedParam length and FUN_MOD \n")
return(NULL)
}
if (all(!is.na(FixedParam))) {
stop("At least one parameter must be not set (NA) \n")
return(NULL)
}
if (all(is.na(FixedParam))) {
warning("You have not set any parameter in \"FixedParam\" \n")
}
}
##check_SearchRanges
if (is.null(SearchRanges)) {
ParamT <- matrix(c(rep(-9.99, NParam), rep(+9.99, NParam)),
ncol = NParam, byrow = TRUE)
SearchRanges <- TransfoParam(ParamIn = ParamT, Direction = "TR", FUN_TRANSFO = FUN_TRANSFO)
} else {
if (!is.matrix(SearchRanges)) {
stop("SearchRanges must be a matrix \n")
return(NULL)
}
if (!is.numeric(SearchRanges)) {
stop("SearchRanges must be a matrix of numeric values \n")
return(NULL)
}
if (sum(is.na(SearchRanges)) != 0) {
stop("SearchRanges must not include NA values \n")
return(NULL)
}
if (nrow(SearchRanges) != 2) {