Commit 0967defb authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.2.14.17 UPDATE: CreateInputsCrit returns FUN_CRIT as character string

Showing with 20 additions and 11 deletions
+20 -11
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.14.16 Version: 1.2.14.17
Date: 2019-05-02 Date: 2019-05-02
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")),
......
...@@ -14,7 +14,7 @@ output: ...@@ -14,7 +14,7 @@ output:
### 1.2.14.16 Release Notes (2019-05-02) ### 1.2.14.17 Release Notes (2019-05-02)
#### New features #### New features
......
...@@ -267,6 +267,7 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -267,6 +267,7 @@ CreateInputsCrit <- function(FUN_CRIT,
} }
} }
## Create InputsCrit ## Create InputsCrit
iInputsCrit <- list(FUN_CRIT = iListArgs2$FUN_CRIT, iInputsCrit <- list(FUN_CRIT = iListArgs2$FUN_CRIT,
Obs = iListArgs2$Obs, Obs = iListArgs2$Obs,
...@@ -282,6 +283,12 @@ CreateInputsCrit <- function(FUN_CRIT, ...@@ -282,6 +283,12 @@ CreateInputsCrit <- function(FUN_CRIT,
}) })
names(InputsCrit) <- paste0("IC", seq_along(InputsCrit)) names(InputsCrit) <- paste0("IC", seq_along(InputsCrit))
## define FUN_CRIT as a characater string
listErrorCrit <- c("ErrorCrit_KGE", "ErrorCrit_KGE2", "ErrorCrit_NSE", "ErrorCrit_RMSE")
InputsCrit <- lapply(InputsCrit, function(i) {
i$FUN_CRIT <- listErrorCrit[sapply(listErrorCrit, function(j) identical(i$FUN_CRIT, get(j)))]
i
})
listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs") listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs")
inCnVarObs <- c("SCA", "SWE") inCnVarObs <- c("SCA", "SWE")
......
...@@ -19,10 +19,11 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo ...@@ -19,10 +19,11 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo
## ----- Single criterion ## ----- Single criterion
if (inherits(InputsCrit, "Single")) { if (inherits(InputsCrit, "Single")) {
OutputsCrit <- InputsCrit$FUN_CRIT(InputsCrit = InputsCrit, FUN_CRIT <- match.fun(InputsCrit$FUN_CRIT)
OutputsModel = OutputsModel, OutputsCrit <- FUN_CRIT(InputsCrit = InputsCrit,
warnings = warnings, OutputsModel = OutputsModel,
verbose = verbose) warnings = warnings,
verbose = verbose)
} }
...@@ -30,10 +31,11 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo ...@@ -30,10 +31,11 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo
if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) { if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) {
listOutputsCrit <- lapply(InputsCrit, FUN = function(iInputsCrit) { listOutputsCrit <- lapply(InputsCrit, FUN = function(iInputsCrit) {
iInputsCrit$FUN_CRIT(InputsCrit = iInputsCrit, FUN_CRIT <- match.fun(iInputsCrit$FUN_CRIT)
OutputsModel = OutputsModel, FUN_CRIT(InputsCrit = iInputsCrit,
warnings = warnings, OutputsModel = OutputsModel,
verbose = verbose) warnings = warnings,
verbose = verbose)
}) })
listValCrit <- sapply(listOutputsCrit, function(x) x[["CritValue"]]) listValCrit <- sapply(listOutputsCrit, function(x) x[["CritValue"]])
...@@ -70,7 +72,7 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo ...@@ -70,7 +72,7 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo
} }
} }
return(OutputsCrit) return(OutputsCrit)
} }
......
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