diff --git a/DESCRIPTION b/DESCRIPTION index 4853f3505709daf93a2c9f7ab2876127e5a59f00..3ff2960b50ad7a84eb2c26fc83d8a6f74bf95845 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.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"), diff --git a/NEWS.md b/NEWS.md index 575fa9e55623604915bd6122c44791787a78ea19..37894189abffa0f6a8b9c2a57784e973c2ebaf26 100644 --- a/NEWS.md +++ b/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 diff --git a/inst/ShinyGR/server.R b/inst/ShinyGR/server.R index 1dce7a1c880ef9fa2ef3befa26d7cbe71f8a6393..dc50bacdfb4748bc287197a6fc2a6efee38e43d5 100644 --- a/inst/ShinyGR/server.R +++ b/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")