Forked from HYCAR-Hydro / airGR
Source project has a limited visibility.
ErrorCrit_KGE2.R 3.31 KiB
ErrorCrit_KGE2 <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE) {
  ## Arguments check
  if (!inherits(OutputsModel, "OutputsModel")) {
    stop("'OutputsModel' must be of class 'OutputsModel'")
  OutputsCritCheck <- .ErrorCrit(InputsCrit = InputsCrit, crit = "RMSE")
  if (!OutputsCritCheck$CritCompute) {
    CritValue <- NA
  } else {
    ## Other variables preparation
    meanVarObs <- mean(VarObs[!TS_ignore])
    meanVarSim <- mean(VarSim[!TS_ignore])
    iCrit         <- 0
    SubCritPrint  <- NULL
    SubCritNames  <- NULL
    SubCritValues <- NULL
    ## SubErrorCrit KGE rPearson
    iCrit <- iCrit + 1
    SubCritPrint[iCrit]  <- paste(CritName, " cor(sim, obs, \"pearson\") =", sep = "")
    SubCritValues[iCrit] <- NA
    SubCritNames[iCrit]  <- "r"
    Numer <- sum((VarObs[!TS_ignore] - meanVarObs) * (VarSim[!TS_ignore] - meanVarSim))
    Deno1 <- sqrt(sum((VarObs[!TS_ignore] - meanVarObs)^2))
    Deno2 <- sqrt(sum((VarSim[!TS_ignore] - meanVarSim)^2))
    if (Numer == 0) {
      if (Deno1 == 0 & Deno2 == 0) {
        Crit <- 1
      } else {
        Crit <- 0
    } else {
      Crit  <- Numer / (Deno1 * Deno2)
    if (is.numeric(Crit) & is.finite(Crit)) {
      SubCritValues[iCrit] <- Crit
    ## SubErrorCrit KGE gamma
    iCrit <- iCrit + 1
    SubCritPrint[iCrit]  <- paste(CritName, " cv(sim)/cv(obs)          =", sep = "")
    SubCritValues[iCrit] <- NA
    SubCritNames[iCrit]  <- "gamma"
    if (meanVarSim == 0) {
      if (sd(VarSim[!TS_ignore]) == 0) {
        CVsim <- 1
      } else {
        CVsim <- 99999
    } else {
      CVsim <- sd(VarSim[!TS_ignore]) / meanVarSim
    if (meanVarObs == 0) {
      if (sd(VarObs[!TS_ignore]) == 0) {
        CVobs <- 1
      } else {
        CVobs <- 99999
    } else {
      CVobs <- sd(VarObs[!TS_ignore]) / meanVarObs
    if (CVsim == 0 &
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121
CVobs == 0) { Crit <- 1 } else { Crit <- CVsim / CVobs } if (is.numeric(Crit) & is.finite(Crit)) { SubCritValues[iCrit] <- Crit } ## SubErrorCrit KGE beta iCrit <- iCrit + 1 SubCritPrint[iCrit] <- paste(CritName, " mean(sim)/mean(obs) =", sep = "") SubCritValues[iCrit] <- NA SubCritNames[iCrit] <- "beta" if (meanVarSim == 0 & meanVarObs == 0) { Crit <- 1 } else { Crit <- meanVarSim / meanVarObs } if (is.numeric(Crit) & is.finite(Crit)) { SubCritValues[iCrit] <- Crit } ## ErrorCrit if (sum(is.na(SubCritValues)) == 0) { CritValue <- (1 - sqrt((SubCritValues[1] - 1)^2 + (SubCritValues[2] - 1)^2 + (SubCritValues[3] - 1)^2)) } ## Verbose if (verbose) { message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue)) message(paste("\tSubCrit.", SubCritPrint, sprintf("%.4f", SubCritValues), "\n", sep = " ")) } } ## Output OutputsCrit <- list(CritValue = CritValue, CritName = CritName, SubCritValues = SubCritValues, SubCritNames = SubCritNames, CritBestValue = CritBestValue, Multiplier = Multiplier, Ind_notcomputed = Ind_TS_ignore) class(OutputsCrit) <- c("KGE2", "ErrorCrit") return(OutputsCrit) }