Commit b84085b2 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.2.9.0 NEW: FUN_* arguments can be a character of the function name

Showing with 38 additions and 15 deletions
+38 -15
Package: airGR Package: airGR
Type: Package Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.2.8.11 Version: 1.2.9.0
Date: 2019-03-12 Date: 2019-03-12
Authors@R: c( Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
...@@ -13,7 +13,7 @@ output: ...@@ -13,7 +13,7 @@ output:
### 1.2.8.11 Release Notes (2019-03-12) ### 1.2.9.0 Release Notes (2019-03-12)
...@@ -60,6 +60,8 @@ output: ...@@ -60,6 +60,8 @@ output:
- It is now possible to be redirected on the documantation about <code>plot.OutputsModel()</code> with <code>?plot</code>. - It is now possible to be redirected on the documantation about <code>plot.OutputsModel()</code> with <code>?plot</code>.
- It is now possible to use a character vector the function name (in addition to function objects) in all <code>FUN_&#42;</code> arguments of the following functions: <code>Calibration()</code>, <code>Calibration_Michel()</code>, <code>CreateCalibOptions()</code>, <code>CreateIniStates()</code>, <code>CreateIniStates()</code>, <code>CreateInputsCrit()</code>, <code>CreateInputsModel()</code>, <code>CreateRunOptions()</code>, <code>ErrorCrit()</code>, <code>RunModel()</code> and <code>TransfoParam()</code>.
#### Minor user-visible changes #### Minor user-visible changes
......
Calibration <- function(InputsModel, RunOptions, InputsCrit, CalibOptions, Calibration <- function(InputsModel, RunOptions, InputsCrit, CalibOptions,
FUN_MOD, FUN_CRIT, FUN_CALIB = Calibration_Michel, FUN_TRANSFO = NULL, FUN_MOD, FUN_CRIT, FUN_CALIB = Calibration_Michel, FUN_TRANSFO = NULL,
verbose = TRUE) { verbose = TRUE) {
if (! is.function(FUN_CALIB)) { FUN_MOD <- match.fun(FUN_MOD)
stop("'FUN_CALIB' must be a function") FUN_CRIT <- match.fun(FUN_CRIT)
} FUN_CALIB <- match.fun(FUN_CALIB)
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
return(FUN_CALIB(InputsModel, RunOptions, InputsCrit, CalibOptions, FUN_MOD, FUN_CRIT, FUN_TRANSFO, verbose = verbose)) return(FUN_CALIB(InputsModel, RunOptions, InputsCrit, CalibOptions, FUN_MOD, FUN_CRIT, FUN_TRANSFO, verbose = verbose))
} }
...@@ -2,6 +2,13 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions ...@@ -2,6 +2,13 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
FUN_MOD, FUN_CRIT, FUN_TRANSFO = NULL, verbose = TRUE) { FUN_MOD, FUN_CRIT, FUN_TRANSFO = NULL, verbose = TRUE) {
FUN_MOD <- match.fun(FUN_MOD)
FUN_CRIT <- match.fun(FUN_CRIT)
if (!is.null(FUN_TRANSFO)) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
}
##_____Arguments_check_____________________________________________________________________ ##_____Arguments_check_____________________________________________________________________
if (!inherits(InputsModel, "InputsModel")) { if (!inherits(InputsModel, "InputsModel")) {
stop("InputsModel must be of class 'InputsModel'") stop("InputsModel must be of class 'InputsModel'")
......
CreateCalibOptions <- CreateCalibOptions <- function(FUN_MOD,
function(FUN_MOD, FUN_CALIB = Calibration_Michel,
FUN_CALIB = Calibration_Michel, FUN_TRANSFO = NULL,
FUN_TRANSFO = NULL, FixedParam = NULL,
FixedParam = NULL, SearchRanges = NULL,
SearchRanges = NULL, StartParamList = NULL,
StartParamList = NULL, StartParamDistrib = NULL) {
StartParamDistrib = NULL) {
ObjectClass <- NULL
ObjectClass <- NULL
FUN_MOD <- match.fun(FUN_MOD)
FUN_CALIB <- match.fun(FUN_CALIB)
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
##check_FUN_MOD ##check_FUN_MOD
BOOL <- FALSE BOOL <- FALSE
......
...@@ -11,6 +11,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, ...@@ -11,6 +11,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
UH1n <- 20L UH1n <- 20L
UH2n <- UH1n * 2L UH2n <- UH1n * 2L
FUN_MOD <- match.fun(FUN_MOD)
## check FUN_MOD ## check FUN_MOD
BOOL <- FALSE BOOL <- FALSE
......
...@@ -15,6 +15,8 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -15,6 +15,8 @@ CreateInputsCrit <- function(FUN_CRIT,
ObjectClass <- NULL ObjectClass <- NULL
FUN_CRIT <- match.fun(FUN_CRIT)
## ---------- check arguments ## ---------- check arguments
if (!missing(Qobs)) { if (!missing(Qobs)) {
......
...@@ -9,6 +9,8 @@ CreateInputsModel <- function(FUN_MOD, ...@@ -9,6 +9,8 @@ CreateInputsModel <- function(FUN_MOD,
ObjectClass <- NULL ObjectClass <- NULL
FUN_MOD <- match.fun(FUN_MOD)
##check_FUN_MOD ##check_FUN_MOD
BOOL <- FALSE BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H)) { if (identical(FUN_MOD, RunModel_GR4H)) {
......
...@@ -10,6 +10,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP ...@@ -10,6 +10,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
ObjectClass <- NULL ObjectClass <- NULL
FUN_MOD <- match.fun(FUN_MOD)
##check_FUN_MOD ##check_FUN_MOD
BOOL <- FALSE; BOOL <- FALSE;
if (identical(FUN_MOD, RunModel_GR4H)) { if (identical(FUN_MOD, RunModel_GR4H)) {
......
ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbose = TRUE) { ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbose = TRUE) {
FUN_CRIT <- match.fun(FUN_CRIT)
## ---------- Arguments check ## ---------- Arguments check
if (!inherits(InputsCrit, "InputsCrit")) { if (!inherits(InputsCrit, "InputsCrit")) {
......
RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) { RunModel <- function(InputsModel, RunOptions, Param, FUN_MOD) {
FUN_MOD <- match.fun(FUN_MOD)
return(FUN_MOD(InputsModel, RunOptions, Param)) return(FUN_MOD(InputsModel, RunOptions, Param))
} }
TransfoParam <- function(ParamIn, Direction, FUN_TRANSFO) { TransfoParam <- function(ParamIn, Direction, FUN_TRANSFO) {
FUN_TRANSFO <- match.fun(FUN_TRANSFO)
return(FUN_TRANSFO(ParamIn, Direction)) return(FUN_TRANSFO(ParamIn, Direction))
} }
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment