diff --git a/DESCRIPTION b/DESCRIPTION
index 3545e7855fecb98287bc8be9ad5ffef3797508e1..87a8a82da58d9f239c799318b1f66cbf7d718a37 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: airGRteaching
Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
-Version: 0.2.10.26
+Version: 0.2.10.27
Date: 2020-04-29
Authors@R: c(
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
diff --git a/NEWS.md b/NEWS.md
index 60e3f2d844e3c98d0f072498e64477f6dd02945e..539d10203c6a19a6c3ef7965ea6f7e9485e11962 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -4,7 +4,7 @@
-### 0.2.10.26 Release Notes (2020-04-29)
+### 0.2.10.27 Release Notes (2020-04-29)
#### New features
diff --git a/inst/ShinyGR/server.R b/inst/ShinyGR/server.R
index 1c00aed762d7588267f90d3a17de33222389c577..f9accaa1ee00274a0d363153e6e31ae3447d9948 100644
--- a/inst/ShinyGR/server.R
+++ b/inst/ShinyGR/server.R
@@ -538,15 +538,18 @@ shinyServer(function(input, output, session) {
## Target date slider
eventReactive({input$Dataset}, {
- updateSliderInput(session, inputId = "Event", label = "Select the target date:",
+ EventId <- ifelse(input$HydroModel == "GR2M", "EventGR2M", "Event")
+ timeFormat <- ifelse(input$HydroModel == "GR2M", "%Y-%m", "%F")
+ updateSliderInput(session, inputId = EventId, 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,
timeFormat = timeFormat, timezone = "+0000")
})
observe({
+ EventId <- ifelse(input$HydroModel == "GR2M", "EventGR2M", "Event")
timeFormat <- ifelse(input$HydroModel == "GR2M", "%Y-%m", "%F")
- updateSliderInput(session, inputId = "Event", label = "Select the target date:",
+ updateSliderInput(session, inputId = EventId, label = "Select the target date:",
min = input$Period[1L],## + .TypeModelGR(input$HydroModel)$TimeLag,
max = input$Period[2L],
timeFormat = timeFormat, timezone = "+0000")
@@ -755,7 +758,12 @@ shinyServer(function(input, output, session) {
col.Precip <- c("#428BCA")
}
data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR, tzone = "UTC")
- dateEvent <- trunc(input$Event, units = ifelse(input$HydroModel == "GR2M", "months", "days"))
+ # dateEvent <- trunc(input$Event, units = ifelse(input$HydroModel == "GR2M", "months", "days"))
+ if (input$HydroModel == "GR2M") {
+ dateEvent <- trunc(input$EventGR2M, units = "months")
+ } else {
+ dateEvent <- trunc(input$Event, units = "days")
+ }
dgMDp <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = paste0("precip. [mm/", getPrep()$TMGR$TimeUnit, "]"))
dgMDp <- dygraphs::dyOptions(dgMDp, colors = col.Precip, drawXAxis = FALSE,
@@ -778,7 +786,12 @@ shinyServer(function(input, output, session) {
# PET = getSim()$SIM$OutputsModel$PotEvap)
data <- getData()$Tab[, c("DatesR", "PET")]
data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR, tzone = "UTC")
- dateEvent <- trunc(input$Event, units = ifelse(input$HydroModel == "GR2M", "months", "days"))
+ # dateEvent <- trunc(input$Event, units = ifelse(input$HydroModel == "GR2M", "months", "days"))
+ if (input$HydroModel == "GR2M") {
+ dateEvent <- trunc(input$EventGR2M, units = "months")
+ } else {
+ dateEvent <- trunc(input$Event, units = "days")
+ }
op <- getPlotPar()$par
dgMDe <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = paste0("PET [mm/", getPrep()$TMGR$TimeUnit, "]"), main = " ")
@@ -813,11 +826,17 @@ shinyServer(function(input, output, session) {
# Qobs = OutputsModel2$Qobs,
# Qsim = OutputsModel2$Qsim,
# QsimOld = OutputsModel2$Qold)
+
+ # dateEvent <- trunc(input$Event, units = ifelse(input$HydroModel == "GR2M", "months", "days"))
+ if (input$HydroModel == "GR2M") {
+ dateEvent <- trunc(input$EventGR2M, units = "months")
+ } else {
+ dateEvent <- trunc(input$Event, units = "days")
+ }
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)
+ data$Qsim <- ifelse(format(data$DatesR, "%Y%m%d") > format(dateEvent, "%Y%m%d"), NA, data$Qsim)
+ data$QsimOld <- ifelse(format(data$DatesR, "%Y%m%d") > format(dateEvent, "%Y%m%d"), NA, data$QsimOld)
data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR, tzone = "UTC")
- dateEvent <- trunc(input$Event, units = ifelse(input$HydroModel == "GR2M", "months", "days"))
op <- getPlotPar()$par
dgMDq <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = paste0("flow [mm/", getPrep()$TMGR$TimeUnit, "]"), main = " ")
@@ -846,12 +865,13 @@ shinyServer(function(input, output, session) {
# OutputsModel2 <- c(OutputsModel2, Qobs = list(getSim()$SIM$Qobs[IndPlot]))
# OutputsModel2 <- getData()$OutputsModel
+ # dateEvent <- trunc(input$Event, units = ifelse(input$HydroModel == "GR2M", "months", "days"))
if (input$HydroModel == "GR2M") {
dd <- trunc(input$Period, units = "months")
- dateEvent <- trunc(input$Event, units = "months")
+ dateEvent <- trunc(input$EventGR2M, units = "months")
} else {
dd <- trunc(input$Period, units = "days")
- dateEvent <- trunc(input$Event, units = "months")
+ dateEvent <- trunc(input$Event, units = "days")
}
par(getPlotPar()$par)
@@ -944,7 +964,11 @@ shinyServer(function(input, output, session) {
content = function(file) {
k <- 1.75
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)]
+ ParamUnits <- c("mm", "mm/%s", "mm", "%s", "", "mm")
+ if (input$HydroModel == "GR2M") {
+ ParamUnits[2] <- "-%s"
+ }
+ ParamUnits <- ParamUnits[seq_len(getPrep()$TMGR$NbParam)]
if (input$SnowModel == "CemaNeige") {
ParamTitle <- c(ParamTitle, "C1", "C2")
ParamUnits <- c(ParamUnits, "", "mm/°C/%s")
@@ -1056,11 +1080,16 @@ shinyServer(function(input, output, session) {
dev.off()
}
if (getPlotType() == 4) {
+ if (input$HydroModel == "GR2M") {
+ dateEvent <- trunc(input$EventGR2M, units = "months")
+ } else {
+ dateEvent <- input$Event
+ }
isCN <- input$SnowModel == "CemaNeige"
png(filename = file, width = 550*k, height = ifelse(isCN, 1000, 900)*k, pointsize = 12, res = 150)
PngTitleMD <- sprintf("%s - %s/%s\n%s\n%s", input$Dataset,
input$HydroModel, ifelse(input$SnowModel == "CemaNeige", "CemaNeige", "No snow model"),
- input$Event,
+ dateEvent,
ParamTitle)
if (grepl("X5", PngTitleMD)) {
PngTitleMD <- gsub(", X5", "\nX5", PngTitleMD)
@@ -1070,7 +1099,7 @@ shinyServer(function(input, output, session) {
par(oma = c(0, 0, ifelse(isCN, 7, 6), 0))
.DiagramGR(OutputsModel = getData()$OutputsModel, Param = getSim()$PARAM,
- SimPer = input$Period, EventDate = input$Event,
+ SimPer = input$Period, EventDate = dateEvent,
HydroModel = input$HydroModel, CemaNeige = input$SnowModel == "CemaNeige")
mtext(text = PngTitleMD, side = 3, outer = TRUE, cex = 1.2, line = ifelse(isCN, -0.15, 0.6))
dev.off()