v0.2.10.11 BUG: missing routing store time series added in GUI when GR2M is used #14

DESCRIPTION

 Package: airGRteaching
 Type: Package
 Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
-Version: 0.2.10.10
+Version: 0.2.10.11
 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.10 Release Notes (2020-04-14)
+### 0.2.10.11 Release Notes (2020-04-14)
 
 
 #### New features

inst/ShinyGR/server.R

@@ -384,7 +384,7 @@ shinyServer(function(input, output, session) {
                          precip. = OutputsModel2$Precip,
                          PET     = OutputsModel2$PotEvap,
                          prod.   = OutputsModel2$Prod,
-                         # rout.   = OutputsModel2$Rout,
+                         rout.   = OutputsModel2$Rout,
                          # exp.    = rep(NA, length(OutputsModel2$DatesR)),
                          # 'exp. (+)'= rep(NA, length(OutputsModel2$DatesR)),
                          # 'exp. (-)'= rep(NA, length(OutputsModel2$DatesR)),
@@ -405,10 +405,10 @@ shinyServer(function(input, output, session) {
         data$'QrExp'   <- OutputsModel2$QRExp
       }
       if (input$HydroModel != "GR2M") {
-        data$'rout.' <- OutputsModel2$Rout
         data$'Qr'    <- OutputsModel2$QR
         data$'Qd'    <- OutputsModel2$QD
       }
+      
       return(list(OutputsModel = OutputsModel2, Tab = data))
     }
   })
@@ -657,11 +657,11 @@ shinyServer(function(input, output, session) {
     # data <- data.frame(DatesR = OutputsModel$DatesR,
     #                    prod.  = OutputsModel$Prod,
     #                    rout.  = OutputsModel$Rout)
-    data <- getData()$Tab[, c("DatesR", "prod.", grep("^rout", colnames(getData()$Tab), value = TRUE), grep("^exp", colnames(getData()$Tab), value = TRUE))]
+    data <- getData()$Tab[, c("DatesR", "prod.", "rout.", grep("^exp", colnames(getData()$Tab), value = TRUE))]
     data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR, tzone = "UTC")
 
     colors <- c("#00008B", "#008B8B", "#10B510", "#FF0303")[seq_len(ncol(data.xts))]
-    
+
     op <- getPlotPar()$par
     dgSVs <- dygraphs::dygraph(data.xts, group = "state_var", ylab = "store [mm]")
     dgSVs <- dygraphs::dyOptions(dgSVs, colors = colors,
@@ -983,7 +983,7 @@ shinyServer(function(input, output, session) {
         # }
         colSelec <- c("DatesR",
                       "prod.",
-                      grep("^rout.$", colnames(getData()$Tab), value = TRUE),
+                      "rout.",
                       grep("^Qr$", colnames(getData()$Tab), value = TRUE),
                       grep("^Qd$", colnames(getData()$Tab), value = TRUE),
                       grep("^QrExp|exp", colnames(getData()$Tab), value = TRUE),
@@ -992,40 +992,28 @@ shinyServer(function(input, output, session) {
         data <- getData()$Tab[, colSelec]
         par(mfrow = c(2, 1), oma = c(3, 0, 4, 0))
         par(mar = c(0.6, 4.0, 0.0, 2.0), xaxt = "n", cex = 0.8)
-        if (input$HydroModel != "GR6J" & input$HydroModel != "GR2M") {
+        if (input$HydroModel != "GR6J") {
           plot(range(data$Dates), range(data$prod., data$rout., na.rm = TRUE),
                type = "n", xlab = "", ylab = "store [mm]")
         }
-        if (input$HydroModel == "GR2M") {
-          plot(range(data$Dates), range(data$prod., na.rm = TRUE),
-               type = "n", xlab = "", ylab = "store [mm]")
-        }
         if (input$HydroModel == "GR6J") {
           data$exp. <- rowSums(data[, c("exp. (+)", "exp. (-)")], na.rm = TRUE)
           plot(range(data$Dates), range(data$prod., data$rout., data$rout., data$exp.),
                type = "n", xlab = "", ylab = "store [mm]")
         }
         polygon(c(data$Dates, rev(range(data$Dates))), c(data$prod., rep(0, 2)), border = "darkblue", col = adjustcolor("darkblue", alpha.f = 0.30))
-        if (input$HydroModel != "GR2M") {
-          polygon(c(data$Dates, rev(range(data$Dates))), c(data$rout., rep(0, 2)), border = "cyan4"   , col = adjustcolor("cyan4"   , alpha.f = 0.30))
-        }
+        polygon(c(data$Dates, rev(range(data$Dates))), c(data$rout., rep(0, 2)), border = "cyan4"   , col = adjustcolor("cyan4"   , alpha.f = 0.30))
         if (input$HydroModel == "GR6J") {
           minQrExp <- min(data$prod., data$rout., data$exp., 0)
           colQrExp <- ifelse(minQrExp > 0, "#10B510", "#FF0303")
           polygon(c(data$Dates, rev(range(data$Dates))), c(data$exp., rep(0, 2)), border = colQrExp, col = adjustcolor(colQrExp, alpha.f = 0.30))
         }
-        if (input$HydroModel != "GR6J"  & input$HydroModel != "GR2M") {
+        if (input$HydroModel != "GR6J") {
           legend("topright", bty = "n", legend = c("prod.", "rout."), cex = 0.8,
                  pt.bg = adjustcolor(c("darkblue", "cyan4"), alpha.f = 0.30),
                  col = c("darkblue", "cyan4"),
                  pch = 22)
         }
-        if (input$HydroModel == "GR2M") {
-          legend("topright", bty = "n", legend = c("prod."), cex = 0.8,
-                 pt.bg = adjustcolor(c("darkblue"), alpha.f = 0.30),
-                 col = c("darkblue"),
-                 pch = 22)
-        }
         if (input$HydroModel == "GR6J") {
           legend("topright", bty = "n", legend = c("prod.", "rout.", "exp. (+)", "exp. (-)"), cex = 0.8,
                  pt.bg = adjustcolor(c("darkblue", "cyan4", "#10B510", "#FF0303"), alpha.f = 0.30),