diff --git a/DESCRIPTION b/DESCRIPTION
index 6a7031dc398762162e0c822b04f5135a45ff0967..ca35bec4c2ad471bdf18db50b37d20d89a9de1f4 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.6.3.67
+Version: 1.6.3.68
Date: 2020-11-23
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
diff --git a/NEWS.md b/NEWS.md
index d3cb7b2b0ca439f187e75c15d8025620d58d346b..bc9380ed5c47fa4015bc044149168d8b4f441168 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -4,7 +4,7 @@
-### 1.6.3.67 Release Notes (2020-11-23)
+### 1.6.3.68 Release Notes (2020-11-23)
#### New features
diff --git a/R/Utils.R b/R/Utils.R
index 2c7a7ba636fecafd59d70f721d606913a67e6215..253ecb3f69d8f8116ecad3bf42e506dc080564c4 100644
--- a/R/Utils.R
+++ b/R/Utils.R
@@ -75,154 +75,3 @@
res <- list(GR = outGR, CN = outCN)
}
-
-
-
-## =================================================================================
-## function to manage inputs of specific ErrorCrit_*() functions
-## =================================================================================
-
-.ErrorCrit <- function(InputsCrit, Crit, OutputsModel, warnings) {
-
- ## Arguments check
- if (!inherits(InputsCrit, "InputsCrit")) {
- stop("'InputsCrit' must be of class 'InputsCrit'", call. = FALSE)
- }
- if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) {
- if (Crit == "RMSE") {
- stop("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' with RMSE", call. = FALSE)
- } else {
- stop(paste0("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' or 'Compo' with ", Crit), call. = FALSE)
- }
- }
-
-
- ## Initialisation
- CritName <- NA
- CritVar <- InputsCrit$VarObs
- if (InputsCrit$transfo == "") {
- CritName <- paste0(Crit, "[CritVar]")
- }
- if (InputsCrit$transfo %in% c("sqrt", "log", "sort", "boxcox")) {
- CritName <- paste0(Crit, "[", InputsCrit$transfo, "(CritVar)]")
- }
- if (InputsCrit$transfo == "inv") {
- CritName <- paste0(Crit, "[1/CritVar]")
- }
- if (grepl("\\^", InputsCrit$transfo)) {
- transfoPow <- suppressWarnings(as.numeric(gsub("\\^", "", InputsCrit$transfo)))
- CritName <- paste0(Crit, "[CritVar^", transfoPow, "]")
- }
- CritName <- gsub(pattern = "CritVar", replacement = CritVar, x = CritName)
- CritValue <- NA
- if (Crit %in% c("RMSE")) {
- CritBestValue <- +1
- Multiplier <- +1
- }
- if (Crit %in% c("NSE", "KGE", "KGE2")) {
- CritBestValue <- +1
- Multiplier <- -1
- }
-
-
- ## Data preparation
- VarObs <- InputsCrit$Obs
- VarObs[!InputsCrit$BoolCrit] <- NA
- if (InputsCrit$VarObs == "Q") {
- VarSim <- OutputsModel$Qsim
- }
- if (InputsCrit$VarObs == "SCA") {
- VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio"))
- }
- if (InputsCrit$VarObs == "SWE") {
- VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack"))
- }
- VarSim[!InputsCrit$BoolCrit] <- NA
-
-
- ## Data transformation
- if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) {
- if (any(VarObs %in% 0)) {
- warning("zeroes detected in 'Qobs': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
- }
- if (any(VarSim %in% 0)) {
- warning("zeroes detected in 'Qsim': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
- }
- }
- if ("epsilon" %in% names(InputsCrit) & !is.null(InputsCrit$epsilon) & !(InputsCrit$transfo == "boxcox")) {
- VarObs <- VarObs + InputsCrit$epsilon
- VarSim <- VarSim + InputsCrit$epsilon
- }
- if (InputsCrit$transfo == "sqrt") {
- VarObs <- sqrt(VarObs)
- VarSim <- sqrt(VarSim)
- }
- if (InputsCrit$transfo == "log") {
- VarObs <- log(VarObs)
- VarSim <- log(VarSim)
- VarSim[VarSim < -1e100] <- NA
- }
- if (InputsCrit$transfo == "inv") {
- VarObs <- 1 / VarObs
- VarSim <- 1 / VarSim
- VarSim[abs(VarSim) > 1e+100] <- NA
- }
- if (InputsCrit$transfo == "sort") {
- VarSim[is.na(VarObs)] <- NA
- VarSim <- sort(VarSim, na.last = TRUE)
- VarObs <- sort(VarObs, na.last = TRUE)
- InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE)
- }
- if (InputsCrit$transfo == "boxcox") {
- muTransfoVarObs <- (0.01 * mean(VarObs, na.rm = TRUE))^0.25
- VarSim <- (VarSim^0.25 - muTransfoVarObs) / 0.25
- VarObs <- (VarObs^0.25 - muTransfoVarObs) / 0.25
- }
- if (grepl("\\^", InputsCrit$transfo)) {
- VarObs <- VarObs^transfoPow
- VarSim <- VarSim^transfoPow
- }
-
-
- ## TS_ignore
- TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit
- Ind_TS_ignore <- which(TS_ignore)
- if (length(Ind_TS_ignore) == 0) {
- Ind_TS_ignore <- NULL
- }
- if (sum(!TS_ignore) == 0 | (sum(!TS_ignore) == 1 & Crit %in% c("KGE", "KGE2"))) {
- CritCompute <- FALSE
- } else {
- CritCompute <- TRUE
- }
- if (inherits(OutputsModel, "hourly")) {
- WarningTS <- 365
- }
- if (inherits(OutputsModel, "daily")) {
- WarningTS <- 365
- }
- if (inherits(OutputsModel, "monthly")) {
- WarningTS <- 12
- }
- if (inherits(OutputsModel, "yearly")) {
- WarningTS <- 3
- }
- if (sum(!TS_ignore) < WarningTS & warnings) {
- warning("\t criterion computed on less than ", WarningTS, " time-steps", call. = FALSE)
- }
-
-
- ## Outputs
- OutputsCritCheck <- list(WarningTS = WarningTS,
- VarObs = VarObs,
- VarSim = VarSim,
- CritBestValue = CritBestValue,
- Multiplier = Multiplier,
- CritName = CritName,
- CritVar = CritVar,
- CritCompute = CritCompute,
- TS_ignore = TS_ignore,
- Ind_TS_ignore = Ind_TS_ignore)
-}
-
-
diff --git a/R/UtilsErrorCrit.R b/R/UtilsErrorCrit.R
new file mode 100644
index 0000000000000000000000000000000000000000..d16a57e520c8e74a872c036c10fefcaa394d3f9b
--- /dev/null
+++ b/R/UtilsErrorCrit.R
@@ -0,0 +1,147 @@
+## =================================================================================
+## function to manage inputs of specific ErrorCrit_*() functions
+## =================================================================================
+
+.ErrorCrit <- function(InputsCrit, Crit, OutputsModel, warnings) {
+
+ ## Arguments check
+ if (!inherits(InputsCrit, "InputsCrit")) {
+ stop("'InputsCrit' must be of class 'InputsCrit'", call. = FALSE)
+ }
+ if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) {
+ if (Crit == "RMSE") {
+ stop("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' with RMSE", call. = FALSE)
+ } else {
+ stop(paste0("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' or 'Compo' with ", Crit), call. = FALSE)
+ }
+ }
+
+
+ ## Initialisation
+ CritName <- NA
+ CritVar <- InputsCrit$VarObs
+ if (InputsCrit$transfo == "") {
+ CritName <- paste0(Crit, "[CritVar]")
+ }
+ if (InputsCrit$transfo %in% c("sqrt", "log", "sort", "boxcox")) {
+ CritName <- paste0(Crit, "[", InputsCrit$transfo, "(CritVar)]")
+ }
+ if (InputsCrit$transfo == "inv") {
+ CritName <- paste0(Crit, "[1/CritVar]")
+ }
+ if (grepl("\\^", InputsCrit$transfo)) {
+ transfoPow <- suppressWarnings(as.numeric(gsub("\\^", "", InputsCrit$transfo)))
+ CritName <- paste0(Crit, "[CritVar^", transfoPow, "]")
+ }
+ CritName <- gsub(pattern = "CritVar", replacement = CritVar, x = CritName)
+ CritValue <- NA
+ if (Crit %in% c("RMSE")) {
+ CritBestValue <- +1
+ Multiplier <- +1
+ }
+ if (Crit %in% c("NSE", "KGE", "KGE2")) {
+ CritBestValue <- +1
+ Multiplier <- -1
+ }
+
+
+ ## Data preparation
+ VarObs <- InputsCrit$Obs
+ VarObs[!InputsCrit$BoolCrit] <- NA
+ if (InputsCrit$VarObs == "Q") {
+ VarSim <- OutputsModel$Qsim
+ }
+ if (InputsCrit$VarObs == "SCA") {
+ VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "Gratio"))
+ }
+ if (InputsCrit$VarObs == "SWE") {
+ VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack"))
+ }
+ VarSim[!InputsCrit$BoolCrit] <- NA
+
+
+ ## Data transformation
+ if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) {
+ if (any(VarObs %in% 0)) {
+ warning("zeroes detected in 'Qobs': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
+ }
+ if (any(VarSim %in% 0)) {
+ warning("zeroes detected in 'Qsim': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
+ }
+ }
+ if ("epsilon" %in% names(InputsCrit) & !is.null(InputsCrit$epsilon) & !(InputsCrit$transfo == "boxcox")) {
+ VarObs <- VarObs + InputsCrit$epsilon
+ VarSim <- VarSim + InputsCrit$epsilon
+ }
+ if (InputsCrit$transfo == "sqrt") {
+ VarObs <- sqrt(VarObs)
+ VarSim <- sqrt(VarSim)
+ }
+ if (InputsCrit$transfo == "log") {
+ VarObs <- log(VarObs)
+ VarSim <- log(VarSim)
+ VarSim[VarSim < -1e100] <- NA
+ }
+ if (InputsCrit$transfo == "inv") {
+ VarObs <- 1 / VarObs
+ VarSim <- 1 / VarSim
+ VarSim[abs(VarSim) > 1e+100] <- NA
+ }
+ if (InputsCrit$transfo == "sort") {
+ VarSim[is.na(VarObs)] <- NA
+ VarSim <- sort(VarSim, na.last = TRUE)
+ VarObs <- sort(VarObs, na.last = TRUE)
+ InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE)
+ }
+ if (InputsCrit$transfo == "boxcox") {
+ muTransfoVarObs <- (0.01 * mean(VarObs, na.rm = TRUE))^0.25
+ VarSim <- (VarSim^0.25 - muTransfoVarObs) / 0.25
+ VarObs <- (VarObs^0.25 - muTransfoVarObs) / 0.25
+ }
+ if (grepl("\\^", InputsCrit$transfo)) {
+ VarObs <- VarObs^transfoPow
+ VarSim <- VarSim^transfoPow
+ }
+
+
+ ## TS_ignore
+ TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit
+ Ind_TS_ignore <- which(TS_ignore)
+ if (length(Ind_TS_ignore) == 0) {
+ Ind_TS_ignore <- NULL
+ }
+ if (sum(!TS_ignore) == 0 | (sum(!TS_ignore) == 1 & Crit %in% c("KGE", "KGE2"))) {
+ CritCompute <- FALSE
+ } else {
+ CritCompute <- TRUE
+ }
+ if (inherits(OutputsModel, "hourly")) {
+ WarningTS <- 365
+ }
+ if (inherits(OutputsModel, "daily")) {
+ WarningTS <- 365
+ }
+ if (inherits(OutputsModel, "monthly")) {
+ WarningTS <- 12
+ }
+ if (inherits(OutputsModel, "yearly")) {
+ WarningTS <- 3
+ }
+ if (sum(!TS_ignore) < WarningTS & warnings) {
+ warning("\t criterion computed on less than ", WarningTS, " time-steps", call. = FALSE)
+ }
+
+
+ ## Outputs
+ OutputsCritCheck <- list(WarningTS = WarningTS,
+ VarObs = VarObs,
+ VarSim = VarSim,
+ CritBestValue = CritBestValue,
+ Multiplier = Multiplier,
+ CritName = CritName,
+ CritVar = CritVar,
+ CritCompute = CritCompute,
+ TS_ignore = TS_ignore,
+ Ind_TS_ignore = Ind_TS_ignore)
+}
+