Commit 308b95b6 authored by unknown's avatar unknown
Browse files

v0.1.9.6 GR6J model diagram corrected in ShinyGR

parent bd06f1eb
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)
......
......@@ -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))
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment