v0.2.10.6 BUG: dyEvent bars now start from the beginning of the month #14

DESCRIPTION

 Package: airGRteaching
 Type: Package
 Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
-Version: 0.2.10.5
+Version: 0.2.10.6
 Date: 2020-04-14
 Authors@R: c(
   person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),

NEWS.md

@@ -4,7 +4,7 @@
 
 
 
-### 0.2.10.5 Release Notes (2020-04-14)
+### 0.2.10.6 Release Notes (2020-04-14)
 
 
 #### New features

inst/ShinyGR/server.R

@@ -757,6 +757,7 @@ 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"))
     
     dgMDp <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = paste0("precip. [mm/", getPrep()$TMGR$TimeUnit, "]"))
     dgMDp <- dygraphs::dyOptions(dgMDp, colors = col.Precip, drawXAxis = FALSE,
@@ -764,7 +765,7 @@ shinyServer(function(input, output, session) {
     dgMDp <- dygraphs::dyStackedBarGroup(dgMDp, name = rev(grep("^P", colnames(data.xts), value = TRUE)),
                                          axis = "y", color = (col.Precip))
     dgMDp <- dygraphs::dyAxis(dgMDp, name = "y", valueRange = rev(Plim))
-    dgMDp <- dygraphs::dyEvent(dgMDp, input$Event, color = "orangered")
+    dgMDp <- dygraphs::dyEvent(dgMDp, dateEvent, color = "orangered")
     dgMDp <- dygraphs::dyLegend(dgMDp, show = "onmouseover", width = 225)
     dgMDp <- dygraphs::dyCrosshair(dgMDp, direction = "vertical")
   })
@@ -779,6 +780,7 @@ 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"))
     
     op <- getPlotPar()$par
     dgMDe <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = paste0("PET [mm/", getPrep()$TMGR$TimeUnit, "]"), main = " ")
@@ -786,7 +788,7 @@ shinyServer(function(input, output, session) {
                                  strokeWidth = 0, pointSize = 2, drawXAxis = FALSE,
                                  axisLineColor = op$fg, axisLabelColor = op$fg, titleHeight = 10,
                                  retainDateWindow = FALSE, useDataTimezone = TRUE)
-    dgMDe <- dygraphs::dyEvent(dgMDe, input$Event, color = "orangered")
+    dgMDe <- dygraphs::dyEvent(dgMDe, dateEvent, color = "orangered")
     dgMDe <- dygraphs::dyLegend(dgMDe, show = "onmouseover", width = 225)
     dgMDe <- dygraphs::dyCrosshair(dgMDe, direction = "vertical")
   })
@@ -817,6 +819,7 @@ shinyServer(function(input, output, session) {
     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.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 = " ")
@@ -824,7 +827,7 @@ shinyServer(function(input, output, session) {
                                  axisLineColor = op$fg, axisLabelColor = op$fg, titleHeight = 10,
                                  retainDateWindow = FALSE, useDataTimezone = TRUE)
     dgMDq <- dygraphs::dySeries(dgMDq, name = "Qsim"   , drawPoints = FALSE)
-    dgMDq <- dygraphs::dyEvent(dgMDq, input$Event, color = "orangered")
+    dgMDq <- dygraphs::dyEvent(dgMDq, dateEvent, color = "orangered")
     dgMDq <- dygraphs::dySeries(dgMDq, name = "QsimOld", label = "Qold", drawPoints = FALSE, strokePattern = "dashed")
     dgMDq <- dygraphs::dyLegend(dgMDq, show = "onmouseover", width = 225)
     dgMDq <- dygraphs::dyCrosshair(dgMDq, direction = "vertical")