diff --git a/DESCRIPTION b/DESCRIPTION index 029b5ae56d050ffa073d34b9f3a921e421809b50..7aa7e0616150aea0fbc43faa8816741def7a05d2 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.0.13.3 +Version: 1.0.13.4 Date: 2018-08-29 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), diff --git a/NEWS.rmd b/NEWS.rmd index 8abc58225e300bbe97535dc53fbe6acf2a207ba2..d0031bae0aed996a1037c71eee85e570d39cb454 100644 --- a/NEWS.rmd +++ b/NEWS.rmd @@ -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 diff --git a/R/ErrorCrit_RMSE.R b/R/ErrorCrit_RMSE.R index c0c6731913e90fe51ab757c41d035edaee7795c9..e137ee09fd123456fd12ba48d4652cadb4e05179 100644 --- a/R/ErrorCrit_RMSE.R +++ b/R/ErrorCrit_RMSE.R @@ -1,70 +1,130 @@ -ErrorCrit_RMSE <- function(InputsCrit,OutputsModel, warnings = TRUE, verbose = TRUE){ - - -##Arguments_check________________________________ - if(inherits(InputsCrit,"InputsCrit")==FALSE){ stop("InputsCrit must be of class 'InputsCrit' \n"); return(NULL); } - if(inherits(OutputsModel,"OutputsModel")==FALSE){ stop("OutputsModel must be of class 'OutputsModel' \n"); return(NULL); } - - -##Initialisation_________________________________ - CritName <- NA; - if(InputsCrit$transfo=="" ){ CritName <- "RMSE[Q]" ; } - 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)]"; } - - CritValue <- NA; - CritBestValue <- +1; - Multiplier <- +1; ### must be equal to -1 or +1 only - - -##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) +ErrorCrit_RMSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE) { + + + ##Arguments_check________________________________ + if (inherits(InputsCrit, "InputsCrit") == FALSE) { + stop("InputsCrit must be of class 'InputsCrit' \n") + return(NULL) + } + if (inherits(OutputsModel, "OutputsModel") == FALSE) { + stop("OutputsModel must be of class 'OutputsModel' \n") + return(NULL) + } + + + ##Initialisation_________________________________ + CritName <- NA + if (InputsCrit$transfo == "") { + CritName <- "RMSE[Q]" + } + 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)]" + } + CritValue <- NA + CritBestValue <- +1 + Multiplier <- +1 + ### must be equal to -1 or +1 only + + + ##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) - -} - -