server.R 40.8 KB
Newer Older
1
2
# server.R

3
shinyServer(function(input, output, session) {
4
5
  
  
6
  
7
8
9
10
11
12
13
14
15
16
17
18
  ## --------------- List of input names
  
  getInputs <- reactive({
    inputList <- sort(names(reactiveValuesToList(input)))
    inputList <- inputList[!grepl("^dy", inputList)]
    inputList <- inputList[!grepl("^CalButton", inputList)]
    inputList <- c(inputList, "DownloadTab", "DownloadPlot")
    return(inputList)
  })
  
  
  
19
20
  ## --------------- Data preparation
  
21
  getPrep <- reactive({
22
    
23
    TMGR  <- .TypeModelGR(input$HydroModel)
24
    PARAM <- c(input$X1, input$X2, input$X3, input$X4, input$X5, input$X6)[seq_len(TMGR$NbParam)]
25
    
26
    if (input$SnowModel == "CemaNeige") {
27
28
      PARAM <- c(PARAM, input$C1, input$C2)
    }
29
30
31
32
    # if (input$Dataset == "Unnamed watershed") {
    if (input$Dataset == "Unnamed watershed") {
      ObsBV <- NULL
    } else {
33
34
      # ObsBV <- get(input$Dataset)
      ObsBV <- .ShinyGR.args$ObsBV[[input$Dataset]]
35
    }
36
37
38
39
40
41
42
43
44
45
46
    PREP <- PrepGR(ObsBV = ObsBV,
                   DatesR = .ShinyGR.args$DatesR,
                   Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap,
                   Qobs = .ShinyGR.args$Qobs, TempMean = .ShinyGR.args$TempMean, 
                   ZInputs = .ShinyGR.args$ZInputs[[input$Dataset]],
                   HypsoData = .ShinyGR.args$HypsoData[[input$Dataset]],
                   NLayers = .ShinyGR.args$NLayers[[input$Dataset]],
                   HydroModel = input$HydroModel,
                   CemaNeige = input$SnowModel == "CemaNeige")
    
    WUPPER <- c(PREP$InputsModel$DatesR[1L], input$Period[1]-.TypeModelGR(PREP)$TimeLag)
47
48
49
50
    if (WUPPER[2] < WUPPER[1]) {
      WUPPER[2] <- WUPPER[1]
    }
    
51
    ## Enable or disable automatic calibration (if there is Qobs or not)
52
    isQobs <- !all(is.na(PREP$Qobs[PREP$InputsModel$Dates >= input$Period[1] & PREP$InputsModel$Dates <= input$Period[2]]))
53
    if (isQobs | input$Period[1L] != input$Period[2L]) {
54
      shinyjs::enable("CalButton")
55
56
    }
    if (!isQobs | input$Period[1L] == input$Period[2L]) {
57
58
      shinyjs::disable("CalButton")
    }
59
    
60
    return(list(TMGR = TMGR, PREP = PREP, WUPPER = WUPPER))
61
    
62
  })
63
  
64
  
65
66
67
  
  ## --------------- Calibration
  
68
  ## If the user calibrate the model
69
  CAL_click <- reactiveValues(valueButton = 0)
70
  
unknown's avatar
unknown committed
71
  
72
  ## Automatic calibration
73
  observeEvent(input$CalButton, {
74
75
76
77
78
79
    
    ## Desable all inputs during automatic calibration
    lapply(getInputs(), shinyjs::disable)
    shinyjs::disable("CalButton")
    
    ## Model calibration
80
    CAL_opt <- list(Crit    = gsub(" .*", "", input$TypeCrit),
81
                    Transfo = gsub("1", "inv", gsub("(\\D{3} \\[)(\\w{0,4})(\\W*Q\\W*\\])", "\\2", input$TypeCrit)))
82
    CAL     <- CalGR(PrepGR = getPrep()$PREP, CalCrit = CAL_opt$Crit, transfo = CAL_opt$Transfo,
83
84
                     WupPer = substr(getPrep()$WUPPER, 1, 10),
                     CalPer = substr(c(input$Period[1], input$Period[2]), 1, 10), verbose = FALSE)
85
    PARAM   <- CAL$OutputsCalib$ParamFinalR
86
    
87
88
89
90
    updateSliderInput(session, inputId = "X1", value = PARAM[1L])
    updateSliderInput(session, inputId = "X2", value = PARAM[2L])
    updateSliderInput(session, inputId = "X3", value = PARAM[3L])
    updateSliderInput(session, inputId = "X4", value = PARAM[4L])
91
    if (getPrep()$TMGR$NbParam >= 5) {
92
93
      updateSliderInput(session, inputId = "X5", value = PARAM[5L])
    }
94
    if (getPrep()$TMGR$NbParam >= 6) {
95
96
      updateSliderInput(session, inputId = "X6", value = PARAM[6L])
    }
97
    if (input$SnowModel == "CemaNeige") {
98
99
100
      updateSliderInput(session, inputId = "C1", value = PARAM[length(PARAM)-1])
      updateSliderInput(session, inputId = "C2", value = PARAM[length(PARAM)])
    }
101
102
    updateActionButton(session, inputId = "CalButton", label = "Model calibrated", icon = icon("check"))
    CAL_click$valueButton <- 1
103
104
    
    ## Enable caliration
105
106
107
    if (input$Period[1L] != input$Period[2L]) {
      shinyjs::enable("CalButton")
    }
108
  }, priority = +20)
109
  
unknown's avatar
unknown committed
110
  
111
  ## Manual calibration
112
  observeEvent({input$Dataset ; input$HydroModel ; input$SnowModel ;
113
114
115
116
117
118
119
120
    input$X1 ; input$X2 ; input$X3 ; input$X4 ; input$X5 ; input$X6 ;
    input$TypeCrit ; input$Period}, {
      CAL_click$valueButton <-  CAL_click$valueButton - 1
      CAL_click$valueButton <- ifelse(CAL_click$valueButton < -1, -1, CAL_click$valueButton)
      if (CAL_click$valueButton < 0) {
        updateActionButton(session, inputId = "CalButton", label = "Run", icon = icon("refresh"))
      }
      
121
      ## Enable all inputs except automatic calibration
122
123
124
      if (input$Period[1L] != input$Period[2L]) {
        lapply(getInputs(), shinyjs::enable)
      }
125
126
127
    })
  
  
128
  
129
  ## --------------- Simulation
130
  
131
  getSim <- reactive({
132
    PARAM <- c(input$X1, input$X2, input$X3, input$X4, input$X5, input$X6)[seq_len(getPrep()$TMGR$NbParam)]
133
    if (input$SnowModel == "CemaNeige") {
134
      PARAM <- c(PARAM, input$C1, input$C2)
135
    }
136
    
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
    
    
    
    # if (dateWindow[1L] == dateWindow[2L]) {
    #   if (dateWindow[1L] == as.POSIXct(.ShinyGR.args$SimPer[2L], tz = "UTC")) {
    #     updateSliderInput(session, inputId = "Period",
    #                       value = dateWindow - c(1, 0) * .TypeModelGR(input$HydroModel)$TimeLag)
    #   } else {
    #     updateSliderInput(session, inputId = "Period",
    #                       value = dateWindow + c(0, 1) * .TypeModelGR(input$HydroModel)$TimeLag)
    #   }
    # } else {
    #   
    # }
    # 
    # 
    # 
    # 
    

    
    
    
    
161
    ## Simulated flows computation
162
    SIM <- SimGR(PrepGR = getPrep()$PREP, Param = PARAM,
163
                 WupPer = substr(getPrep()$WUPPER, 1, 10),
164
                 SimPer = substr(c(input$Period[1], input$Period[2]), 1, 10), #substr(c(zzz1, zzz2), 1, 10), #
165
                 verbose = FALSE)
166
    
167
    ## Criteria computation
168
169
    CRIT_opt <- list(Crit    = c("ErrorCrit_NSE", "ErrorCrit_KGE"),
                     Transfo = c("NO", "sqrt", "inv"))
170
171
    CRIT <- lapply(CRIT_opt$Crit, function(iCRIT) {
      Qtransfo <- lapply(CRIT_opt$Transfo, function(iTRSF) {
172
        iInputsCrit <- SIM$OptionsCrit
173
174
        iTRSF <- gsub("NO", "", iTRSF)
        iInputsCrit$transfo <- iTRSF
175
176
177
        iCRIT <- ErrorCrit(InputsCrit = iInputsCrit, OutputsModel = SIM$OutputsModel, FUN_CRIT = get(iCRIT), verbose = FALSE)
        iCRIT <- iCRIT[c("CritName", "CritValue")]
        return(iCRIT)
178
      })
179
      return(Qtransfo)
180
    })
181
    CRIT <- as.data.frame(matrix(na.omit(unlist(CRIT)), ncol = 2, byrow = TRUE), stringsAsFactors = FALSE)
182
    colnames(CRIT) <- c("Criterion", "Value")
183
    rownames(CRIT) <- NULL    
184
185
    CRIT$Value     <- as.numeric(CRIT$Value)
    CRIT$Criterion <- gsub("\\[", " [", CRIT$Criterion)
186
    
187
    ## Recording past simulations
188
    .GlobalEnv$.ShinyGR.hist[[length(.GlobalEnv$.ShinyGR.hist)+1]] <- list(Qsim      = SIM$OutputsModel$Qsim,
189
                                                                           Param     = PARAM,
190
                                                                           TypeModel = SIM$TypeModel,
191
192
                                                                           Crit      = CRIT,
                                                                           Dataset   = input$Dataset)
193
    
194
    .GlobalEnv$.ShinyGR.hist <- .GlobalEnv$.ShinyGR.hist[!(duplicated(sapply(.GlobalEnv$.ShinyGR.hist, function(x) sum(x$Param)), fromLast = TRUE) & 
195
                                                             duplicated(sapply(.GlobalEnv$.ShinyGR.hist, function(x) x$TypeModel), fromLast = TRUE))]
196
    .GlobalEnv$.ShinyGR.hist <- tail(.GlobalEnv$.ShinyGR.hist, n = 2)
197

198
    if (length(.GlobalEnv$.ShinyGR.hist) == 2 &  is.null(names(.GlobalEnv$.ShinyGR.hist[[1]]))) {
199
      .GlobalEnv$.ShinyGR.hist[[1]] <- NULL
200
    }
201
202
203
204
205
    if (length(.GlobalEnv$.ShinyGR.hist) == 2) {
      if (.GlobalEnv$.ShinyGR.hist[[1]]$Dataset != .GlobalEnv$.ShinyGR.hist[[2]]$Dataset) { # reset Qold when new dataset
        .GlobalEnv$.ShinyGR.hist[[1]] <- NULL
      }
    }
206
    if (length(.GlobalEnv$.ShinyGR.hist) == 2 & !is.null(names(.GlobalEnv$.ShinyGR.hist[[1]]))) {
207
208
      isEqualSumQsim   <- sum(.GlobalEnv$.ShinyGR.hist[[1]]$Crit$Value) != sum(.GlobalEnv$.ShinyGR.hist[[2]]$Crit$Value)
      isEqualTypeModel <- .GlobalEnv$.ShinyGR.hist[[1]]$TypeModel == .GlobalEnv$.ShinyGR.hist[[2]]$TypeModel
209
      if (length(.GlobalEnv$.ShinyGR.hist[[1]]$Qsim) != length(.GlobalEnv$.ShinyGR.hist[[2]]$Qsim) |
210
          (isEqualSumQsim & isEqualTypeModel)) {
211
        OBSold <- getPrep()$PREP
212
        OBSold$TypeModel <- .GlobalEnv$.ShinyGR.hist[[1]]$TypeModel
213
        if (.TypeModelGR(OBSold)$CemaNeige & !.TypeModelGR(getPrep()$PREP)$CemaNeige | # present: No CemaNeige ; old: CemaNeige
214
            isEqualSumQsim & isEqualTypeModel) {
215
216
217
          if (input$Dataset == "Unnamed watershed") {
            ObsBV <- NULL
          } else {
218
219
            # ObsBV <- get(input$Dataset)
            ObsBV <- .ShinyGR.args$ObsBV[[input$Dataset]]
220
          }
221
          OBSold <- PrepGR(ObsBV = ObsBV,
222
                          Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap,
223
                          Qobs = .ShinyGR.args$Qobs, TempMean = .ShinyGR.args$TempMean, 
224
225
226
                          ZInputs = .ShinyGR.args$ZInputs[[input$Dataset]],
                          HypsoData = .ShinyGR.args$HypsoData[[input$Dataset]],
                          NLayers = .ShinyGR.args$NLayers[[input$Dataset]],
227
228
                          HydroModel = input$HydroModel,
                          CemaNeige = input$SnowModel == "CemaNeige")
229
        }
230
        SIMold <- SimGR(PrepGR = OBSold,
231
232
233
234
                        Param = .GlobalEnv$.ShinyGR.hist[[1]]$Param,
                        WupPer = substr(getPrep()$WUPPER, 1, 10),
                        SimPer = substr(c(input$Period[1], input$Period[2]), 1, 10),
                        verbose = FALSE)
235
236
        CRITold <- lapply(CRIT_opt$Crit, function(iCRIT) {
          SIM_transfo <- lapply(CRIT_opt$Transfo, function(iTRSF) {
237
238
            iTRSF <- gsub("NO", "", iTRSF)
            SIMold$OptionsCrit$transfo <- iTRSF
239
240
241
242
243
244
245
246
247
248
            iCRITold <- ErrorCrit(InputsCrit = SIMold$OptionsCrit, OutputsModel = SIMold$OutputsModel, FUN_CRIT = get(iCRIT), verbose = FALSE)
            iCRITold <- iCRITold[c("CritName", "CritValue")]
            return(iCRITold)
          })
        })
        CRITold <- as.data.frame(matrix(na.omit(unlist(CRITold)), ncol = 2, byrow = TRUE), stringsAsFactors = FALSE)
        colnames(CRITold) <- c("Criterion", "Value")
        rownames(CRITold) <- NULL    
        CRITold$Value     <- as.numeric(CRITold$Value)
        CRITold$Criterion <- gsub("\\[", " [", CRITold$Criterion)
249
        
250
        .GlobalEnv$.ShinyGR.hist[[1]]$Crit <- CRITold
251
        .GlobalEnv$.ShinyGR.hist[[1]]$Qsim <- SIMold$OutputsModel$Qsim
252
      }
253
254
    }
    
255
    return(list(PARAM = PARAM, SIM = SIM, SIMold = .GlobalEnv$.ShinyGR.hist, Crit = CRIT))
256
257
    
  })
258
  
259
  
260
261
262
263
  
  ## --------------- Plot
  
  ## Choice
264
265
266
267
268
269
270
  getPlotType <- reactive({
    switch(input$PlotType,
           "Model performance" = 1,
           "Flow time series"  = 2,
           "State variables"   = 3,
           "Model diagram"     = 4)
  })
271
  
272
273
274
  
  ## Models available considering the plot type
  observe({
275
    if (getPlotType() == 4) {
276
      updateSelectInput(session, inputId = "HydroModel", choice = c("GR4J", "GR5J", "GR6J"), selected = input$HydroModel)
277
      updateSelectInput(session, inputId = "SnowModel" , choice = c("None"))
278
    } else {
279
      updateSelectInput(session, inputId = "HydroModel", choice = c("GR4J", "GR5J", "GR6J"), selected = input$HydroModel)
280
      updateSelectInput(session, inputId = "SnowModel" , choice = c("None", "CemaNeige")   , selected = input$SnowModel)
281
    }
282
283
  })
  
unknown's avatar
unknown committed
284
  
285
  ## Plots available considering the model type
286
287
288
289
290
291
292
293
294
295
296
  # observe({
  #   if (input$HydroModel == "GR6J") {
  #     updateSelectInput(session, inputId = "PlotType",
  #                       choice = c("Flow time series", "Model performance", "State variables"),
  #                       selected = input$PlotType)
  #   } else {
  #     updateSelectInput(session, inputId = "PlotType",
  #                       choice = c("Flow time series", "Model performance", "State variables", "Model diagram"),
  #                       selected = input$PlotType)
  #   }
  # })
297
298
  
  
299
300
301
302
303
304
305
306
307
308
309
310
311
  # Formated simulation results
  getData <- reactive({
    OutputsModel <- getSim()$SIM$OutputsModel
    IndPlot <- which(OutputsModel$DatesR >= input$Period[1L] & OutputsModel$DatesR <= input$Period[2L])
    OutputsModel2 <- sapply(OutputsModel[seq_len(which(names(OutputsModel) == "Qsim"))], function(x) x[IndPlot])
    OutputsModel2 <- c(OutputsModel2, Qobs = list(getSim()$SIM$Qobs[IndPlot]))
    
    if (length(OutputsModel2$DatesR) != 0) {
      data <- data.frame(DatesR  = OutputsModel2$DatesR,
                         precip. = OutputsModel2$Precip,
                         PET     = OutputsModel2$PotEvap,
                         prod.   = OutputsModel2$Prod,
                         rout.   = OutputsModel2$Rout,
312
313
314
                         # exp.    = rep(NA, length(OutputsModel2$DatesR)),
                         # 'exp. (+)'= rep(NA, length(OutputsModel2$DatesR)),
                         # 'exp. (-)'= rep(NA, length(OutputsModel2$DatesR)),
315
316
317
318
                         Qr      = OutputsModel2$QR,
                         Qd      = OutputsModel2$QD,
                         Qsim    = OutputsModel2$Qsim,
                         Qobs    = OutputsModel2$Qobs,
319
320
                         QsimOld = rep(NA, length(OutputsModel2$DatesR)))
                         # QrExp   = rep(NA, length(OutputsModel2$DatesR)))
321
322
323
324
325
      
      if (length(.GlobalEnv$.ShinyGR.hist) == 2 & input$ShowOldQsim == "Yes") {
        data$QsimOld <- .GlobalEnv$.ShinyGR.hist[[1]]$Qsim
      }
      if (input$HydroModel == "GR6J") {
326
327
328
        data$'exp.'    <- NULL
        data$'exp. (+)'<- ifelse(OutputsModel2$Exp >= 0, OutputsModel2$Exp, NA)
        data$'exp. (-)'<- ifelse(OutputsModel2$Exp <  0, OutputsModel2$Exp, NA)
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
        data$QrExp <- OutputsModel2$QRExp
      }
      
      return(list(OutputsModel = OutputsModel2, Tab = data))
    }
  })
  
  
  ## Period slider responds to changes in the selected/zoomed dateWindow 
  observeEvent({input$dyPlotTS_date_window ; input$dyPlotSVs_date_window; input$dyPlotMDp_date_window}, {
    if (!is.null(input$dyPlotTS_date_window)  && getPlotType() == 2) {
      dateWindow <- as.POSIXct(strftime(input$dyPlotTS_date_window, "%Y-%m-%d %H:%M:%S"), tz = "UTC")
    }
    if (!is.null(input$dyPlotSVq_date_window) && getPlotType() == 3) {
      dateWindow <- as.POSIXct(strftime(input$dyPlotSVq_date_window, "%Y-%m-%d %H:%M:%S"), tz = "UTC")
    }
    if (!is.null(input$dyPlotMDp_date_window) && getPlotType() == 4) {
      dateWindow <- as.POSIXct(strftime(input$dyPlotMDp_date_window, "%Y-%m-%d %H:%M:%S"), tz = "UTC")
    }
    if (exists("dateWindow")) {
      # if (dateWindow[1L] == dateWindow[2L]) {
      #   if (dateWindow[1L] == as.POSIXct(.ShinyGR.args$SimPer[2L], tz = "UTC")) {
      #     updateSliderInput(session, inputId = "Period",
      #                       value = dateWindow - c(1, 0) * .TypeModelGR(input$HydroModel)$TimeLag)
      #   } else {
      #     updateSliderInput(session, inputId = "Period",
      #                       value = dateWindow + c(0, 1) * .TypeModelGR(input$HydroModel)$TimeLag)
      #   }
      # } else {
      if (dateWindow[1L] != dateWindow[2L]) {
        updateSliderInput(session, inputId = "Period",
                          value = dateWindow + .TypeModelGR(input$HydroModel)$TimeLag)
      }
      # }
    }
  }, priority = +100)
  
  
  # observe({
  #   if (getPlotType() == 1) {
  #     if (input$Period[1L] == input$Period[2L]) {
  #       if (input$Period[1L] == as.POSIXct(.ShinyGR.args$SimPer[2L], tz = "UTC")) {
  #         updateSliderInput(session, inputId = "Period",
  #                           value = input$Period - c(1, 0) * .TypeModelGR(input$HydroModel)$TimeLag)
  #       } else {
  #         updateSliderInput(session, inputId = "Period",
  #                           value = input$Period + c(0, 1) * .TypeModelGR(input$HydroModel)$TimeLag)
  #       }
  #     }
  #   }
  # }, priority = +100)
  
  ## Disable all inputs if there is no data
  observe({
    if (input$Period[1L] == input$Period[2L]) {
      inputs <- gsub("Period", "CalButton", getInputs())
      lapply(inputs, shinyjs::disable)
    }
  }, priority = -100)
unknown's avatar
unknown committed
388
  
389
390
391
392
  
  ## Reset period slider responds to dygraphs to mouse clicks
  observeEvent({input$dyPlotTS_click}, {
    updateSliderInput(session, inputId = "Period",
393
                      value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"))
394
395
396
  }, priority = +10)
  observeEvent({input$dyPlotSVs_click}, {
    updateSliderInput(session, inputId = "Period",
397
                      value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"))
398
399
400
  }, priority = +10)
  observeEvent({input$dyPlotSVq_click}, {
    updateSliderInput(session, inputId = "Period",
401
                      value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"))
402
403
404
  }, priority = +10)
  observeEvent({input$dyPlotMDp_click}, {
    updateSliderInput(session, inputId = "Period",
405
                      value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"))
406
407
408
  }, priority = +10)
  observeEvent({input$dyPlotMDe_click}, {
    updateSliderInput(session, inputId = "Period",
409
                      value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"))
410
411
412
  }, priority = +10)
  observeEvent({input$dyPlotMDq_click}, {
    updateSliderInput(session, inputId = "Period",
413
                      value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"))
414
415
  }, priority = +10)
  
416
417
418
419
420
421
422
423
424
425
426
427
428
  ##################
  # observe({
    # print(.ShinyGR.args$SimPer[[input$Dataset]])
    # updateSliderInput(session, inputId = "Period",
    #                   min = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][1L], tz = "UTC"),
    #                   max = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][2L], tz = "UTC"),
    #                   value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"))
    # updateSliderInput(session, inputId = "Event",
    #                   min = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][1L], tz = "UTC"),
    #                   max = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][2L], tz = "UTC"),
    #                   value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][1L], tz = "UTC")+ .TypeModelGR(input$HydroModel)$TimeLag)
  # }, priority = -1000)
  ##################
429
  
unknown's avatar
unknown committed
430
  ## Target date slider
431
432
433
434
435
436
437
438
439
  observeEvent({input$Dataset}, {
    updateSliderInput(session, inputId = "Period",
                      min = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][1L], tz = "UTC"),
                      max = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][2L], tz = "UTC"),
                      value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]], tz = "UTC"))
    # updateSliderInput(session, inputId = "Event",
    #                   min = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][1L], tz = "UTC"),+ .TypeModelGR(input$HydroModel)$TimeLag,
    #                   max = input$Period[2L],
    #                   value = input$Period[1L] + .TypeModelGR(input$HydroModel)$TimeLag)
440
441
  })
  eventReactive({input$Dataset}, {
442
443
444
445
446
    updateSliderInput(session, inputId = "Event", label = "Select the target date:",
                      min = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][1L], tz = "UTC") + .TypeModelGR(input$HydroModel)$TimeLag,
                      max = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][2L], tz = "UTC"),
                      value = as.POSIXct(.ShinyGR.args$SimPer[[input$Dataset]][1L], tz = "UTC"), + .TypeModelGR(input$HydroModel)$TimeLag)
  })
unknown's avatar
unknown committed
447
  observe({
448
  # observeEvent({input$Dataset}, {
449
    updateSliderInput(session, inputId = "Event", label = "Select the target date:",
450
                      min = input$Period[1L] + .TypeModelGR(input$HydroModel)$TimeLag,
unknown's avatar
unknown committed
451
                      max = input$Period[2L])
452
  })
unknown's avatar
unknown committed
453
454
  
  
455
456
457
458
459
460
461
462
  ## Graphical parameters
  getPlotPar <- reactive({
    if (.GlobalEnv$.ShinyGR.args$theme == "Cyborg") {
      col_bg <- "black"
      col_fg <- "white"
      par(bg = col_bg, fg = col_fg, col.axis = col_fg, col.lab = col_fg)
    } else if (.GlobalEnv$.ShinyGR.args$theme == "Flatly") {
      col_bg <- "#2C3E50"
463
      col_fg <- "black"
464
465
466
467
468
469
470
471
      par(bg = col_bg, fg = col_fg, col.axis = col_bg, col.lab = col_bg)
    } else {
      col_bg <- "white"
      col_fg <- "black"
      par(bg = col_bg , fg = col_fg)
    }
    return(list(col_bg = col_bg, col_fg = col_fg, par = par(no.readonly = TRUE)))
  })
472
  
473
474
475
  
  ## Plot model performance
  output$stPlotMP <- renderPlot({
476
477
478
    if (length(getSim()$SIM$OutputsModel$DatesR) < 2) {
      return(NULL)
    }
479
    OutputsModel <- getSim()$SIM$OutputsModel
480
    IndPlot <- which(OutputsModel$DatesR >= input$Period[1L] & OutputsModel$DatesR <= input$Period[2L])
481
482
    par(getPlotPar()$par)
    par(cex.axis = 1.2)
483
484
485
    if (input$SnowModel != "CemaNeige") {
      par(oma = c(20, 0, 0, 0))
    }
486
    plot(OutputsModel, Qobs = getSim()$SIM$Qobs, IndPeriod_Plot = IndPlot, cex.lab = 1.2, cex.axis = 1.4, cex.leg = 1.4)
487
  }, bg = "transparent")
488
  
unknown's avatar
unknown committed
489
  
490
  ## Plot flow time series
491
  output$dyPlotTS <- dygraphs::renderDygraph({
492
493
494
    if (length(getSim()$SIM$OutputsModel$DatesR) < 2) {
      return(NULL)
    }
495
496
    if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
      QsimOld <- getSim()$SIMold[[1]]$Qsim
497
498
499
    } else {
      QsimOld <- NULL
    }
500
    op <- getPlotPar()$par
501
    dg1 <- dyplot(getSim()$SIM, Qsup = QsimOld, Qsup.name = "Qold", RangeSelector = FALSE, LegendShow = "auto",
502
                  col.Q = c(op$fg, "orangered", "grey"), col.Precip = c("#428BCA", "lightblue"))
503
504
    dg1 <- dygraphs::dyOptions(dg1, axisLineColor = op$fg, axisLabelColor = op$fg, retainDateWindow = FALSE)
    dg1 <- dygraphs::dyLegend(dg1, show = "follow", width = 325)
505
506
  })
  
unknown's avatar
unknown committed
507
  
508
  ## Plot state variables stores
509
  output$dyPlotSVs <- dygraphs::renderDygraph({
510
511
512
    if (length(getSim()$SIM$OutputsModel$DatesR) < 2) {
      return(NULL)
    }
513
514
515
516
    # OutputsModel <- getSim()$SIM$OutputsModel
    # data <- data.frame(DatesR = OutputsModel$DatesR,
    #                    prod.  = OutputsModel$Prod,
    #                    rout.  = OutputsModel$Rout)
517

518
519
520
521
522
523
524
525
526
    data <- getData()$Tab[, c("DatesR", "prod.", "rout.", grep("^exp", colnames(getData()$Tab), value = TRUE))]
    data.xts <- xts::xts(data[, -1L], order.by = data$DatesR)

    if (input$HydroModel == "GR6J") {
      colors = c("#00008B", "#008B8B", "#10B510", "#FF0303")
    } else {
      colors = c("#00008B", "#008B8B")
    }
        
527
    op <- getPlotPar()$par
528
    dg2 <- dygraphs::dygraph(data.xts, group = "state_var", ylab = "store [mm]")
529
    dg2 <- dygraphs::dyOptions(dg2, colors = colors,
530
531
532
533
                               fillGraph = TRUE, fillAlpha = 0.3,
                               drawXAxis = FALSE, axisLineColor = op$fg, axisLabelColor = op$fg, retainDateWindow = FALSE)
    dg2 <- dygraphs::dyLegend(dg2, show = "always", width = 325)
    dg2 <- dygraphs::dyCrosshair(dg2, direction = "vertical")
534
535
  })
  
unknown's avatar
unknown committed
536
  
537
  ## Plot state variables Q
538
  output$dyPlotSVq <- dygraphs::renderDygraph({
539
540
541
    if (length(getSim()$SIM$OutputsModel$DatesR) < 2) {
      return(NULL)
    }
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
    # OutputsModel <- getSim()$SIM$OutputsModel
    # IndPlot <- which(OutputsModel$DatesR >= input$Period[1L] & OutputsModel$DatesR <= input$Period[2L])
    # OutputsModel2 <- sapply(OutputsModel[seq_len(which(names(OutputsModel) == "Qsim"))], function(x) x[IndPlot])
    # OutputsModel2 <- c(OutputsModel2, Qobs = list(getSim()$SIM$Qobs[IndPlot]))
    # 
    # data <- data.frame(DatesR = OutputsModel2$DatesR,
    #                    Qr     = OutputsModel2$QR,
    #                    Qd     = OutputsModel2$QD,
    #                    Qsim   = OutputsModel2$Qsim,
    #                    Qobs   = OutputsModel2$Qobs)
    # if (input$HydroModel == "GR6J") {
    #   data$QrExp <- OutputsModel2$QRExp
    # } else {
    #   data$QrExp <- NA
    # }
557
558
559
560
561
562
563
    
    colSelec <- c("DatesR", "Qr", "Qd", grep("^QrExp", colnames(getData()$Tab), value = TRUE), "Qsim", "Qobs")
    if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
      colSelec <- c(colSelec, "QsimOld")
    }
    
    data <- getData()$Tab[, colSelec]
564
    data.xts <- xts::xts(data[, -1L], order.by = data$DatesR)
565
    
566
567
568
569
570
571
572
    if (input$HydroModel == "GR6J") {
      names  <- c("Qd", "Qr", "QrExp")
      colors <- c("#FFD700", "#EE6300", "brown")
    } else {
      names  <- c("Qd", "Qr")
      colors <- c("#FFD700", "#EE6300")
    }
573

574
    op <- getPlotPar()$par
575
576
577
578
    dg3 <- dygraphs::dygraph(data.xts, group = "state_var", ylab = "flow [mm/d]", main = " ")
    dg3 <- dygraphs::dyOptions(dg3, fillAlpha = 1.0,
                               axisLineColor = op$fg, axisLabelColor = op$fg,
                               titleHeight = 10, retainDateWindow = FALSE)
579
580
    dg3 <- dygraphs::dyStackedRibbonGroup(dg3, name = names,
                                          color = colors, strokeBorderColor = "black")
581
582
    dg3 <- dygraphs::dySeries(dg3, name = "Qobs", fillGraph = FALSE, drawPoints = TRUE, color = op$fg)
    dg3 <- dygraphs::dySeries(dg3, name = "Qsim", fillGraph = FALSE, color = "orangered")
583
584
585
    if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
      dg3 <- dygraphs::dySeries(dg3, name = "QsimOld", label = "Qold", fillGraph = FALSE, color = "grey", strokePattern = "dashed")
    }
586
587
    dg3 <- dygraphs::dyCrosshair(dg3, direction = "vertical")
    dg3 <- dygraphs::dyLegend(dg3, show = "always", width = 325)
588
  })
589
  
unknown's avatar
unknown committed
590
  
591
  ## Plot model diagram precipitation
592
  output$dyPlotMDp <- dygraphs::renderDygraph({
593
594
595
596
597
598
    if (length(getSim()$SIM$OutputsModel$DatesR) < 2) {
      return(NULL)
    }
    data <- data.frame(DatesR  = getSim()$SIM$OutputsModel$DatesR,
                       precip. = getSim()$SIM$OutputsModel$Precip)
    # data <- getData()$Tab[, c("DatesR", "precip.")]
599
    data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR)
600
    
601
602
603
604
605
606
607
    dg4 <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = "precip. [mm/d]")
    dg4 <- dygraphs::dyOptions(dg4, colors = "#428BCA", drawXAxis = FALSE, retainDateWindow = FALSE)
    dg4 <- dygraphs::dyBarSeries(dg4, name = "precip.")
    dg4 <- dygraphs::dyAxis(dg4, name = "y", valueRange = c(max(data.xts[, "precip."], na.rm = TRUE), -1e-3))
    dg4 <- dygraphs::dyEvent(dg4, input$Event, color = "orangered")
    dg4 <- dygraphs::dyLegend(dg4, show = "onmouseover", width = 225)
    dg4 <- dygraphs::dyCrosshair(dg4, direction = "vertical")
608
  })
609
  
unknown's avatar
unknown committed
610
  
611
  ## Plot model diagram ETP
612
  output$dyPlotMDe <- dygraphs::renderDygraph({
613
614
615
    if (length(getSim()$SIM$OutputsModel$DatesR) < 2) {
      return(NULL)
    }
616
617
618
    # data <- data.frame(DatesR = getSim()$SIM$OutputsModel$DatesR,
    #                    PET    = getSim()$SIM$OutputsModel$PotEvap)
    data <- getData()$Tab[, c("DatesR", "PET")]
619
    data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR)
620
    
621
    op <- getPlotPar()$par
622
623
624
625
626
627
628
629
    dg5 <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = "PET [mm/d]", main = " ")
    dg5 <- dygraphs::dyOptions(dg5, colors = "#A4C400", drawPoints = TRUE,
                               strokeWidth = 0, pointSize = 2, drawXAxis = FALSE,
                               axisLineColor = op$fg, axisLabelColor = op$fg,
                               titleHeight = 10, retainDateWindow = FALSE)
    dg5 <- dygraphs::dyEvent(dg5, input$Event, color = "orangered")
    dg5 <- dygraphs::dyLegend(dg5, show = "onmouseover", width = 225)
    dg5 <- dygraphs::dyCrosshair(dg5, direction = "vertical")
630
  })
631
  
unknown's avatar
unknown committed
632
  
633
  ## Plot model diagram flow
634
  output$dyPlotMDq <- dygraphs::renderDygraph({
635
636
637
    if (length(getSim()$SIM$OutputsModel$DatesR) < 2) {
      return(NULL)
    }
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
    # if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
    #   QsimOld <- getSim()$SIMold[[1]]$Qsim
    # } else {
    #   QsimOld <- NA
    # }
    # OutputsModel <- getSim()$SIM$OutputsModel
    # IndPlot <- which(OutputsModel$DatesR >= input$Period[1L] & OutputsModel$DatesR <= input$Period[2L])
    # OutputsModel2 <- sapply(OutputsModel[seq_len(which(names(OutputsModel) == "Qsim"))], function(x) x[IndPlot])
    # OutputsModel2 <- c(OutputsModel2, Qobs = list(getSim()$SIM$Qobs[IndPlot]))
    # OutputsModel2$Qsim <- ifelse(format(OutputsModel2$DatesR, "%Y%m%d") > format(input$Event, "%Y%m%d"), NA, OutputsModel2$Qsim)
    # OutputsModel2$Qold <- ifelse(format(OutputsModel2$DatesR, "%Y%m%d") > format(input$Event, "%Y%m%d"), NA, QsimOld[IndPlot])
    # 
    # data <- data.frame(DatesR  = OutputsModel2$DatesR,
    #                    Qobs    = OutputsModel2$Qobs,
    #                    Qsim    = OutputsModel2$Qsim,
    #                    QsimOld = OutputsModel2$Qold)
    data <- getData()$Tab[, c("DatesR", "Qobs", "Qsim", "QsimOld")]
    data$Qsim    <- ifelse(format(data$DatesR, "%Y%m%d") > format(input$Event, "%Y%m%d"), NA, data$Qsim)
    data$QsimOld <- ifelse(format(data$DatesR, "%Y%m%d") > format(input$Event, "%Y%m%d"), NA, data$QsimOld)
657
    data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR)
658
659
    
    op <- getPlotPar()$par
660
    dg6 <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = "flow [mm/d]", main = " ")
661
    dg6 <- dygraphs::dyOptions(dg6, colors = c(op$fg, "orangered", "grey"), drawPoints = TRUE,
662
663
664
665
                               axisLineColor = op$fg, axisLabelColor = op$fg,
                               titleHeight = 10, retainDateWindow = FALSE)
    dg6 <- dygraphs::dySeries(dg6, name = "Qsim"   , drawPoints = FALSE)
    dg6 <- dygraphs::dyEvent(dg6, input$Event, color = "orangered")
666
    dg6 <- dygraphs::dySeries(dg6, name = "QsimOld", label = "Qold", drawPoints = FALSE, strokePattern = "dashed")
667
668
    dg6 <- dygraphs::dyLegend(dg6, show = "onmouseover", width = 225)
    dg6 <- dygraphs::dyCrosshair(dg6, direction = "vertical")
669
  })
670
  
unknown's avatar
unknown committed
671
  
672
673
  ## Plot model diagram chart
  output$stPlotMD <- renderPlot({
674
675
676
    if (length(getSim()$SIM$OutputsModel$DatesR) < 2) {
      return(NULL)
    }
677
678
679
680
681
682
    # OutputsModel <- getSim()$SIM$OutputsModel
    # IndPlot <- which(OutputsModel$DatesR >= input$Period[1L] & OutputsModel$DatesR <= input$Period[2L])
    # OutputsModel2 <- sapply(OutputsModel[seq_len(which(names(OutputsModel) == "Qsim"))], function(x) x[IndPlot])
    # OutputsModel2 <- c(OutputsModel2, Qobs = list(getSim()$SIM$Qobs[IndPlot]))
    
    OutputsModel2 <- getData()$OutputsModel
683
    
684
    par(getPlotPar()$par)
685
    airGRteaching:::DiagramGR(OutputsModel = OutputsModel2, Param = getSim()$PARAM,
686
                              SimPer = input$Period, EventDate = input$Event,
687
                              HydroModel = input$HydroModel)
688
  }, bg = "transparent")
689
690
  
  
691
  
692
693
  ## --------------- Criteria table
  
694
  output$Criteria <- renderTable({
695

696
    ## Table created in order to choose order the criteria in the table output
697
698
    tabCrit_gauge <- data.frame(Criterion = c("NSE [Q]", "NSE [sqrt(Q)]", "NSE [1/Q]",
                                              "KGE [Q]", "KGE [sqrt(Q)]", "KGE [1/Q]"),
699
                                ID        = 1:6, stringsAsFactors = FALSE)
700
    
701
702
703
    if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
      tabCrit_old <- getSim()$SIMold[[1]]$Crit$Value
      tabCrit_val <- cbind(getSim()$Crit, tabCrit_old)
704
      colnames(tabCrit_val) <- c(colnames(getSim()$Crit), "Qold")
705
706
      CellColHisto <- '<div style="color: #808080;"><span>9999</span></div>'
    } else {
707
      tabCrit_val <- getSim()$Crit
708
709
    }
    tabCrit_out <- merge(tabCrit_gauge, tabCrit_val, by = "Criterion", all.x = TRUE)
710
711
    tabCrit_out <- tabCrit_out[order(tabCrit_out$ID), ]
    tabCrit_out <- tabCrit_out[, !colnames(tabCrit_out) %in% "ID"]
712
713
    tabCrit_out[, seq_len(ncol(tabCrit_out))[-1]] <- sapply(seq_len(ncol(tabCrit_out))[-1], function(x) sprintf("%7.2f", tabCrit_out[, x]))
    tabCrit_out <- as.data.frame(tabCrit_out)
714
    tabCrit_out[tabCrit_out <= -99.99] <- "< - 99.99"
715
    colnames(tabCrit_out) <- gsub("Value", "Qsim", colnames(tabCrit_out))
716
717
718
    
    ## Color the cell of the crietaia uses during the calibration
    if (CAL_click$valueButton >= 0) {
719
      CellColCalib <- '<div style="color: #FFFFFF; background-color: #A4C400; border: 5px solid #A4C400; position:relative; top: 0px; left: 5px; padding: 0px; margin: -5px -0px -8px -10px;">
720
<span>9999</span></div>'
721
722
723
      CellColCalib_id  <- which(tabCrit_out$Criterion == input$TypeCrit)
      tabCrit_out[CellColCalib_id, 2] <- gsub("9999", tabCrit_out[CellColCalib_id, 2], CellColCalib)
    }
724
    if (input$ShowOldQsim == "Yes" & length(getSim()$SIMold) > 1) {
725
      tabCrit_out[, "Qold"] <- apply(tabCrit_out[, "Qold", drop = FALSE], 1, function(x) gsub("9999", x, CellColHisto))
726
727
728
    }
    
    return(tabCrit_out)
729
  }, align = c("r"), sanitize.text.function = function(x) x)
730
  
731
  
732
733
734
  
  ## --------------- Download buttons
  
735
  ## Download simulation table
736
737
738
  output$DownloadTab <- downloadHandler(
    filename = function() {
      filename <- "TabSim"
739
      filename <- sprintf("airGR_%s_%s.csv", filename, gsub("(.*)( )(\\d{2})(:)(\\d{2})(:)(\\d{2})", "\\1_\\3h\\5m\\7s", Sys.time()))
740
741
    },
    content = function(file) {
742
743
      PREP <- getPrep()$PREP
      SIM  <- getSim()$SIM
744
745
746
      if (input$SnowModel != "CemaNeige") {
        PrecipSim <- NA
        FracSolid <- NA
747
        TempMean  <- NA
748
      } else {
749
750
        PrecipSol <- rowMeans(as.data.frame(PREP$InputsModel$LayerPrecip) * as.data.frame(PREP$InputsModel$LayerFracSolidPrecip), na.rm = TRUE)
        PrecipSim <- rowMeans(as.data.frame(PREP$InputsModel$LayerPrecip), na.rm = TRUE)
751
752
753
754
        FracSolid <- PrecipSol / PrecipSim
        FracSolid <- ifelse(is.na(FracSolid)  & PrecipSol == 0 & PrecipSim == 0, 0, FracSolid)
        PrecipSim <- PrecipSim[SIM$OptionsSimul$IndPeriod_Run]
        FracSolid <- FracSolid[SIM$OptionsSimul$IndPeriod_Run]
755
        FracSolid <- round(FracSolid, digits = 3)
756
        TempMean  <- rowMeans(as.data.frame(PREP$InputsModel$LayerTempMean), na.rm = TRUE)
757
        TempMean  <- TempMean[SIM$OptionsSimul$IndPeriod_Run]
758
      }
759
760
761
762
763
764
765
766
767
768
      TabSim <- data.frame(Dates                     = SIM$OutputsModel$DatesR,
                           PotEvap                   = SIM$OutputsModel$PotEvap,
                           PrecipObs                 = SIM$OutputsModel$Precip,
                           PrecipSim_CemaNeige       = PrecipSim,
                           PrecipFracSolid_CemaNeige = FracSolid,
                           TempMeanSim_CemaNeige     = TempMean,
                           Qobs                      = SIM$OptionsCrit$Qobs,
                           Qsim                      = SIM$OutputsModel$Qsim)
      colnames(TabSim) <- sprintf("%s [%s]", colnames(TabSim), c("-", rep("mm",3), "-", "°C", rep("mm", 2)))
      colnames(TabSim) <- ifelse(grepl("mm", colnames(TabSim)),
769
                                 gsub("mm", paste0("mm/", .TypeModelGR(PREP)$TimeUnit),colnames(TabSim)),
770
                                 colnames(TabSim))
771
772
773
774
      write.table(TabSim, file = file, row.names = FALSE, sep = ";")
    }
  )
  
775
  ## Download plots
776
777
778
  output$DownloadPlot <- downloadHandler(
    filename = function() {
      filename <- switch(input$PlotType,
779
780
781
782
                         "Model performance" = "PlotModelPerf",
                         "Flow time series"  = "PlotFlowTimeSeries",
                         "State variables"   = "PlotStateVar",
                         "Model diagram"     = "PlotModelDiag")
783
      filename <- sprintf("airGR_%s_%s.png", filename, gsub("(.*)( )(\\d{2})(:)(\\d{2})(:)(\\d{2})", "\\1_\\3h\\5m\\7s", Sys.time()))
784
785
786
    },
    content = function(file) {
      k <- 1.75
787
788
      ParamTitle <- c("X1", "X2"   , "X3", "X4", "X5", "X6")[seq_len(getPrep()$TMGR$NbParam)]
      ParamUnits <- c("mm", "mm/%s", "mm", "%s",   "", "mm")[seq_len(getPrep()$TMGR$NbParam)]
789
790
      if (input$SnowModel == "CemaNeige") {
        ParamTitle <- c(ParamTitle, "C1", "C2")
791
        ParamUnits <- c(ParamUnits,   "", "mm/°C/%s")
792
      }
793
      ParamTitle <- paste(ParamTitle, paste(getSim()$PARAM, sprintf(ParamUnits, getPrep()$TMGR$TimeUnit)), sep = " = ", collapse = ", ")
794
795
796
797
      PngTitle <- sprintf("%s - %s/%s\n%s\n%s", input$Dataset,
                          input$HydroModel, ifelse(input$SnowModel == "CemaNeige", "CemaNeige", "No snow model"),
                          paste0(input$Period, collapse = " - "),
                          ParamTitle)
798
799
      if (getPlotType() == 1) {
        png(filename = file, width = 1000*k,  height = ifelse(input$SnowModel != "CemaNeige", 700*k, 1100*k), pointsize = 14, res = 150)
800
        par(oma = c(0, 0, 4, 0))
801
        plot(getSim()$SIM)
802
        mtext(text = PngTitle, side = 3, outer = TRUE, cex = 0.8, line = 1.2)
803
804
805
806
        dev.off()
      }
      if (getPlotType() == 2) {
        png(filename = file, width = 1000*k, height = 600*k, pointsize = 14, res = 150)
807
        par(oma = c(0, 0, 4, 0))
808
        plot(getSim()$SIM, which = c( "Precip", "Flows"))
809
        mtext(text = PngTitle, side = 3, outer = TRUE, cex = 0.8, line = 1.2)
810
811
        dev.off()
      }
812
813
      if (getPlotType() == 3) {
        png(filename = file, width = 1000*k, height = 600*k, pointsize = 14, res = 150)
814
815
816
817
        # OutputsModel <- getSim()$SIM$OutputsModel
        # IndPlot <- which(OutputsModel$DatesR >= input$Period[1L] & OutputsModel$DatesR <= input$Period[2L])
        # OutputsModel2 <- sapply(OutputsModel[seq_len(which(names(OutputsModel) == "Qsim"))], function(x) x[IndPlot])
        # OutputsModel2 <- c(OutputsModel2, Qobs = list(getSim()$SIM$Qobs[IndPlot]))
818
        #