Forked from HYCAR-Hydro / airGR
Source project has a limited visibility.
CreateInputsCrit.R 5.37 KiB
#*************************************************************************************************
#' 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); }