SimGR.R 3.14 KB
Newer Older
1
SimGR <- function(PrepGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", "KGE2", "RMSE"),
unknown's avatar
unknown committed
2
3
                  WupPer = NULL, SimPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) {
 
4
5
  if (! any(class(PrepGR) %in% "PrepGR")) {
    stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
unknown's avatar
unknown committed
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
  }
  
  if (! any(class(CalGR) %in% "CalGR") & !is.null(CalGR)) {
    stop("Non convenient data  for argument \"CalGR\". Must be of class \"CalGR\"")
  }
  if (is.null(CalGR) & is.null(Param)) {
    stop("Arguments \"CalGR\" and \"Param\" are missing, with no default. You must fill in one of these two arguments.")
  }
  
  if (is.null(Param)) {
    Param <- CalGR$OutputsCalib$ParamFinalR
  }
  
  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 {
25
      if (!any(PrepGR$InputsModel$DatesR == WupPer[1]) | !any(PrepGR$InputsModel$DatesR == WupPer[2])) {
unknown's avatar
unknown committed
26
27
        stop("Non convenient date for the warm-up period \"WupPer\"")
      } else {
28
        WupInd <- which(PrepGR$InputsModel$DatesR == WupPer[1]):which(PrepGR$InputsModel$DatesR == WupPer[2])
unknown's avatar
unknown committed
29
30
31
32
33
34
35
36
      }
    }
  }
 
  SimPer <- as.POSIXct(SimPer, tz = "UTC")
  if (any(is.na(SimPer))) {
    stop("Non convenient date format for the simulation period \"SimPer\"")
  } else {
37
    if (!any(PrepGR$InputsModel$DatesR == SimPer[1]) | !any(PrepGR$InputsModel$DatesR == SimPer[2])) {
unknown's avatar
unknown committed
38
39
      stop("Non convenient date for the simulation period \"SimPer\"")
    } else {
40
      SimInd <- which(PrepGR$InputsModel$DatesR == SimPer[1]):which(PrepGR$InputsModel$DatesR == SimPer[2])
unknown's avatar
unknown committed
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
    }
  }
  
  if (! any(EffCrit %in% c("NSE", "KGE", "KGE2", "RMSE"))) {
    stop("Non convenient efficiency criteria \"EffCrit\"")
  } else {
    EffCrit <- EffCrit[1L]
    EffCrit <- sprintf("ErrorCrit_%s", EffCrit)
    FUN_CRIT <- get(EffCrit)
  }
  
  if (! any(transfo %in% c("", "sqrt", "log", "inv", "sort"))) {
    stop("Non convenient transformation \"transfo\"")
  } else {
    transfo <- transfo[1L]
  }  
  
58
  MOD_opt <- CreateRunOptions(FUN_MOD = get(PrepGR$TypeModel), InputsModel = PrepGR$InputsModel, 
unknown's avatar
unknown committed
59
60
61
                              IndPeriod_WarmUp = WupInd, IndPeriod_Run = SimInd, verbose = verbose)

  
62
63
  MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = PrepGR$InputsModel, 
                              RunOptions = MOD_opt, Qobs = PrepGR$Qobs[SimInd], transfo = transfo)  
unknown's avatar
unknown committed
64
65
  
  
66
67
  SIM <- RunModel(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt, 
                  Param = Param, FUN_MOD =  get(PrepGR$TypeModel))
unknown's avatar
unknown committed
68
69
70
71
72
  
  
  CRT <- ErrorCrit(InputsCrit = MOD_crt, OutputsModel = SIM, FUN_CRIT = FUN_CRIT, verbose = verbose)

  
73
74
  SimGR <- list(OptionsSimul = MOD_opt, OptionsCrit = MOD_crt, OutputsModel = SIM, Qobs = PrepGR$Qobs[SimInd],
                TypeModel = PrepGR$TypeModel,
unknown's avatar
unknown committed
75
                CalCrit = CalGR$CalCrit, EffCrit = CRT,
76
                PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)]),
unknown's avatar
unknown committed
77
78
79
80
81
                                   Run    = SimPer))
  class(SimGR) <- c("SimGR", "GR")
  return(SimGR)  
  
}