SimGR.R 3.33 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
  }
  
  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)) {
12
    stop("Arguments \"CalGR\" and \"Param\" are missing, with no default. You must fill in one of these two arguments")
unknown's avatar
unknown committed
13
14
15
16
17
18
19
20
21
  }
  
  if (is.null(Param)) {
    Param <- CalGR$OutputsCalib$ParamFinalR
  }
  
  WupInd <- NULL
  if (!is.null(WupPer)) {
    WupPer <- as.POSIXct(WupPer, tz = "UTC")
22
23
24
    if (length(WupPer) != 2) {
      stop("Warm-up period \"WupPer\" must be of length 2")
    }
unknown's avatar
unknown committed
25
26
27
    if (any(is.na(WupPer))) {
      stop("Non convenient date format for the warm-up period \"WupPer\"")
    } else {
28
      if (!any(PrepGR$InputsModel$DatesR == WupPer[1]) | !any(PrepGR$InputsModel$DatesR == WupPer[2])) {
unknown's avatar
unknown committed
29
30
        stop("Non convenient date for the warm-up period \"WupPer\"")
      } else {
31
        WupInd <- which(PrepGR$InputsModel$DatesR == WupPer[1]):which(PrepGR$InputsModel$DatesR == WupPer[2])
unknown's avatar
unknown committed
32
33
34
35
36
      }
    }
  }
 
  SimPer <- as.POSIXct(SimPer, tz = "UTC")
37
38
39
  if (length(SimPer) != 2) {
    stop("Simulation period \"SimPer\" must be of length 2")
  }
unknown's avatar
unknown committed
40
41
42
  if (any(is.na(SimPer))) {
    stop("Non convenient date format for the simulation period \"SimPer\"")
  } else {
43
    if (!any(PrepGR$InputsModel$DatesR == SimPer[1]) | !any(PrepGR$InputsModel$DatesR == SimPer[2])) {
unknown's avatar
unknown committed
44
45
      stop("Non convenient date for the simulation period \"SimPer\"")
    } else {
46
      SimInd <- which(PrepGR$InputsModel$DatesR == SimPer[1]):which(PrepGR$InputsModel$DatesR == SimPer[2])
unknown's avatar
unknown committed
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
    }
  }
  
  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]
  }  
  
64
  MOD_opt <- CreateRunOptions(FUN_MOD = get(PrepGR$TypeModel), InputsModel = PrepGR$InputsModel, 
unknown's avatar
unknown committed
65
66
67
                              IndPeriod_WarmUp = WupInd, IndPeriod_Run = SimInd, verbose = verbose)

  
68
  MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = PrepGR$InputsModel, 
69
                              RunOptions = MOD_opt, Obs = PrepGR$Qobs[SimInd], transfo = transfo)  
unknown's avatar
unknown committed
70
71
  
  
72
  SIM <- RunModel(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt, 
73
                  Param = Param, FUN_MOD = get(PrepGR$TypeModel))
unknown's avatar
unknown committed
74
75
  
  
76
  CRT <- ErrorCrit(InputsCrit = MOD_crt, OutputsModel = SIM, verbose = verbose)
unknown's avatar
unknown committed
77
78

  
79
80
  SimGR <- list(OptionsSimul = MOD_opt, OptionsCrit = MOD_crt, OutputsModel = SIM, Qobs = PrepGR$Qobs[SimInd],
                TypeModel = PrepGR$TypeModel,
unknown's avatar
unknown committed
81
                CalCrit = CalGR$CalCrit, EffCrit = CRT,
82
                PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"),
unknown's avatar
unknown committed
83
                                   Run    = SimPer))
84
  class(SimGR) <- c("SimGR", "GR", "airGRt")
unknown's avatar
unknown committed
85
86
87
  return(SimGR)  
  
}