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