Commit 16a9ca4f authored by unknown's avatar unknown
Browse files

v1.0.5.14 function CreateInputsCrit() cleaned

Showing with 118 additions and 50 deletions
+118 -50
Package: airGR Package: airGR
Type: Package Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.0.5.13 Version: 1.0.5.14
Date: 2017-01-23 Date: 2017-01-23
Authors@R: c( Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl")), person("Laurent", "Coron", role = c("aut", "trl")),
......
CreateInputsCrit <- function(FUN_CRIT,InputsModel,RunOptions,Qobs,BoolCrit=NULL,transfo="",Ind_zeroes=NULL,epsilon=NULL){ CreateInputsCrit <-
function(FUN_CRIT,
ObjectClass <- NULL; InputsModel,
RunOptions,
##check_FUN_CRIT Qobs,
BOOL <- FALSE; BoolCrit = NULL,
if(identical(FUN_CRIT,ErrorCrit_NSE) | identical(FUN_CRIT,ErrorCrit_KGE) | identical(FUN_CRIT,ErrorCrit_KGE2) | transfo = "",
identical(FUN_CRIT,ErrorCrit_RMSE)){ Ind_zeroes = NULL,
BOOL <- TRUE; } epsilon = NULL) {
if(!BOOL){ stop("incorrect FUN_CRIT for use in CreateInputsCrit \n"); return(NULL); } ObjectClass <- NULL
##check_arguments
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n" ); return(NULL); } ##check_FUN_CRIT
if(inherits(RunOptions ,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' \n" ); return(NULL); } BOOL <- FALSE
if (identical(FUN_CRIT, ErrorCrit_NSE) | identical(FUN_CRIT, ErrorCrit_KGE) |
identical(FUN_CRIT, ErrorCrit_KGE2) | identical(FUN_CRIT, ErrorCrit_RMSE)) {
BOOL <- TRUE
}
if (!BOOL) {
stop("incorrect FUN_CRIT for use in CreateInputsCrit \n")
return(NULL)
}
##check_arguments
if (inherits(InputsModel, "InputsModel") == FALSE) {
stop("InputsModel must be of class 'InputsModel' \n")
return(NULL)
}
if (inherits(RunOptions , "RunOptions") == FALSE) {
stop("RunOptions must be of class 'RunOptions' \n")
return(NULL)
}
LLL <- length(InputsModel$DatesR[RunOptions$IndPeriod_Run]) LLL <- length(InputsModel$DatesR[RunOptions$IndPeriod_Run])
if(is.null(Qobs) ){ stop("Qobs is missing \n"); return(NULL); } if (is.null(Qobs)) {
if(!is.vector( Qobs)){ stop(paste("Qobs must be a vector of numeric values \n",sep="")); return(NULL); } stop("Qobs is missing \n")
if(!is.numeric(Qobs)){ stop(paste("Qobs must be a vector of numeric values \n",sep="")); return(NULL); } return(NULL)
if(length(Qobs)!=LLL){ stop("Qobs and InputsModel series must have the same length \n"); return(NULL); } }
if (!is.vector(Qobs)) {
if(is.null(BoolCrit)){ BoolCrit <- rep(TRUE,length(Qobs)); } stop(paste("Qobs must be a vector of numeric values \n", sep = ""))
if(!is.logical(BoolCrit)){ stop("BoolCrit must be a vector of boolean \n" ); return(NULL); } return(NULL)
if(length(BoolCrit)!=LLL){ stop("BoolCrit and InputsModel series must have the same length \n"); return(NULL); } }
if (!is.numeric(Qobs)) {
if(is.null(transfo) ){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n"); return(NULL); } stop(paste("Qobs must be a vector of numeric values \n", sep = ""))
if(!is.vector(transfo )){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n"); return(NULL); } return(NULL)
if(length(transfo)!=1 ){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n"); return(NULL); } }
if(!is.character(transfo)){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n"); return(NULL); } if (length(Qobs) != LLL) {
if(transfo %in% c("","sqrt","log","inv","sort") == FALSE){ stop("Qobs and InputsModel series must have the same length \n")
stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n"); return(NULL); } return(NULL)
}
if(!is.null(Ind_zeroes)){ if (is.null(BoolCrit)) {
if(!is.vector( Ind_zeroes)){ stop("Ind_zeroes must be a vector of integers \n" ); return(NULL); } BoolCrit <- rep(TRUE, length(Qobs))
if(!is.integer(Ind_zeroes)){ stop("Ind_zeroes must be a vector of integers \n" ); return(NULL); } }
} if (!is.logical(BoolCrit)) {
if(!is.null(epsilon)){ stop("BoolCrit must be a vector of boolean \n")
if(!is.vector( epsilon) | length(epsilon)!=1 | !is.numeric(epsilon)){ return(NULL)
stop("epsilon must be single numeric value \n" ); return(NULL); } }
epsilon=as.double(epsilon); if (length(BoolCrit) != LLL) {
} stop("BoolCrit and InputsModel series must have the same length \n")
return(NULL)
##Create_InputsCrit }
InputsCrit <- list(BoolCrit=BoolCrit,Qobs=Qobs,transfo=transfo,Ind_zeroes=Ind_zeroes,epsilon=epsilon); if (is.null(transfo)) {
class(InputsCrit) <- c("InputsCrit",ObjectClass); stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n")
return(InputsCrit); return(NULL)
}
if (!is.vector(transfo)) {
} stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n")
return(NULL)
}
if (length(transfo) != 1) {
stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n")
return(NULL)
}
if (!is.character(transfo)) {
stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n")
return(NULL)
}
if (transfo %in% c("", "sqrt", "log", "inv", "sort") == FALSE) {
stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n")
return(NULL)
}
if (!is.null(Ind_zeroes)) {
if (!is.vector(Ind_zeroes)) {
stop("Ind_zeroes must be a vector of integers \n")
return(NULL)
}
if (!is.integer(Ind_zeroes)) {
stop("Ind_zeroes must be a vector of integers \n")
return(NULL)
}
}
if (!is.null(epsilon)) {
if (!is.vector(epsilon) |
length(epsilon) != 1 | !is.numeric(epsilon)) {
stop("epsilon must be single numeric value \n")
return(NULL)
}
epsilon = as.double(epsilon)
}
##Create_InputsCrit
InputsCrit <- list(BoolCrit = BoolCrit,
Qobs = Qobs,
transfo = transfo,
Ind_zeroes = Ind_zeroes,
epsilon = epsilon)
class(InputsCrit) <- c("InputsCrit", ObjectClass)
return(InputsCrit)
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment