Skip to content
GitLab
Select Git revision
  • dev default
  • master
  • 136-decreased-performance-of-calibration-execution-time
  • 115-add-pcict-date-format-managment
  • 118-plot-outputsmodel-remove-case-sensitivity-to-the-which-argument
  • 96-parallelize-the-grid-screening-step-during-calibration
  • 60-migrate-transfoparam-functions-and-createcaliboptions-to-s3-methods
  • airGRplus
  • cleanAirGRplus
  • 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
  • CRAN_v1.4.3.65
  • CRAN_v1.4.3.60
  • CRAN_v1.4.3.52
  • CRAN_v1.3.2.42
  • CRAN_v1.3.2.41
  • CRAN_v1.3.2.40
  • CRAN_v1.3.2.39
  • CRAN_v1.3.2.23
  • CRAN_v1.3.2.17
  • CRAN_v1.2.13.16
  • CRAN_v1.2.13.13
  • CRAN_v1.0.14.1
Find file BlameHistoryPermalink
Forked from HYCAR-Hydro / airGR
Source project has a limited visibility.
ErrorCrit_RMSE.R 4.17 KiB
1 
ErrorCrit_RMSE <- function(InputsCrit, OutputsModel, warnings = TRUE, verbose = TRUE) {
2
3
4 
  ##Arguments_check________________________________
5 
  if (!inherits(InputsCrit, "InputsCrit")) {
6 
    stop("InputsCrit must be of class 'InputsCrit'")
7 
  }
8 
  if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) {
9 
    stop("InputsCrit must be of class 'Single'. Use the ErrorCrit function on objects of class 'Multi' with RMSE")
10 
  }
11 
  if (!inherits(OutputsModel, "OutputsModel")) {
12 
    stop("OutputsModel must be of class 'OutputsModel'")
13 
  }
14
15
16 
  ##Initialisation_________________________________
17 
  CritName <- NA
18 
  CritVar  <- InputsCrit$varObs
19 
  if (InputsCrit$transfo == "") {
20 
    CritName <- "RMSE[CritVar]"
21 
  }
22 
  if (InputsCrit$transfo == "sqrt") {
23 
    CritName <- "RMSE[sqrt(CritVar)]"
24 
  }
25 
  if (InputsCrit$transfo == "log") {
26 
    CritName <- "RMSE[log(CritVar)]"
27 
  }
28 
  if (InputsCrit$transfo == "inv") {
29 
    CritName <- "RMSE[1/CritVar]"
30 
  }
31 
  if (InputsCrit$transfo == "sort") {
32 
    CritName <- "RMSE[sort(CritVar)]"
33 
  }
34 
  CritName      <- gsub(pattern = "CritVar", replacement = CritVar, x = CritName)
35 
  CritValue     <- NA
36 
  CritBestValue <- +1
37 
  Multiplier    <- +1
38 
  ### must be equal to -1 or +1 only
39
40
41 
  ##Data_preparation_______________________________
42 
  VarObs <- InputsCrit$obs
43 
  VarObs[!InputsCrit$BoolCrit] <- NA
44 
  VarSim <- OutputsModel$Qsim
45 
  VarSim[!InputsCrit$BoolCrit] <- NA
46
47 
  ##Data_transformation
48 
  if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) {
49 
    if (any(VarObs %in% 0)) {
50 
      warning("zeroes detected in Qobs: the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL")
51 
    }
52 
    if (any(VarSim %in% 0)) {
53 
      warning("zeroes detected in Qsim: the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL")
54 
    }
55 
  }
56 
  if ("epsilon" %in% names(InputsCrit) & !is.null(InputsCrit$epsilon)) {
57 
    VarObs <- VarObs + InputsCrit$epsilon
58 
    VarSim <- VarSim + InputsCrit$epsilon
59 
  }
60 
  if (InputsCrit$transfo == "sqrt") {
61 
    VarObs <- sqrt(VarObs)
62 
    VarSim <- sqrt(VarSim)
63 
  }
64 
  if (InputsCrit$transfo == "log") {
65 
    VarObs <- log(VarObs)
66 
    VarSim <- log(VarSim)
67 
    VarSim[VarSim      < -1e100] <- NA
68 
  }
69 
  if (InputsCrit$transfo == "inv") {
70 
    VarObs <- 1 / VarObs
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
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), "\n") } ##Output_________________________________________ OutputsCrit <- list(CritValue = CritValue, CritName = CritName, CritBestValue = CritBestValue, Multiplier = Multiplier, Ind_notcomputed = Ind_TS_ignore ) class(OutputsCrit) <- c("RMSE", "ErrorCrit") return(OutputsCrit)
141142
}