From 308b95b632b5bc6a36263153bd22a61ec4400af6 Mon Sep 17 00:00:00 2001
From: unknown <olivier.delaigue@ANPI1430.antony.irstea.priv>
Date: Mon, 22 Jan 2018 18:26:51 +0100
Subject: [PATCH] v0.1.9.6 GR6J model diagram corrected in ShinyGR
---
DESCRIPTION | 2 +-
R/Utils.R | 87 +++++++++++++++++++++++++++++++++++++++++------------
2 files changed, 69 insertions(+), 20 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 6fdb763..583eb2d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
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)
diff --git a/R/Utils.R b/R/Utils.R
index fc974dc..74a7fef 100644
--- a/R/Utils.R
+++ b/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))
}
--
GitLab