Failed to fetch fork details. Try again later.
-
Delaigue Olivier authored21bc95cc
Forked from
HYCAR-Hydro / airGR
Source project has a limited visibility.
#*************************************************************************************************
#' Creation of the InputsCrit object required to the ErrorCrit functions.
#'
#' Users wanting to use FUN_CRIT functions that are not included in
#' the package must create their own InputsCrit object accordingly.
#*************************************************************************************************
#' @title Creation of the InputsCrit object required to the ErrorCrit functions
#' @author Laurent Coron (June 2014)
#' @seealso \code{\link{RunModel}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateCalibOptions}}
#' @example tests/example_ErrorCrit.R
#' @encoding UTF-8
#' @export
#_FunctionInputs__________________________________________________________________________________
#' @param FUN_CRIT [function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE)
#' @param InputsModel [object of class \emph{InputsModel}] see \code{\link{CreateInputsModel}} for details
#' @param RunOptions [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details
#' @param Qobs [numeric] series of observed discharges [mm]
#' @param BoolCrit (optional) [boolean] boolean giving the time steps to consider in the computation (all time steps are consider by default)
#' @param transfo (optional) [character] name of the transformation (e.g. "", "sqrt", "log", "inv", "sort")
#' @param Ind_zeroes (optional) [numeric] indices of the time-steps where zeroes are observed
#' @param epsilon (optional) [numeric] epsilon to add to all Qobs and Qsim if \emph{$Ind_zeroes} is not empty
#_FunctionOutputs_________________________________________________________________________________
#' @return [list] object of class \emph{InputsCrit} containing the data required to evaluate the model outputs; it can include the following:
#' \tabular{ll}{
#' \emph{$BoolCrit } \tab [boolean] boolean giving the time steps to consider in the computation \cr
#' \emph{$Qobs } \tab [numeric] series of observed discharges [mm] \cr
#' \emph{$transfo } \tab [character] name of the transformation (e.g. "", "sqrt", "log", "inv", "sort") \cr
#' \emph{$Ind_zeroes} \tab [numeric] indices of the time-steps where zeroes are observed \cr
#' \emph{$epsilon } \tab [numeric] epsilon to add to all Qobs and Qsim if \emph{$Ind_zeroes} is not empty \cr
#' }
#**************************************************************************************************
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' \n"); return(NULL); }
if(!is.vector(transfo )){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \n"); return(NULL); }
if(length(transfo)!=1 ){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \n"); return(NULL); }
if(!is.character(transfo)){ stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \n"); return(NULL); }
if(transfo %in% c("","sqrt","log","inv") == FALSE){
stop("transfo must be a chosen among the following: '', 'sqrt', 'log' or 'inv' \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); }
717273747576777879808182
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);
}