From 16a9ca4f2d92440eefc20915d90334b744dd0f02 Mon Sep 17 00:00:00 2001
From: unknown <olivier.delaigue@ANPI1430.antony.irstea.priv>
Date: Thu, 16 Feb 2017 15:06:18 +0100
Subject: [PATCH] v1.0.5.14 function CreateInputsCrit() cleaned
---
DESCRIPTION | 2 +-
R/CreateInputsCrit.R | 166 ++++++++++++++++++++++++++++++-------------
2 files changed, 118 insertions(+), 50 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index fbee2ad9..1b4a5685 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.0.5.13
+Version: 1.0.5.14
Date: 2017-01-23
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl")),
diff --git a/R/CreateInputsCrit.R b/R/CreateInputsCrit.R
index a825f20e..a2f03b76 100644
--- a/R/CreateInputsCrit.R
+++ b/R/CreateInputsCrit.R
@@ -1,50 +1,118 @@
-CreateInputsCrit <- function(FUN_CRIT,InputsModel,RunOptions,Qobs,BoolCrit=NULL,transfo="",Ind_zeroes=NULL,epsilon=NULL){
-
- ObjectClass <- NULL;
-
- ##check_FUN_CRIT
- 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); }
+CreateInputsCrit <-
+ function(FUN_CRIT,
+ InputsModel,
+ RunOptions,
+ Qobs,
+ BoolCrit = NULL,
+ transfo = "",
+ Ind_zeroes = NULL,
+ epsilon = NULL) {
+ ObjectClass <- NULL
+
+
+ ##check_FUN_CRIT
+ 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])
-
- if(is.null(Qobs) ){ stop("Qobs is missing \n"); return(NULL); }
- if(!is.vector( Qobs)){ stop(paste("Qobs must be a vector of numeric values \n",sep="")); return(NULL); }
- if(!is.numeric(Qobs)){ stop(paste("Qobs must be a vector of numeric values \n",sep="")); return(NULL); }
- if(length(Qobs)!=LLL){ stop("Qobs and InputsModel series must have the same length \n"); return(NULL); }
-
- if(is.null(BoolCrit)){ BoolCrit <- rep(TRUE,length(Qobs)); }
- if(!is.logical(BoolCrit)){ stop("BoolCrit must be a vector of boolean \n" ); return(NULL); }
- if(length(BoolCrit)!=LLL){ stop("BoolCrit and InputsModel series must have the same length \n"); return(NULL); }
-
- if(is.null(transfo) ){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n"); 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);
-
-
-}
-
+
+ if (is.null(Qobs)) {
+ stop("Qobs is missing \n")
+ return(NULL)
+ }
+ if (!is.vector(Qobs)) {
+ stop(paste("Qobs must be a vector of numeric values \n", sep = ""))
+ return(NULL)
+ }
+ if (!is.numeric(Qobs)) {
+ stop(paste("Qobs must be a vector of numeric values \n", sep = ""))
+ return(NULL)
+ }
+ if (length(Qobs) != LLL) {
+ stop("Qobs and InputsModel series must have the same length \n")
+ return(NULL)
+ }
+ if (is.null(BoolCrit)) {
+ BoolCrit <- rep(TRUE, length(Qobs))
+ }
+ if (!is.logical(BoolCrit)) {
+ stop("BoolCrit must be a vector of boolean \n")
+ return(NULL)
+ }
+ if (length(BoolCrit) != LLL) {
+ stop("BoolCrit and InputsModel series must have the same length \n")
+ return(NULL)
+ }
+ if (is.null(transfo)) {
+ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' or 'sort' \n")
+ 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)
+
+
+
+ }
--
GitLab