Commit 76600c38 authored by Delaigue Olivier's avatar Delaigue Olivier Committed by unknown
Browse files

test

parent a29cb871
BasinInfo Data sample: characteristics of a fictional
catchment (L0123001, L0123002 or L0123003)
BasinObs Data sample: time series of observations of a
fictional catchment (L0123001, L0123002 or
L0123003)
Calibration Calibration algorithm which minimises an error
criterion on the model outputs using the
provided functions
Calibration_HBAN Calibration algorithm which minimises the error
criterion using the Irstea-HBAN procedure
Calibration_optim Calibration algorithm which minimises the error
criterion using the stats::optim function
CreateCalibOptions Creation of the CalibOptions object required to
the Calibration functions
CreateInputsCrit Creation of the InputsCrit object required to
the ErrorCrit functions
CreateInputsModel Creation of the InputsModel object required to
the RunModel functions
CreateRunOptions Creation of the RunOptions object required to
the RunModel functions
DataAltiExtrapolation_HBAN
Altitudinal extrapolation of precipitation and
temperature series
ErrorCrit Error criterion using the provided function
ErrorCrit_KGE Error criterion based on the KGE formula
ErrorCrit_KGE2 Error criterion based on the KGE' formula
ErrorCrit_NSE Error criterion based on the NSE formula
ErrorCrit_RMSE Error criterion based on the RMSE
PEdaily_Oudin Computation of daily series of potential
evapotranspiration with Oudin's formula
RunModel Run with the provided hydrological model
function
RunModel_CemaNeige Run with the CemaNeige snow module
RunModel_CemaNeigeGR4J
Run with the CemaNeigeGR4J hydrological model
RunModel_CemaNeigeGR5J
Run with the CemaNeigeGR5J hydrological model
RunModel_CemaNeigeGR6J
Run with the CemaNeigeGR6J hydrological model
RunModel_GR4J Run with the GR4J hydrological model
RunModel_GR5J Run with the GR5J hydrological model
RunModel_GR6J Run with the GR6J hydrological model
TransfoParam Transformation of the parameters using the
provided function
TransfoParam_CemaNeige
Transformation of the parameters from the
CemaNeige module
TransfoParam_GR4J Transformation of the parameters from the GR4J
model
TransfoParam_GR5J Transformation of the parameters from the GR5J
model
TransfoParam_GR6J Transformation of the parameters from the GR6J
model
airGR Modelling tools used at Irstea-HBAN (France),
including GR4J, GR5J, GR6J and CemaNeige
plot_OutputsModel Default preview of model outputs
dc740898c129f840d12d222a2ead106d *DESCRIPTION
eacf8601006227c3c02bcfaf97cbdc0e *INDEX
f06c85e4eb89b267cfb165274067c4e8 *Meta/Rd.rds
32a1c5de93e3b6254dbd86b07ba073ba *Meta/data.rds
e5a11fd9f38a3bf1d0dadd7840a739f7 *Meta/hsearch.rds
a1d82a0c2244a09e38104c219298794a *Meta/links.rds
3b9ab8f86ffaa46a406cb5352028ef27 *Meta/nsInfo.rds
7ecce7e1cc77345bfed1ac9c9b04e61d *Meta/package.rds
52ca795872157b1a3e2b6f6bfbc480e0 *NAMESPACE
ebf0fc819595d631b8bf280c4b049940 *R/airGR
fca9fb51c6dd9ac775dbba00d895d0a7 *R/airGR.rdb
9362eca21ff55ff6e7866a8653c5371e *R/airGR.rdx
63a6f712183a364edfac4df460e83c4b *data/L0123001.rda
aa6993b50e8a59fb4b37c8eb92df6760 *data/L0123002.rda
cd27feeac8c19aad0c511b33010ea9ed *data/L0123003.rda
c067204cb6e5b9db41af38aa96b519b0 *help/AnIndex
a55d619bb922901e93a88bc0cd44fa4a *help/airGR.rdb
efdee1c7837ed1b695a529e17fa09725 *help/airGR.rdx
228f1599718d0523f25967469dcfbb61 *help/aliases.rds
d312909d7d245fe60010b0b763b00f13 *help/paths.rds
592202faa3a70495a0bf299af2596ac4 *html/00Index.html
444535b9cb76ddff1bab1e1865a3fb14 *html/R.css
0b6e15e196f42c1f59b5b95fc0fad2b9 *libs/i386/airGR.dll
#' @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
#*************************************************************************************************
#' 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) )
}
This diff is collapsed.
#*************************************************************************************************
#' 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);
}
#*************************************************************************************************
#' 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);
}
#*************************************************************************************************
#' 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)){
BO