CalGR.R 3.26 KB
Newer Older
1
CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"), 
unknown's avatar
unknown committed
2
3
                  WupPer = NULL, CalPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) {
  
4
5
6
7
  CalCrit <- match.arg(arg = CalCrit)
  CalCrit <- sprintf("ErrorCrit_%s", CalCrit)
  FUN_CRIT <- get(CalCrit)
  
8
9
10
11
12
  if (! any(transfo %in% c("", "sqrt", "log", "inv", "sort"))) {
    stop("Non convenient transformation \"transfo\"")
  } else {
    transfo <- transfo[1L]
  }
13
14
  
  
15
16
  if (! any(class(PrepGR) %in% "PrepGR")) {
    stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
unknown's avatar
unknown committed
17
18
  }
  
19
20
21
22
23
  isQobs <- !all(is.na(PrepGR$Qobs))
  if (!isQobs) {
    stop("\"PrepGR\" does not contain any Qobs values. It is not possible to calibrate the model")
  }
  
unknown's avatar
unknown committed
24
25
26
  WupInd <- NULL
  if (!is.null(WupPer)) {
    WupPer <- as.POSIXct(WupPer, tz = "UTC")
27
28
29
    if (length(WupPer) != 2) {
      stop("Warm-up period \"WupPer\" must be of length 2")
    }
unknown's avatar
unknown committed
30
31
32
    if (any(is.na(WupPer))) {
      stop("Non convenient date format for the warm-up period \"WupPer\"")
    } else {
33
      if (!any(PrepGR$InputsModel$DatesR == WupPer[1]) | !any(PrepGR$InputsModel$DatesR == WupPer[2])) {
unknown's avatar
unknown committed
34
35
        stop("Non convenient date for the warm-up period \"WupPer\"")
      } else {
36
        WupInd <- which(PrepGR$InputsModel$DatesR == WupPer[1]):which(PrepGR$InputsModel$DatesR == WupPer[2])
unknown's avatar
unknown committed
37
38
39
40
41
      }
    }
  }
  
  CalPer <- as.POSIXct(CalPer, tz = "UTC")
42
43
44
  if (length(CalPer) != 2) {
    stop("Calibration period \"CalPer\" must be of length 2")
  }
unknown's avatar
unknown committed
45
46
47
  if (any(is.na(CalPer))) {
    stop("Non convenient date format for the calibration period \"CalPer\"")
  } else {
48
    if (!any(PrepGR$InputsModel$DatesR == CalPer[1]) | !any(PrepGR$InputsModel$DatesR == CalPer[2])) {
unknown's avatar
unknown committed
49
50
      stop("Non convenient date for the calibration period \"CalPer\"")
    } else {
51
      CalInd <- which(PrepGR$InputsModel$DatesR == CalPer[1]):which(PrepGR$InputsModel$DatesR == CalPer[2])
unknown's avatar
unknown committed
52
53
54
55
56
    }
  }
  
  
  
57
  MOD_opt <- CreateRunOptions(FUN_MOD = get(PrepGR$TypeModel), InputsModel = PrepGR$InputsModel, 
unknown's avatar
unknown committed
58
59
60
                              IndPeriod_WarmUp = WupInd, IndPeriod_Run = CalInd, verbose = FALSE) 
  
  
61
  MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = PrepGR$InputsModel, 
62
                              RunOptions = MOD_opt, Obs = PrepGR$Qobs[CalInd], transfo = transfo)
unknown's avatar
unknown committed
63
64
  
  
65
  CAL_opt <- CreateCalibOptions(FUN_MOD = get(PrepGR$TypeModel), FUN_CALIB = Calibration_Michel)
unknown's avatar
unknown committed
66
67
  
  
68
  CAL <- Calibration(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt,
unknown's avatar
unknown committed
69
                     InputsCrit = MOD_crt,  CalibOptions = CAL_opt,
70
                     FUN_MOD = get(PrepGR$TypeModel), FUN_CRIT = FUN_CRIT,
71
                     FUN_CALIB = Calibration_Michel, verbose = verbose)
unknown's avatar
unknown committed
72
73
  
  
74
75
  SIM <- RunModel(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt,
                  Param = CAL$ParamFinalR, FUN_MOD = get(PrepGR$TypeModel))
unknown's avatar
unknown committed
76
77
  
  
78
  CalGR <- list(OptionsCalib = MOD_opt, Qobs = PrepGR$Qobs[CalInd],
unknown's avatar
unknown committed
79
                OutputsCalib = CAL, OutputsModel = SIM,
80
                TypeModel = PrepGR$TypeModel, CalCrit = CalCrit,
81
                PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"),
unknown's avatar
unknown committed
82
                                   Run    = CalPer))
83
  class(CalGR) <- c("CalGR", "GR", "airGRt")
unknown's avatar
unknown committed
84
85
86
  return(CalGR)  
  
}