v0.1.9.6 GR6J model diagram corrected in ShinyGR

DESCRIPTION

 Package: airGRteaching
 Type: Package
 Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface)
-Version: 0.1.9.5
+Version: 0.1.9.6
 Date: 2018-01-22
 Authors@R: c(person("Olivier", "Delaigue", role = c("aut", "cre"), email = "airGR@irstea.fr"), person("Laurent", "Coron", role = c("aut")), person("Pierre", "Brigode", role = c("aut")), person("Guillaume", "Thirel", role = c("ctb")))
 Depends: airGR (>= 1.0.9.43)

R/Utils.R

@@ -76,10 +76,10 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
   col_R           <- rgb(066, 139, 202, maxColorValue = 255) #rgb(037, 155, 210, maxColorValue = 255)
   col_mod_bg      <- rgb(245, 245, 245, maxColorValue = 255)
   col_mod_bd      <- rgb(231, 231, 231, maxColorValue = 255)
-  xy_E            <- c(250, 970)
+  xy_E            <- c(250, 980)
   xy_PE           <- c(250, 940)
   xy_AE           <- c(250, 860)
-  xy_P            <- c(600, 970)
+  xy_P            <- c(600, 980)
   xy_Precip       <- c(600, 950)
   xy_Q            <- c(700,  30)
   x_Ps            <- 440
@@ -235,7 +235,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
   plot(x = 0, type = "n", xlab = "", ylab = "", axes = FALSE, ylim = c(0, 1000), xlim = c(0, 1000))
   
   # Le modele
-  rect(xleft = 0, xright = 1000, ybottom = 50, ytop = 950, col = col_mod_bg, border = col_mod_bd)
+  rect(xleft = 0, xright = 1000, ybottom = 50, ytop = 970, col = col_mod_bg, border = col_mod_bd)
   
   
   # --------------------------------------------------------------------------------
@@ -515,12 +515,14 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
              y0 = y_entreeUH-3*tmp_decal, y1 = xy_Q9[2])
     segments(x0 = xy_Q9[1]*0.80, x1 = xy_Q9[1]*1.30,
              y0 = xy_Q9[2], y1 = xy_Q9[2])
+    segments(x0 = xy_Q9[1]*1.30, x1 = xy_Q9[1]*1.30,
+             y0 = xy_Q9[2], y1 = xy_Q9[2]*0.65)    
     segments(x0 = xy_Q9[1]*0.80, x1 = xy_Q9[1]*0.80,
              y0 = xy_Q9[2], y1 = xy_Q9[2]*0.90)
-    segments(x0 = xy_Q9[1]*0.80, x1 = xy_Q9[1]*0.80,
-             y0 = xy_Q9[2]*0.70, y1 = xy_Q9[2]*0.65)
-    segments(x0 = xy_Q9[1]*1.30, x1 = xy_Q9[1]*1.30,
-             y0 = xy_Q9[2], y1 = xy_Q9[2]*0.65)
+    segments(x0 = xy_Q9[1]*0.55, x1 = xy_Q9[1]*0.55,
+             y0 = xy_Q9[2]*0.70, y1 = y_routage)
+    segments(x0 = xy_Q9[1]*0.55, x1 = xy_min_ROUT[1]+base_res/2,
+             y0 = y_routage, y1 = y_routage)
   }
   
   # Q9
@@ -528,7 +530,19 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
     points(x = xy_Q9[1], y = xy_Q9[2]+tmp_decal,
            type = "p", pch = tri_B, col = col_P,
            cex = cex_tri(OutputsModel$Q9[i_pdt], fact = fact_triangle, max = cex_max_poly))
-  } 
+    if (HydroModel == "GR6J") {
+      # Q9 exp
+      points(x = xy_Q9[1]*0.80, y = xy_Q9[1]*0.73,
+             type = "p", pch = tri_B, col = col_P,
+             cex = cex_tri(OutputsModel$Q9[i_pdt]*0.4, fact = fact_triangle, max = cex_max_poly))
+      # Q9 rout      
+      points(x = xy_Q9[1]*1.30, y = xy_Q9[1]*0.73,
+             type = "p", pch = tri_B, col = col_P,
+             cex = cex_tri(OutputsModel$Q9[i_pdt]*0.6, fact = fact_triangle, max = cex_max_poly))
+      # QrExp
+      plotrix::boxed.labels(x = xy_Q9[1]*0.55, y = y_routage, labels = "QrExp", bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
+    }
+  }
   
   plotrix::boxed.labels(x = xy_Q9[1], y = xy_Q9[2], labels = "Q9",
                         bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
@@ -581,24 +595,29 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
            y0 = y_routage, y1 = y_routage)
   
   # Qr
-  plotrix::boxed.labels(x = xy_min_ROUT[1]+base_res/2, y = y_routage, labels = "Qr",
-                        bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
+  if (HydroModel != "GR6J") {
+    plotrix::boxed.labels(x = xy_min_ROUT[1]+base_res/2, y = y_routage, labels = "Qr",
+                          bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
+  }
+  if (HydroModel == "GR6J") {
+    plotrix::boxed.labels(x = xy_min_ROUT[1]+base_res/1.5, y = (xy_min_ROUT[2]+y_routage)/2, labels = "Qr",
+                          bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
+  }
   
   # Valeur de Qr
   if (OutputsModel$QR[i_pdt] != 0) {
+    if (HydroModel != "GR6J") {
     points(x = xy_Q[1]-100, y = y_routage,
            type = "p", pch = tri_R, col = col_P,
            cex = cex_tri(OutputsModel$QR[i_pdt], fact = fact_triangle, max = cex_max_poly))
+    } else {
+      points(x = xy_min_ROUT[1]+base_res/2, y = (xy_min_ROUT[2]+y_routage)/2,
+             type = "p", pch = tri_B, col = col_P,
+             cex = cex_tri(OutputsModel$QR[i_pdt], fact = fact_triangle, max = cex_max_poly))
+    }
   }
   
-  # Q final
-  segments(x0 = xy_Q[1], x1 = xy_Q[1], y0 = y_routage, y1 = xy_Q[2]+10)
-  if (OutputsModel$Qsim[i_pdt] != 0) {
-    points(x = xy_Q[1], y =  mean(c(y_routage, xy_Q[2]+10)),
-           type = "p", pch = tri_B, col = col_Q,
-           cex = cex_tri(OutputsModel$Qsim[i_pdt], fact = fact_triangle, max = cex_max_poly))
-  }
-  
+
   
   # --------------------------------------------------------------------------------
   # RESERVOIR EXPONENTIEL
@@ -626,9 +645,39 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
              y0 = xy_min_EXPO[2], y1 = xy_min_EXPO[2]-max(abs(OutputsModel$Exp))*fact_res-tmp_triche)
     segments(x0 = xy_min_EXPO[1]+base_res, x1 = xy_min_EXPO[1]+base_res,
              y0 = xy_min_EXPO[2], y1 = xy_min_EXPO[2]-max(abs(OutputsModel$Exp))*fact_res-tmp_triche)
-    text(x = 50, y = xy_min_EXPO[2]+Param[3]*fact_res/3, labels = "Expo.\nstore",
+    text(x = 50, y = xy_min_EXPO[2]+Param[3]*fact_res/3, labels = "Exp.\nstore",
          cex = 1.4, pos = 4)
+    points(x = 180, y = xy_min_EXPO[2]+Param[3]*fact_res/3+05, pch = 43, # +
+         cex = 2.0, col = "#10B510")
+    points(x = 178, y = xy_min_EXPO[2]+Param[3]*fact_res/3-35, pch = 95, # -
+         cex = 1.6, col = "#FF0303")
+
+    # Valeur de QrExp
+    if (OutputsModel$QR[i_pdt] != 0) {
+      points(x = xy_Q[1]-350, y = y_routage,
+             type = "p", pch = tri_R, col = col_P,
+             cex = cex_tri(OutputsModel$QRExp[i_pdt], fact = fact_triangle, max = cex_max_poly))
+    }
 
+    # Valeur de Qr + QrExp
+    if (OutputsModel$QR[i_pdt] != 0) {    
+      points(x = xy_Q[1]-100, y = y_routage,
+             type = "p", pch = tri_R, col = col_P,
+             cex = cex_tri(OutputsModel$QR[i_pdt]+OutputsModel$QRExp[i_pdt], fact = fact_triangle, max = cex_max_poly))
+    }
+  }
+  
+  
+  # --------------------------------------------------------------------------------
+  # Q FINAL
+  # -------------------------------------------------------------------------------
+  
+  # Q final
+  segments(x0 = xy_Q[1], x1 = xy_Q[1], y0 = y_routage, y1 = xy_Q[2]+10)
+  if (OutputsModel$Qsim[i_pdt] != 0) {
+    points(x = xy_Q[1], y =  mean(c(y_routage, xy_Q[2]+10)),
+           type = "p", pch = tri_B, col = col_Q,
+           cex = cex_tri(OutputsModel$Qsim[i_pdt], fact = fact_triangle, max = cex_max_poly))
   }