Commit 26af2991 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.2.14.9 BUG: many object values of ErrorCrit_ funs are now get from the .ErrorCrit fun

Showing with 61 additions and 61 deletions
+61 -61
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.8 Version: 1.2.14.9
Date: 2019-04-17 Date: 2019-04-17
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.8 Release Notes (2019-04-17) ### 1.2.14.9 Release Notes (2019-04-17)
#### New features #### New features
......
...@@ -5,15 +5,16 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T ...@@ -5,15 +5,16 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T
stop("'OutputsModel' must be of class 'OutputsModel'") stop("'OutputsModel' must be of class 'OutputsModel'")
} }
OutputsCritCheck <- .ErrorCrit(InputsCrit = InputsCrit, crit = "KGE") EC <- .ErrorCrit(InputsCrit = InputsCrit, Crit = "KGE", OutputsModel = OutputsModel, warnings = warnings)
if (!EC$CritCompute) {
if (!OutputsCritCheck$CritCompute) { CritValue <- NA
CritValue <- NA SubCritValues <- NA
SubCritNames <- NA
} else { } else {
## Other variables preparation ## Other variables preparation
meanVarObs <- mean(VarObs[!TS_ignore]) meanVarObs <- mean(EC$VarObs[!EC$TS_ignore])
meanVarSim <- mean(VarSim[!TS_ignore]) meanVarSim <- mean(EC$VarSim[!EC$TS_ignore])
iCrit <- 0 iCrit <- 0
SubCritPrint <- NULL SubCritPrint <- NULL
...@@ -22,13 +23,13 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T ...@@ -22,13 +23,13 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T
## SubErrorCrit KGE rPearson ## SubErrorCrit KGE rPearson
iCrit <- iCrit + 1 iCrit <- iCrit + 1
SubCritPrint[iCrit] <- paste(CritName, " cor(sim, obs, \"pearson\") =", sep = "") SubCritPrint[iCrit] <- paste0(EC$CritName, " cor(sim, obs, \"pearson\") =")
SubCritValues[iCrit] <- NA SubCritValues[iCrit] <- NA
SubCritNames[iCrit] <- "r" SubCritNames[iCrit] <- "r"
Numer <- sum((VarObs[!TS_ignore] - meanVarObs) * (VarSim[!TS_ignore] - meanVarSim)) Numer <- sum((EC$VarObs[!EC$TS_ignore] - meanVarObs) * (EC$VarSim[!EC$TS_ignore] - meanVarSim))
Deno1 <- sqrt(sum((VarObs[!TS_ignore] - meanVarObs) ^ 2)) Deno1 <- sqrt(sum((EC$VarObs[!EC$TS_ignore] - meanVarObs) ^ 2))
Deno2 <- sqrt(sum((VarSim[!TS_ignore] - meanVarSim) ^ 2)) Deno2 <- sqrt(sum((EC$VarSim[!EC$TS_ignore] - meanVarSim) ^ 2))
if (Numer == 0) { if (Numer == 0) {
if (Deno1 == 0 & Deno2 == 0) { if (Deno1 == 0 & Deno2 == 0) {
...@@ -45,12 +46,12 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T ...@@ -45,12 +46,12 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T
## SubErrorCrit KGE alpha ## SubErrorCrit KGE alpha
iCrit <- iCrit + 1 iCrit <- iCrit + 1
SubCritPrint[iCrit] <- paste(CritName, " sd(sim)/sd(obs) =", sep = "") SubCritPrint[iCrit] <- paste0(EC$CritName, " sd(sim)/sd(obs) =")
SubCritValues[iCrit] <- NA SubCritValues[iCrit] <- NA
SubCritNames[iCrit] <- "alpha" SubCritNames[iCrit] <- "alpha"
Numer <- sd(VarSim[!TS_ignore]) Numer <- sd(EC$VarSim[!EC$TS_ignore])
Denom <- sd(VarObs[!TS_ignore]) Denom <- sd(EC$VarObs[!EC$TS_ignore])
if (Numer == 0 & Denom == 0) { if (Numer == 0 & Denom == 0) {
Crit <- 1 Crit <- 1
...@@ -63,7 +64,7 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T ...@@ -63,7 +64,7 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T
## SubErrorCrit KGE beta ## SubErrorCrit KGE beta
iCrit <- iCrit + 1 iCrit <- iCrit + 1
SubCritPrint[iCrit] <- paste(CritName, " mean(sim)/mean(obs) =", sep = "") SubCritPrint[iCrit] <- paste0(EC$CritName, " mean(sim)/mean(obs) =")
SubCritValues[iCrit] <- NA SubCritValues[iCrit] <- NA
SubCritNames[iCrit] <- "beta" SubCritNames[iCrit] <- "beta"
...@@ -83,7 +84,7 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T ...@@ -83,7 +84,7 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T
## Verbose ## Verbose
if (verbose) { if (verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue)) message(sprintf("Crit. %s = %.4f", EC$CritName, CritValue))
message(paste("\tSubCrit.", SubCritPrint, sprintf("%.4f", SubCritValues), "\n", sep = " ")) message(paste("\tSubCrit.", SubCritPrint, sprintf("%.4f", SubCritValues), "\n", sep = " "))
} }
} }
...@@ -91,13 +92,12 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T ...@@ -91,13 +92,12 @@ ErrorCrit_KGE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T
## Output ## Output
OutputsCrit <- list(CritValue = CritValue, OutputsCrit <- list(CritValue = CritValue,
CritName = CritName, CritName = EC$CritName,
SubCritValues = SubCritValues, SubCritValues = SubCritValues,
SubCritNames = SubCritNames, SubCritNames = SubCritNames,
CritBestValue = CritBestValue, CritBestValue = EC$CritBestValue,
Multiplier = Multiplier, Multiplier = EC$Multiplier,
Ind_notcomputed = Ind_TS_ignore Ind_notcomputed = EC$Ind_TS_ignore)
)
class(OutputsCrit) <- c("KGE", "ErrorCrit") class(OutputsCrit) <- c("KGE", "ErrorCrit")
return(OutputsCrit) return(OutputsCrit)
......
...@@ -5,14 +5,14 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = ...@@ -5,14 +5,14 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose =
stop("'OutputsModel' must be of class 'OutputsModel'") stop("'OutputsModel' must be of class 'OutputsModel'")
} }
OutputsCritCheck <- .ErrorCrit(InputsCrit = InputsCrit, crit = "RMSE") EC <- .ErrorCrit(InputsCrit = InputsCrit, Crit = "KGE2", OutputsModel = OutputsModel, warnings = warnings)
if (!OutputsCritCheck$CritCompute) { if (!EC$CritCompute) {
CritValue <- NA CritValue <- NA
} else { } else {
## Other variables preparation ## Other variables preparation
meanVarObs <- mean(VarObs[!TS_ignore]) meanVarObs <- mean(EC$VarObs[!EC$TS_ignore])
meanVarSim <- mean(VarSim[!TS_ignore]) meanVarSim <- mean(EC$VarSim[!EC$TS_ignore])
iCrit <- 0 iCrit <- 0
SubCritPrint <- NULL SubCritPrint <- NULL
...@@ -21,13 +21,13 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = ...@@ -21,13 +21,13 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose =
## SubErrorCrit KGE rPearson ## SubErrorCrit KGE rPearson
iCrit <- iCrit + 1 iCrit <- iCrit + 1
SubCritPrint[iCrit] <- paste(CritName, " cor(sim, obs, \"pearson\") =", sep = "") SubCritPrint[iCrit] <- paste0(EC$CritName, " cor(sim, obs, \"pearson\") =")
SubCritValues[iCrit] <- NA SubCritValues[iCrit] <- NA
SubCritNames[iCrit] <- "r" SubCritNames[iCrit] <- "r"
Numer <- sum((VarObs[!TS_ignore] - meanVarObs) * (VarSim[!TS_ignore] - meanVarSim)) Numer <- sum((EC$VarObs[!EC$TS_ignore] - meanVarObs) * (EC$VarSim[!EC$TS_ignore] - meanVarSim))
Deno1 <- sqrt(sum((VarObs[!TS_ignore] - meanVarObs)^2)) Deno1 <- sqrt(sum((EC$VarObs[!EC$TS_ignore] - meanVarObs)^2))
Deno2 <- sqrt(sum((VarSim[!TS_ignore] - meanVarSim)^2)) Deno2 <- sqrt(sum((EC$VarSim[!EC$TS_ignore] - meanVarSim)^2))
if (Numer == 0) { if (Numer == 0) {
if (Deno1 == 0 & Deno2 == 0) { if (Deno1 == 0 & Deno2 == 0) {
...@@ -44,28 +44,28 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = ...@@ -44,28 +44,28 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose =
## SubErrorCrit KGE gamma ## SubErrorCrit KGE gamma
iCrit <- iCrit + 1 iCrit <- iCrit + 1
SubCritPrint[iCrit] <- paste(CritName, " cv(sim)/cv(obs) =", sep = "") SubCritPrint[iCrit] <- paste0(EC$CritName, " cv(sim)/cv(obs) =")
SubCritValues[iCrit] <- NA SubCritValues[iCrit] <- NA
SubCritNames[iCrit] <- "gamma" SubCritNames[iCrit] <- "gamma"
if (meanVarSim == 0) { if (meanVarSim == 0) {
if (sd(VarSim[!TS_ignore]) == 0) { if (sd(EC$VarSim[!EC$TS_ignore]) == 0) {
CVsim <- 1 CVsim <- 1
} else { } else {
CVsim <- 99999 CVsim <- 99999
} }
} else { } else {
CVsim <- sd(VarSim[!TS_ignore]) / meanVarSim CVsim <- sd(EC$VarSim[!EC$TS_ignore]) / meanVarSim
} }
if (meanVarObs == 0) { if (meanVarObs == 0) {
if (sd(VarObs[!TS_ignore]) == 0) { if (sd(EC$VarObs[!EC$TS_ignore]) == 0) {
CVobs <- 1 CVobs <- 1
} else { } else {
CVobs <- 99999 CVobs <- 99999
} }
} else { } else {
CVobs <- sd(VarObs[!TS_ignore]) / meanVarObs CVobs <- sd(EC$VarObs[!EC$TS_ignore]) / meanVarObs
} }
if (CVsim == 0 & if (CVsim == 0 &
CVobs == 0) { CVobs == 0) {
...@@ -79,7 +79,7 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = ...@@ -79,7 +79,7 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose =
## SubErrorCrit KGE beta ## SubErrorCrit KGE beta
iCrit <- iCrit + 1 iCrit <- iCrit + 1
SubCritPrint[iCrit] <- paste(CritName, " mean(sim)/mean(obs) =", sep = "") SubCritPrint[iCrit] <- paste0(EC$CritName, " mean(sim)/mean(obs) =")
SubCritValues[iCrit] <- NA SubCritValues[iCrit] <- NA
SubCritNames[iCrit] <- "beta" SubCritNames[iCrit] <- "beta"
...@@ -99,7 +99,7 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = ...@@ -99,7 +99,7 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose =
## Verbose ## Verbose
if (verbose) { if (verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue)) message(sprintf("Crit. %s = %.4f", EC$CritName, CritValue))
message(paste("\tSubCrit.", SubCritPrint, sprintf("%.4f", SubCritValues), "\n", sep = " ")) message(paste("\tSubCrit.", SubCritPrint, sprintf("%.4f", SubCritValues), "\n", sep = " "))
} }
} }
...@@ -107,12 +107,12 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = ...@@ -107,12 +107,12 @@ ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose =
## Output ## Output
OutputsCrit <- list(CritValue = CritValue, OutputsCrit <- list(CritValue = CritValue,
CritName = CritName, CritName = EC$CritName,
SubCritValues = SubCritValues, SubCritValues = SubCritValues,
SubCritNames = SubCritNames, SubCritNames = SubCritNames,
CritBestValue = CritBestValue, CritBestValue = EC$CritBestValue,
Multiplier = Multiplier, Multiplier = EC$Multiplier,
Ind_notcomputed = Ind_TS_ignore) Ind_notcomputed = EC$Ind_TS_ignore)
class(OutputsCrit) <- c("KGE2", "ErrorCrit") class(OutputsCrit) <- c("KGE2", "ErrorCrit")
return(OutputsCrit) return(OutputsCrit)
......
...@@ -5,18 +5,18 @@ ErrorCrit_NSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T ...@@ -5,18 +5,18 @@ ErrorCrit_NSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T
stop("'OutputsModel' must be of class 'OutputsModel'") stop("'OutputsModel' must be of class 'OutputsModel'")
} }
OutputsCritCheck <- .ErrorCrit(InputsCrit = InputsCrit, crit = "NSE") EC <- .ErrorCrit(InputsCrit = InputsCrit, Crit = "NSE", OutputsModel = OutputsModel, warnings = warnings)
if (!OutputsCritCheck$CritCompute) { if (!EC$CritCompute) {
CritValue <- NA CritValue <- NA
} else { } else {
## Other variables preparation ## Other variables preparation
meanVarObs <- mean(VarObs[!TS_ignore]) meanVarObs <- mean(EC$VarObs[!EC$TS_ignore])
meanVarSim <- mean(VarSim[!TS_ignore]) meanVarSim <- mean(EC$VarSim[!EC$TS_ignore])
## ErrorCrit ## ErrorCrit
Emod <- sum((VarSim[!TS_ignore] - VarObs[!TS_ignore])^2) Emod <- sum((EC$VarSim[!EC$TS_ignore] - EC$VarObs[!EC$TS_ignore])^2)
Eref <- sum((VarObs[!TS_ignore] - mean(VarObs[!TS_ignore]))^2) Eref <- sum((EC$VarObs[!EC$TS_ignore] - mean(EC$VarObs[!EC$TS_ignore]))^2)
if (Emod == 0 & Eref == 0) { if (Emod == 0 & Eref == 0) {
Crit <- 0 Crit <- 0
...@@ -29,17 +29,17 @@ ErrorCrit_NSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T ...@@ -29,17 +29,17 @@ ErrorCrit_NSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = T
## Verbose ## Verbose
if (verbose) { if (verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue), "\n") message(sprintf("Crit. %s = %.4f", EC$CritName, CritValue))
} }
} }
## Output ## Output
OutputsCrit <- list(CritValue = CritValue, OutputsCrit <- list(CritValue = CritValue,
CritName = CritName, CritName = EC$CritName,
CritBestValue = CritBestValue, CritBestValue = EC$CritBestValue,
Multiplier = Multiplier, Multiplier = EC$Multiplier,
Ind_notcomputed = Ind_TS_ignore) Ind_notcomputed = EC$Ind_TS_ignore)
class(OutputsCrit) <- c("NSE", "ErrorCrit") class(OutputsCrit) <- c("NSE", "ErrorCrit")
return(OutputsCrit) return(OutputsCrit)
......
...@@ -5,14 +5,14 @@ ErrorCrit_RMSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = ...@@ -5,14 +5,14 @@ ErrorCrit_RMSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose =
stop("'OutputsModel' must be of class 'OutputsModel'") stop("'OutputsModel' must be of class 'OutputsModel'")
} }
OutputsCritCheck <- .ErrorCrit(InputsCrit = InputsCrit, crit = "RMSE") EC <- .ErrorCrit(InputsCrit = InputsCrit, Crit = "RMSE", OutputsModel = OutputsModel, warnings = warnings)
if (!OutputsCritCheck$CritCompute) { if (!EC$CritCompute) {
CritValue <- NA CritValue <- NA
} else { } else {
## ErrorCrit ## ErrorCrit
Numer <- sum((OutputsCritCheck$VarSim - OutputsCritCheck$VarObs)^2, na.rm = TRUE) Numer <- sum((EC$VarSim - EC$VarObs)^2, na.rm = TRUE)
Denom <- sum(!is.na(OutputsCritCheck$VarObs)) Denom <- sum(!is.na(EC$VarObs))
if (Numer == 0) { if (Numer == 0) {
Crit <- 0 Crit <- 0
...@@ -25,17 +25,17 @@ ErrorCrit_RMSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = ...@@ -25,17 +25,17 @@ ErrorCrit_RMSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose =
## Verbose ## Verbose
if (verbose) { if (verbose) {
message("Crit. ", OutputsCritCheck$CritName, " = ", sprintf("%.4f", CritValue), "\n") message(sprintf("Crit. %s = %.4f", EC$CritName, CritValue))
} }
} }
## Output ## Output
OutputsCrit <- list(CritValue = CritValue, OutputsCrit <- list(CritValue = CritValue,
CritName = OutputsCritCheck$CritName, CritName = EC$CritName,
CritBestValue = OutputsCritCheck$CritBestValue, CritBestValue = EC$CritBestValue,
Multiplier = OutputsCritCheck$Multiplier, Multiplier = EC$Multiplier,
Ind_notcomputed = OutputsCritCheck$Ind_TS_ignore) Ind_notcomputed = EC$Ind_TS_ignore)
class(OutputsCrit) <- c("RMSE", "ErrorCrit") class(OutputsCrit) <- c("RMSE", "ErrorCrit")
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