SimGR.R 3.85 KB
Newer Older
1
SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2", "RMSE"),
unknown's avatar
unknown committed
2
                  WupPer = NULL, SimPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) {
3

4
5
6
  EffCrit <- match.arg(arg = EffCrit)
  EffCrit <- sprintf("ErrorCrit_%s", EffCrit)
  FUN_CRIT <- get(EffCrit)
7

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
  if (!inherits(PrepGR, "PrepGR")) {
16
    stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
unknown's avatar
unknown committed
17
  }
18

19
20
21
22
23
24
25
  if (!missing(CalGR)) {
    warning("Deprecated \"CalGR\" argument. Use \"Param\" instead")
  }
  ### to remove when the CalGR will be removed
  if (missing(Param)) {
    Param <- NULL
  }
26
  if (!inherits(CalGR, "CalGR") & !is.null(CalGR)) {
unknown's avatar
unknown committed
27
28
29
    stop("Non convenient data  for argument \"CalGR\". Must be of class \"CalGR\"")
  }
  if (is.null(CalGR) & is.null(Param)) {
30
    stop("Arguments \"CalGR\" and \"Param\" are missing, with no default. You must fill in one of these two arguments")
unknown's avatar
unknown committed
31
32
33
34
  }
  if (is.null(Param)) {
    Param <- CalGR$OutputsCalib$ParamFinalR
  }
35
36
37
38
  ###
  if (inherits(Param, "CalGR")) {
    Param <- Param$OutputsCalib$ParamFinalR
  }
39

unknown's avatar
unknown committed
40
41
42
  WupInd <- NULL
  if (!is.null(WupPer)) {
    WupPer <- as.POSIXct(WupPer, tz = "UTC")
43
44
45
    if (length(WupPer) != 2) {
      stop("Warm-up period \"WupPer\" must be of length 2")
    }
unknown's avatar
unknown committed
46
47
48
    if (any(is.na(WupPer))) {
      stop("Non convenient date format for the warm-up period \"WupPer\"")
    } else {
49
      if (!any(PrepGR$InputsModel$DatesR == WupPer[1]) | !any(PrepGR$InputsModel$DatesR == WupPer[2])) {
unknown's avatar
unknown committed
50
51
        stop("Non convenient date for the warm-up period \"WupPer\"")
      } else {
52
        WupInd <- which(PrepGR$InputsModel$DatesR == WupPer[1]):which(PrepGR$InputsModel$DatesR == WupPer[2])
unknown's avatar
unknown committed
53
54
55
      }
    }
  }
56

unknown's avatar
unknown committed
57
  SimPer <- as.POSIXct(SimPer, tz = "UTC")
58
59
60
  if (length(SimPer) != 2) {
    stop("Simulation period \"SimPer\" must be of length 2")
  }
unknown's avatar
unknown committed
61
62
63
  if (any(is.na(SimPer))) {
    stop("Non convenient date format for the simulation period \"SimPer\"")
  } else {
64
    if (!any(PrepGR$InputsModel$DatesR == SimPer[1]) | !any(PrepGR$InputsModel$DatesR == SimPer[2])) {
unknown's avatar
unknown committed
65
66
      stop("Non convenient date for the simulation period \"SimPer\"")
    } else {
67
      SimInd <- which(PrepGR$InputsModel$DatesR == SimPer[1]):which(PrepGR$InputsModel$DatesR == SimPer[2])
unknown's avatar
unknown committed
68
69
    }
  }
70

71
72

  MOD_opt <- CreateRunOptions(FUN_MOD = get(PrepGR$TypeModel), InputsModel = PrepGR$InputsModel,
unknown's avatar
unknown committed
73
74
                              IndPeriod_WarmUp = WupInd, IndPeriod_Run = SimInd, verbose = verbose)

75

76
77
78
79
80
81
82
  # NA in Qobs
  isQobs <- !all(is.na(PrepGR$Qobs))
  isQobsSimPer <- !all(is.na(PrepGR$Qobs[SimInd]))
  if (!isQobs) {
    warning("\"PrepGR\" does not contain any Qobs values. The efficiency criterion is not computed")
  } else if (!isQobsSimPer) {
    message("\"PrepGR\" does not contain any Qobs values on \"SimPer\". The efficiency criterion is not computed")
83
  }
84
85
86


  SIM <- RunModel(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt,
87
                  Param = Param, FUN_MOD = get(PrepGR$TypeModel))
88
89


90
91
92
  if (isQobsSimPer) {
    MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = PrepGR$InputsModel,
                                RunOptions = MOD_opt, Obs = PrepGR$Qobs[SimInd], transfo = transfo)
93
94
    CRT <- ErrorCrit(InputsCrit = MOD_crt, OutputsModel = SIM, verbose = verbose)
  } else {
95
    MOD_crt <- NULL
96
97
    CRT <- NULL
  }
98
99


100
101
  SimGR <- list(OptionsSimul = MOD_opt, OptionsCrit = MOD_crt, OutputsModel = SIM, Qobs = PrepGR$Qobs[SimInd],
                TypeModel = PrepGR$TypeModel,
unknown's avatar
unknown committed
102
                CalCrit = CalGR$CalCrit, EffCrit = CRT,
103
                PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"),
unknown's avatar
unknown committed
104
                                   Run    = SimPer))
105
  class(SimGR) <- c("SimGR", "GR")
106
107
108
  return(SimGR)

}