[0.7.4] Dépot

Signed-off-by: Olivier Delaigue <olivier.delaigue@irstea.fr>

.Rbuildignore

+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

+.Rproj.user
+.Rhistory
+.RData
+src/*.o
+src/*.so
+src/*.dll

DESCRIPTION

+Package: airGR
+Type: Package
+Title: Modelling tools used at Irstea-HBAN (France), including GR4J,
+        GR5J, GR6J and CemaNeige
+Version: 0.7.4
+Date: 2014-11-01
+Author: Laurent CORON
+Maintainer: Laurent CORON <laurent.coron@irstea.fr>, Olivier DELAIGUE
+        <olivier.delaigue@irstea.fr>
+Depends: R (>= 3.0.1)
+Description: This package brings into R the hydrological modelling tools used
+    at Irstea-HBAN (France). The package includes several conceptual
+    rainfall-runoff models and the associated functions for their calibration
+    and evaluation,including GR4J, GR5J, GR6J and CemaNeige. Use help(airGR)
+    for package description.
+License: GPL-2
+Packaged: 2014-11-25 21:51:31 UTC; H61970

NAMESPACE

+# Generated by roxygen2 (4.0.1): do not edit by hand
+
+export(Calibration)
+export(Calibration_HBAN)
+export(Calibration_optim)
+export(CreateCalibOptions)
+export(CreateInputsCrit)
+export(CreateInputsModel)
+export(CreateRunOptions)
+export(DataAltiExtrapolation_HBAN)
+export(ErrorCrit)
+export(ErrorCrit_KGE)
+export(ErrorCrit_KGE2)
+export(ErrorCrit_NSE)
+export(ErrorCrit_RMSE)
+export(PEdaily_Oudin)
+export(RunModel)
+export(RunModel_CemaNeige)
+export(RunModel_CemaNeigeGR4J)
+export(RunModel_CemaNeigeGR5J)
+export(RunModel_CemaNeigeGR6J)
+export(RunModel_GR4J)
+export(RunModel_GR5J)
+export(RunModel_GR6J)
+export(TransfoParam)
+export(TransfoParam_CemaNeige)
+export(TransfoParam_GR4J)
+export(TransfoParam_GR5J)
+export(TransfoParam_GR6J)
+export(plot_OutputsModel)
+useDynLib(airgr)

R/BasinData.R

+#' @name BasinInfo
+#' @docType data
+#' @title Data sample: characteristics of a fictional catchment (L0123001, L0123002 or L0123003)
+#' @description
+#' R-object containing the code, station's name, area and hypsometric curve of the catchment.
+#' @encoding UTF-8
+#' @format
+#' List named 'BasinInfo' containing
+#' \itemize{
+#' \item two strings: catchment's code and station's name
+#' \item one float: catchment's area in km2
+#' \item one numeric vector: catchment's hypsometric curve (min, quantiles 01 to 99 and max) in metres
+#' }
+#' @examples 
+#'    require(airGR)
+#'    data(L0123001)
+#'    str(BasinInfo)
+
+NULL
+
+
+#' @name BasinObs
+#' @docType data
+#' @title Data sample: time series of observations of a fictional catchment (L0123001, L0123002 or L0123003)
+#' @description
+#' R-object containing the times series of precipitation, temperature, potential evapotranspiration and discharges. \cr
+#' Times series for L0123001 or L0123002 are at the daily time-step for use with daily models such as GR4J, GR5J, GR6J, CemaNeigeGR4J, CemaNeigeGR5J and CemaNeigeGR6J.
+#' Times series for L0123003 are at the hourly time-step for use with hourly models such as GR4H.
+#' @encoding UTF-8
+#' @format
+#' Data frame named 'BasinObs' containing
+#' \itemize{
+#' \item one POSIXlt vector: time series dates in the POSIXlt format
+#' \item five numeric vectors: time series of catchment average precipitation [mm], catchment average air temperature [degC], catchment average potential evapotranspiration [mm], outlet discharge [l/s], outlet discharge [mm]
+#' }
+#' @examples 
+#'    require(airGR)
+#'    data(L0123001)
+#'    str(BasinObs)
+
+NULL
+

R/Calibration.R

+#*************************************************************************************************
+#' Calibration algorithm which minimises the error criterion using the provided functions. \cr
+#*************************************************************************************************
+#' @title  Calibration algorithm which minimises an error criterion on the model outputs using the provided functions
+#' @author Laurent Coron (June 2014)
+#' @seealso \code{\link{Calibration_HBAN}}, \code{\link{Calibration_optim}},
+#'          \code{\link{RunModel}}, \code{\link{ErrorCrit}}, \code{\link{TransfoParam}},
+#'          \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, 
+#'          \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}.
+#' @example tests/example_Calibration.R
+#' @export
+#' @encoding UTF-8
+#_FunctionInputs__________________________________________________________________________________
+#' @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  InputsCrit          [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details
+#' @param  CalibOptions        [object of class \emph{CalibOptions}] see \code{\link{CreateCalibOptions}} for details
+#' @param  FUN_MOD             [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)
+#' @param  FUN_CRIT            [function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE)
+#' @param  FUN_CALIB           (optional) [function] calibration algorithm function (e.g. Calibration_HBAN, Calibration_optim), default=Calibration_HBAN
+#' @param  FUN_TRANSFO         (optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined
+#' @param  quiet               (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE
+#_FunctionOutputs_________________________________________________________________________________
+#' @return  [list] see \code{\link{Calibration_HBAN}} or \code{\link{Calibration_optim}} 
+#**************************************************************************************************
+Calibration <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_CALIB=Calibration_HBAN,FUN_TRANSFO=NULL,quiet=FALSE){
+    return( FUN_CALIB(InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO,quiet=quiet) )
+}
+

R/Calibration_optim.R

+#*************************************************************************************************
+#' Calibration algorithm which minimises the error criterion. \cr
+#' \cr
+#' The algorithm is based on the "optim" function from the "stats" R-package 
+#' (using method="L-BFGS-B", i.e. a local optimization quasi-Newton method).
+#'
+#' To optimise the exploration of the parameter space, transformation functions are used to convert
+#' the model parameters. This is done using the TransfoParam functions.
+#*************************************************************************************************
+#' @title  Calibration algorithm which minimises the error criterion using the stats::optim function
+#' @author Laurent Coron (August 2013)
+#' @example tests/example_Calibration_optim.R
+#' @seealso \code{\link{Calibration}}, \code{\link{Calibration_HBAN}},
+#'          \code{\link{RunModel_GR4J}}, \code{\link{TransfoParam_GR4J}}, \code{\link{ErrorCrit_RMSE}},
+#'          \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, 
+#'          \code{\link{CreateInputsCrit}}, \code{\link{CreateCalibOptions}}.
+#' @encoding UTF-8
+#' @export
+#_FunctionInputs__________________________________________________________________________________
+#' @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  InputsCrit          [object of class \emph{InputsCrit}] see \code{\link{CreateInputsCrit}} for details
+#' @param  CalibOptions        [object of class \emph{CalibOptions}] see \code{\link{CreateCalibOptions}} for details
+#' @param  FUN_MOD             [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)
+#' @param  FUN_CRIT            [function] error criterion function (e.g. ErrorCrit_RMSE, ErrorCrit_NSE)
+#' @param  FUN_TRANSFO         (optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined
+#' @param  quiet               (optional) [boolean] boolean indicating if the function is run in quiet mode or not, default=FALSE
+#_FunctionOutputs_________________________________________________________________________________
+#' @return  [list] list containing the function outputs organised as follows:
+#'          \tabular{ll}{
+#'          \emph{$ParamFinalR  }  \tab   [numeric] parameter set obtained at the end of the calibration \cr
+#'          \emph{$CritFinal    }  \tab   [numeric] error criterion obtained at the end of the calibration \cr
+#'          \emph{$Nruns        }  \tab   [numeric] number of model runs done during the calibration \cr
+#'          \emph{$CritName     }  \tab   [character] name of the calibration criterion \cr
+#'          \emph{$CritBestValue}  \tab   [numeric] theoretical best criterion value \cr
+#'          }
+#**************************************************************************************************
+Calibration_optim <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO=NULL,quiet=FALSE){
+    
+
+    ##_check_class
+    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); }  
+    if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); }  
+    if(inherits(CalibOptions,"CalibOptions")==FALSE){ stop("CalibOptions must be of class 'CalibOptions' \n"); return(NULL); }  
+    if(inherits(CalibOptions,"optim")==FALSE){ stop("CalibOptions must be of class 'optim' if Calibration_optim is used \n"); return(NULL); }  
+
+
+    ##_check_FUN_TRANSFO
+    if(is.null(FUN_TRANSFO)){
+      if(identical(FUN_MOD,RunModel_GR4J         )){ FUN_TRANSFO <- TransfoParam_GR4J     ; }
+      if(identical(FUN_MOD,RunModel_GR5J         )){ FUN_TRANSFO <- TransfoParam_GR5J     ; }
+      if(identical(FUN_MOD,RunModel_GR6J         )){ FUN_TRANSFO <- TransfoParam_GR6J     ; }
+      if(identical(FUN_MOD,RunModel_CemaNeige    )){ FUN_TRANSFO <- TransfoParam_CemaNeige; }
+      if(identical(FUN_MOD,RunModel_CemaNeigeGR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)){
+        if(identical(FUN_MOD,RunModel_CemaNeigeGR4J)){ FUN1 <- TransfoParam_GR4J; FUN2 <- TransfoParam_CemaNeige; }
+        if(identical(FUN_MOD,RunModel_CemaNeigeGR5J)){ FUN1 <- TransfoParam_GR5J; FUN2 <- TransfoParam_CemaNeige; }
+        if(identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ FUN1 <- TransfoParam_GR6J; FUN2 <- TransfoParam_CemaNeige; }
+        FUN_TRANSFO <- function(ParamIn,Direction){
+          Bool <- is.matrix(ParamIn);
+          if(Bool==FALSE){ ParamIn <- rbind(ParamIn); }
+          ParamOut <- NA*ParamIn;
+          NParam   <- ncol(ParamIn);
+          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 (in Calibration function) \n"); return(NULL);  }
+    }
+
+
+    ##_RunModelAndCrit
+    RunModelAndCrit <- function(par,InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO){
+        ParamT <- NA*CalibOptions$FixedParam;
+        ParamT[CalibOptions$OptimParam] <- par;
+        Param <- FUN_TRANSFO(ParamIn=ParamT,Direction="TR");
+        Param[!CalibOptions$OptimParam] <- CalibOptions$FixedParam[!CalibOptions$OptimParam];
+        OutputsModel <- FUN_MOD(InputsModel=InputsModel,RunOptions=RunOptions,Param=Param);
+        OutputsCrit <- FUN_CRIT(InputsCrit=InputsCrit,OutputsModel=OutputsModel);   
+        return(OutputsCrit$CritValue*OutputsCrit$Multiplier);
+    }
+
+
+    ##_temporary_change_of_Outputs_Sim
+    RunOptions$Outputs_Sim <- RunOptions$Outputs_Cal;  ### this reduces the size of the matrix exchange with fortran and therefore speeds the calibration
+    ##_screenPrint
+    if(!quiet){ 
+      cat(paste("\t Calibration in progress (function optim from the stats package) \n",sep=""));
+    }
+    
+
+    ##_lower_and_upper_limit_values (transformed)
+    RangesR <- CalibOptions$SearchRanges;
+    RangesT <- FUN_TRANSFO(RangesR,"RT");
+    lower   <- RangesT[1,CalibOptions$OptimParam];
+    upper   <- RangesT[2,CalibOptions$OptimParam];
+
+    ##_starting_values (transformed)
+    ParamStartT <- FUN_TRANSFO(CalibOptions$StartParam,"RT");
+    par_start   <- ParamStartT[CalibOptions$OptimParam]; 
+
+
+    ##_calibration
+    RESULT <- optim(par=par_start,fn=RunModelAndCrit,gr=NULL,
+                InputsModel,RunOptions,InputsCrit,CalibOptions,FUN_MOD,FUN_CRIT,FUN_TRANSFO,  ## arguments for the RunModelAndCrit function (other than par)
+                method="L-BFGS-B",lower=lower,upper=upper,control=list(),hessian=FALSE)
+    
+
+    ##_outputs_preparation
+    ParamFinalT <- NA*ParamStartT;
+    ParamFinalT[CalibOptions$OptimParam] <- RESULT$par;
+    ParamFinalR <- FUN_TRANSFO(ParamFinalT,"TR");
+    ParamFinalR[!CalibOptions$OptimParam] <- CalibOptions$FixedParam[!CalibOptions$OptimParam];  
+    CritFinal <- RESULT$value;
+
+    ##_storage_of_crit_info
+    OutputsModel  <- FUN_MOD(InputsModel=InputsModel,RunOptions=RunOptions,Param=ParamFinalR);
+    OutputsCrit   <- FUN_CRIT(InputsCrit=InputsCrit,OutputsModel=OutputsModel);   
+    CritName      <- OutputsCrit$CritName;
+    CritBestValue <- OutputsCrit$CritBestValue;
+    Multiplier    <- OutputsCrit$Multiplier;
+
+    ##_screenPrint
+    if(!quiet){ 
+      if(RESULT$convergence==0){ 
+        cat(paste("\t Calibration completed: \n",sep=""));
+        cat(paste("\t     Param = ",paste(formatC(ParamFinalR,format="f",width=8,digits=3),collapse=" , "),"\n",sep=""));
+        cat(paste("\t     Crit ",format(CritName,width=12,justify="left")," = ",formatC(CritFinal*Multiplier,format="f",digits=4),"\n",sep=""));
+      } else {
+        cat(paste("\t Calibration failed: \n",sep=""));
+        cat(paste("\t     ",RESULT$message,sep=""));
+      }
+    }
+    
+    
+    ##_function_output
+    OutputsCalib <- list(as.double(ParamFinalR),CritFinal*Multiplier,as.integer(RESULT$counts[1]),CritName,CritBestValue);
+    names(OutputsCalib) <- c("ParamFinalR","CritFinal","NRuns","CritName","CritBestValue");
+    class(OutputsCalib) <- c("OutputsCalib","optim");
+    return(OutputsCalib);
+
+
+}
+
+
+
+

R/CreateCalibOptions.R

+#*************************************************************************************************
+#' Creation of the CalibOptions object required to the Calibration functions.
+#'
+#' Users wanting to use FUN_MOD, FUN_CALIB or FUN_TRANSFO functions that are not included in 
+#' the package must create their own CalibOptions object accordingly.
+#*************************************************************************************************
+#' @title  Creation of the CalibOptions object required to the Calibration functions
+#' @author Laurent Coron (June 2014)
+#' @seealso \code{\link{RunModel}}, \code{\link{CreateInputsModel}}, \code{\link{CreateRunOptions}}, \code{\link{CreateInputsCrit}}
+#' @example tests/example_Calibration.R
+#' @encoding UTF-8
+#' @export
+#_FunctionInputs__________________________________________________________________________________
+#' @param  FUN_MOD             [function] hydrological model function (e.g. RunModel_GR4J, RunModel_CemaNeigeGR4J)
+#' @param  FUN_CALIB           (optional) [function] calibration algorithm function (e.g. Calibration_HBAN, Calibration_optim), default=Calibration_HBAN
+#' @param  FUN_TRANSFO         (optional) [function] model parameters transformation function, if the FUN_MOD used is native in the package FUN_TRANSFO is automatically defined
+#' @param  RunOptions          (optional) [object of class \emph{RunOptions}] see \code{\link{CreateRunOptions}} for details
+#' @param  OptimParam          (optional) [boolean] vector of booleans indicating which parameters must be optimised (NParam columns, 1 line) 
+#' @param  FixedParam          (optional) [numeric] vector giving the values to allocate to non-optimised parameter values (NParam columns, 1 line)
+#' @param  SearchRanges        (optional) [numeric] matrix giving the ranges of real parameters (NParam columns, 2 lines)
+#'                             \tabular{llllll}{
+#'                                           \tab [X1]   \tab [X2]   \tab [X3]   \tab [...]   \tab [Xi] \cr
+#'                                  [1,]     \tab    0   \tab   -1   \tab    0   \tab  ...    \tab  0.0 \cr
+#'                                  [2,]     \tab 3000   \tab   +1   \tab  100   \tab  ...    \tab  3.0 \cr
+#'                             }
+#' @param  StartParam          (optional) [numeric] vector of parameter values used to start global search calibration procedure (e.g. Calibration_optim)
+#'                             \tabular{llllll}{
+#'                                           \tab [X1]   \tab [X2]   \tab [X3]   \tab [...]   \tab [Xi] \cr
+#'                                           \tab 1000   \tab -0.5   \tab   22   \tab  ...    \tab  1.1 \cr
+#'                             }
+#' @param  StartParamList      (optional) [numeric] matrix of parameter sets used for grid-screening calibration procedure (values in columns, sets in line)
+#'                             \tabular{llllll}{
+#'                                           \tab [X1]   \tab [X2]   \tab [X3]   \tab [...]   \tab [Xi] \cr
+#'                                  [set1]   \tab  800   \tab -0.7   \tab   25   \tab  ...    \tab  1.0 \cr
+#'                                  [set2]   \tab 1000   \tab -0.5   \tab   22   \tab  ...    \tab  1.1 \cr
+#'                                  [...]    \tab  ...   \tab  ...   \tab  ...   \tab  ...    \tab  ... \cr
+#'                                  [set n]  \tab  200   \tab -0.3   \tab   17   \tab  ...    \tab  1.0 \cr
+#'                             }
+#' @param  StartParamDistrib   (optional) [numeric] matrix of parameter values used for grid-screening calibration procedure (values in columns, percentiles in line) \cr
+#'                             \tabular{llllll}{
+#'                                           \tab [X1]   \tab [X2]   \tab [X3]   \tab [...]   \tab [Xi] \cr
+#'                                  [value1] \tab  800   \tab -0.7   \tab   25   \tab  ...    \tab  1.0 \cr
+#'                                  [value2] \tab 1000   \tab   NA   \tab   50   \tab  ...    \tab  1.2 \cr
+#'                                  [value3] \tab 1200   \tab   NA   \tab   NA   \tab  ...    \tab  1.6 \cr
+#'                             }
+#_FunctionOutputs_________________________________________________________________________________
+#' @return  [list] object of class \emph{CalibOptions} containing the data required to evaluate the model outputs; it can include the following:
+#'          \tabular{ll}{
+#'          \emph{$OptimParam       }  \tab   [boolean] vector of booleans indicating which parameters must be optimised \cr
+#'          \emph{$FixedParam       }  \tab   [numeric] vector giving the values to allocate to non-optimised parameter values \cr
+#'          \emph{$SearchRanges     }  \tab   [numeric] matrix giving the ranges of real parameters \cr
+#'          \emph{$StartParam       }  \tab   [numeric] vector of parameter values used to start global search calibration procedure \cr
+#'          \emph{$StartParamList   }  \tab   [numeric] matrix of parameter sets used for grid-screening calibration procedure \cr
+#'          \emph{$StartParamDistrib}  \tab   [numeric] matrix of parameter values used for grid-screening calibration procedure \cr
+#'          }
+#**************************************************************************************************'
+CreateCalibOptions <- function(FUN_MOD,FUN_CALIB=Calibration_HBAN,FUN_TRANSFO=NULL,RunOptions=NULL,OptimParam=NULL,FixedParam=NULL,SearchRanges=NULL,
+                               StartParam=NULL,StartParamList=NULL,StartParamDistrib=NULL){
+
+
+  ObjectClass <- NULL;
+
+  ##check_FUN_MOD
+    BOOL <- FALSE;
+    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_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_HBAN )){ ObjectClass <- c(ObjectClass,"HBAN" ); BOOL <- TRUE; }
+    if(identical(FUN_CALIB,Calibration_optim)){ ObjectClass <- c(ObjectClass,"optim"); BOOL <- TRUE; }
+    if(!BOOL){ stop("incorrect FUN_CALIB for use in CreateCalibOptions \n"); return(NULL); } 
+
+  ##check_FUN_TRANSFO
+    if(is.null(FUN_TRANSFO)){
+      ##_set_FUN1
+      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_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(identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeige)){
+        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);  }
+
+  ##check_RunOptions
+    if(!is.null(RunOptions)){ 
+      if(inherits(RunOptions,"RunOptions")==FALSE){ stop("RunOptions must be of class 'RunOptions' if not null= \n"); return(NULL); }  
+    }
+
+  ##NParam
+    if("GR4J"          %in% ObjectClass){ NParam <- 4; }
+    if("GR5J"          %in% ObjectClass){ NParam <- 5; }
+    if("GR6J"          %in% ObjectClass){ NParam <- 6; }
+    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_OptimParam
+    if(is.null(OptimParam)){
+      OptimParam <- rep(TRUE,NParam);
+    } else {
+      if(!is.vector(OptimParam)    ){ stop("OptimParam must be a vector of booleans \n"); return(NULL);  }
+      if(length(OptimParam)!=NParam){ stop("Incompatibility between OptimParam length and FUN_MOD \n"); return(NULL);  }
+      if(!is.logical(OptimParam)   ){ stop("OptimParam must be a vector of booleans \n"); return(NULL);  }
+    }
+
+  ##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 OptimParam length and FUN_MOD \n"); return(NULL);  }
+      if(!is.numeric(FixedParam[!OptimParam])){ stop("if OptimParam[i]==FALSE, FixedParam[i] must be a numeric value \n"); return(NULL);  }
+    }
+
+  ##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      ){ stop("SearchRanges must have 2 rows \n"); return(NULL);  }
+      if(ncol(SearchRanges)!=NParam ){ stop("Incompatibility between SearchRanges ncol and FUN_MOD \n"); return(NULL);  }
+    }
+
+  ##check_StartParamList_and_StartParamDistrib__default_values
+    if( ("HBAN"  %in% ObjectClass & is.null(StartParamList) & is.null(StartParamDistrib)) |
+        ("optim" %in% ObjectClass & is.null(StartParam)) ){
+
+      if("GR4J"%in% ObjectClass){ 
+        ParamT <- matrix( c( +3.60, -2.00, +3.40, -9.10,
+                             +3.90, -0.90, +4.10, -8.70,
+                             +4.50, -0.10, +5.00, -8.10),ncol=NParam,byrow=TRUE); }
+      if("GR5J"%in% ObjectClass){ 
+        ParamT <- matrix( c( +3.60, -1.70, +3.30, -9.10, -0.70,
+                             +3.90, -0.60, +4.10, -8.70, +0.30,
+                             +4.50, -0.10, +5.00, -8.10, +0.50),ncol=NParam,byrow=TRUE); }
+      if("GR6J"%in% ObjectClass){ 
+        ParamT <- matrix( c( +3.60, -1.00, +3.30, -9.10, -0.90, +3.00,
+                             +3.90, -0.50, +4.10, -8.70, +0.10, +4.00,
+                             +4.50, +0.50, +5.00, -8.10, +1.10, +5.00),ncol=NParam,byrow=TRUE); }
+      if("CemaNeige"%in% ObjectClass){ 
+        ParamT <- matrix( c( -6.26, +0.55,
+                             -2.13, +0.92,
+                             +4.86, +1.40),ncol=NParam,byrow=TRUE); }
+      if("CemaNeigeGR4J"%in% ObjectClass){ 
+        ParamT <- matrix( c( +3.60, -2.00, +3.40, -9.10, -6.26, +0.55,
+                             +3.90, -0.90, +4.10, -8.70, -2.13, +0.92,
+                             +4.50, -0.10, +5.00, -8.10, +4.86, +1.40),ncol=NParam,byrow=TRUE); }
+      if("CemaNeigeGR5J"%in% ObjectClass){ 
+        ParamT <- matrix( c( +3.60, -1.70, +3.30, -9.10, -0.70, -6.26, +0.55,
+                             +3.90, -0.60, +4.10, -8.70, +0.30, -2.13, +0.92,
+                             +4.50, -0.10, +5.00, -8.10, +0.50, +4.86, +1.40),ncol=NParam,byrow=TRUE); }
+      if("CemaNeigeGR6J"%in% ObjectClass){ 
+        ParamT <- matrix( c( +3.60, -1.00, +3.30, -9.10, -0.90, +3.00, -6.26, +0.55,
+                             +3.90, -0.50, +4.10, -8.70, +0.10, +4.00, -2.13, +0.92,
+                             +4.50, +0.50, +5.00, -8.10, +1.10, +5.00, +4.86, +1.40),ncol=NParam,byrow=TRUE); }
+
+      StartParamList    <- NULL;
+      StartParamDistrib <- TransfoParam(ParamIn=ParamT,Direction="TR",FUN_TRANSFO=FUN_TRANSFO);
+      StartParam        <- StartParamDistrib[2,];
+    }
+
+  ##check_StartParamList_and_StartParamDistrib__format
+    if("HBAN" %in% ObjectClass & !is.null(StartParamList)){
+      if(!is.matrix( StartParamList)  ){ stop("StartParamList must be a matrix \n"); return(NULL);  }
+      if(!is.numeric(StartParamList)  ){ stop("StartParamList must be a matrix of numeric values \n"); return(NULL);  }
+      if(sum(is.na(StartParamList))!=0){ stop("StartParamList must not include NA values \n"); return(NULL);  }
+      if(ncol(StartParamList)!=NParam ){ stop("Incompatibility between StartParamList ncol and FUN_MOD \n"); return(NULL);  }
+    }
+    if("HBAN" %in% ObjectClass & !is.null(StartParamDistrib)){
+      if(!is.matrix( StartParamDistrib)      ){ stop("StartParamDistrib must be a matrix \n"); return(NULL);  }
+      if(!is.numeric(StartParamDistrib[1,])  ){ stop("StartParamDistrib must be a matrix of numeric values \n"); return(NULL);  }
+      if(sum(is.na(StartParamDistrib[1,]))!=0){ stop("StartParamDistrib must not include NA values on the first line \n"); return(NULL);  }
+      if(ncol(StartParamDistrib)!=NParam     ){ stop("Incompatibility between StartParamDistrib ncol and FUN_MOD \n"); return(NULL);  }
+    }
+    if("optim" %in% ObjectClass & !is.null(StartParam)){
+      if(!is.vector( StartParam)    ){ stop("StartParam must be a vector \n"); return(NULL);  }
+      if(!is.numeric(StartParam)    ){ stop("StartParam must be a vector of numeric values \n"); return(NULL);  }
+      if(sum(is.na(StartParam))!=0  ){ stop("StartParam must not include NA values \n"); return(NULL);  }
+      if(length(StartParam)!=NParam ){ stop("Incompatibility between StartParam length and FUN_MOD \n"); return(NULL);  }
+    }
+
+
+  ##Create_CalibOptions
+    CalibOptions <- list(OptimParam=OptimParam,FixedParam=FixedParam,SearchRanges=SearchRanges);
+    if(!is.null(StartParam       )){ CalibOptions <- c(CalibOptions,list(StartParam=StartParam)); }
+    if(!is.null(StartParamList   )){ CalibOptions <- c(CalibOptions,list(StartParamList=StartParamList)); }
+    if(!is.null(StartParamDistrib)){ CalibOptions <- c(CalibOptions,list(StartParamDistrib=StartParamDistrib)); }
+    class(CalibOptions) <- c("CalibOptions",ObjectClass);
+    return(CalibOptions);
+
+
+}
+
+
+

R/CreateInputsCrit.R

+#*************************************************************************************************
+#' 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_RMSE) | identical(FUN_CRIT,ErrorCrit_NSE) | identical(FUN_CRIT,ErrorCrit_KGE) | identical(FUN_CRIT,ErrorCrit_KGE2)){
+      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); } 
+