Skip to content
GitLab
Commit c5410c88 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.6.3.68 refactor: move .ErrorCrit function from Utils.R to UtilsErrorCrit

parent 1108d17d
dev 115-add-pcict-date-format-managment 118-plot-outputsmodel-remove-case-sensitivity-to-the-which-argument 136-decreased-performance-of-calibration-execution-time 161-runmodel_lag-proposal-for-a-better-transformation-and-screening-of-the-parameters 165-add-missing-isintstore-argument-in-createcaliboptions 171-check-error-direct-call-of-as-data-frame-posixct-is-deprecated-use-as-data-frame-vector-or-as 191-speed-up-runmodel_lag-when-it-is-used-alone 33-merge-airgr-and-airgrplus-functions 96-parallelize-the-grid-screening-step-during-calibration master rmOptions CRAN_v1.7.6 CRAN_v1.7.5 CRAN_v1.7.4 CRAN_v1.7.3 CRAN_v1.7.2 CRAN_v1.7.1 CRAN_v1.7.0 CRAN_v1.6.12 CRAN_v1.6.11 CRAN_v1.6.10.4 CRAN_v1.6.9.27 CRAN_v1.6.9.24 CRAN_v1.6.9.23 CRAN_v1.6.9.21
1 merge request!26CRAN v1.6.9.21
Pipeline #17759 canceled with stages
Hide whitespace changes
Inline Side-by-side
Showing
with 149 additions and 153 deletions
+149 -153
DESCRIPTION
+ 1
− 1
View file @ c5410c88
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")),
......
NEWS.md
+ 1
− 1
View file @ c5410c88
......@@ -4,7 +4,7 @@
### 1.6.3.67 Release Notes (2020-11-23)
### 1.6.3.68 Release Notes (2020-11-23)
#### New features
......
R/Utils.R
+ 0
− 151
View file @ c5410c88
......@@ -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)
}
R/UtilsErrorCrit.R 0 → 100644
+ 147
− 0
View file @ c5410c88
## =================================================================================
## 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)
}
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