Commit 3f94e3e1 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

vv1.0.13.4 ErrorCrit_RMSE cleaned

parent 52e9d535
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.0.13.3 Version: 1.0.13.4
Date: 2018-08-29 Date: 2018-08-29
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.0.13.3 Release Notes (2018-08-29) ### 1.0.13.4 Release Notes (2018-08-29)
#### Deprectated and defunct #### Deprectated and defunct
......
ErrorCrit_RMSE <- function(InputsCrit,OutputsModel, warnings = TRUE, verbose = TRUE){ ErrorCrit_RMSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE) {
##Arguments_check________________________________ ##Arguments_check________________________________
if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); } if (inherits(InputsCrit, "InputsCrit") == FALSE) {
if(inherits(OutputsModel,"OutputsModel")==FALSE){ stop("OutputsModel must be of class 'OutputsModel' \n"); return(NULL); } stop("InputsCrit must be of class 'InputsCrit' \n")
return(NULL)
}
##Initialisation_________________________________ if (inherits(OutputsModel, "OutputsModel") == FALSE) {
CritName <- NA; stop("OutputsModel must be of class 'OutputsModel' \n")
if(InputsCrit$transfo=="" ){ CritName <- "RMSE[Q]" ; } return(NULL)
if(InputsCrit$transfo=="sqrt"){ CritName <- "RMSE[sqrt(Q)]"; } }
if(InputsCrit$transfo=="log" ){ CritName <- "RMSE[log(Q)]" ; }
if(InputsCrit$transfo=="inv" ){ CritName <- "RMSE[1/Q]" ; }
if(InputsCrit$transfo=="sort"){ CritName <- "RMSE[sort(Q)]"; } ##Initialisation_________________________________
CritName <- NA
CritValue <- NA; if (InputsCrit$transfo == "") {
CritBestValue <- +1; CritName <- "RMSE[Q]"
Multiplier <- +1; ### must be equal to -1 or +1 only }
if (InputsCrit$transfo == "sqrt") {
CritName <- "RMSE[sqrt(Q)]"
##Data_preparation_______________________________ }
VarObs <- InputsCrit$Qobs ; VarObs[!InputsCrit$BoolCrit] <- NA; if (InputsCrit$transfo == "log") {
VarSim <- OutputsModel$Qsim; VarSim[!InputsCrit$BoolCrit] <- NA; CritName <- "RMSE[log(Q)]"
##Data_transformation }
if("Ind_zeroes" %in% names(InputsCrit) & "epsilon" %in% names(InputsCrit)){ if(length(InputsCrit$Ind_zeroes)>0){ if (InputsCrit$transfo == "inv") {
VarObs <- VarObs + InputsCrit$epsilon; CritName <- "RMSE[1/Q]"
VarSim <- VarSim + InputsCrit$epsilon; }
} } if (InputsCrit$transfo == "sort") {
if(InputsCrit$transfo=="sqrt"){ VarObs <- sqrt(VarObs); VarSim <- sqrt(VarSim); } CritName <- "RMSE[sort(Q)]"
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; } CritValue <- NA
if(InputsCrit$transfo=="sort"){ CritBestValue <- +1
VarSim[is.na(VarObs)] <- NA Multiplier <- +1
VarSim <- sort(VarSim, na.last = TRUE) ### must be equal to -1 or +1 only
VarObs <- sort(VarObs, na.last = TRUE)
InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE)
##Data_preparation_______________________________
VarObs <- InputsCrit$Qobs
VarObs[!InputsCrit$BoolCrit] <- NA
VarSim <- OutputsModel$Qsim
VarSim[!InputsCrit$BoolCrit] <- NA
##Data_transformation
if ("Ind_zeroes" %in% names(InputsCrit) & "epsilon" %in% names(InputsCrit)) {
if (length(InputsCrit$Ind_zeroes) > 0) {
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)
}
##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) {
OutputsCrit <- list(NA)
names(OutputsCrit) <- c("CritValue")
return(OutputsCrit)
}
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")
}
##ErrorCrit______________________________________
Numer <- sum((VarSim - VarObs)^2, na.rm = TRUE)
Denom <- sum(!is.na(VarObs))
if (Numer == 0) {
Crit <- 0
} else {
Crit <- sqrt(Numer / Denom)
}
if (is.numeric(Crit) & is.finite(Crit)) {
CritValue <- Crit
}
##Verbose______________________________________
if (verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue))
}
##Output_________________________________________
OutputsCrit <- list(CritValue = CritValue,
CritName = CritName,
CritBestValue = CritBestValue,
Multiplier = Multiplier,
Ind_notcomputed = Ind_TS_ignore
)
return(OutputsCrit)
} }
##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){ OutputsCrit <- list(NA); names(OutputsCrit) <- c("CritValue"); return(OutputsCrit); }
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") }
##ErrorCrit______________________________________
Numer <- sum((VarSim-VarObs)^2,na.rm=TRUE);
Denom <- sum(!is.na(VarObs));
if(Numer==0){ Crit <- 0; } else { Crit <- sqrt(Numer/Denom); }
if(is.numeric(Crit) & is.finite(Crit)){ CritValue <- Crit; }
##Verbose______________________________________
if(verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue))
}
##Output_________________________________________
OutputsCrit <- list(CritValue = CritValue, CritName = CritName, CritBestValue = CritBestValue,
Multiplier = Multiplier, Ind_notcomputed = Ind_TS_ignore)
return(OutputsCrit)
}
Markdown is supported
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