Commit b596cb3d authored by Delaigue Olivier's avatar Delaigue Olivier

v0.2.10.60 Merge branch 'dev' into 'master'

# Conflicts:
#   DESCRIPTION
#   NEWS.md
#   R/ShinyGR.R
#   man/airGRteaching.Rd
parents 47fda2ae d80c4bf3
Package: airGRteaching
Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
Version: 0.2.9.26
Version: 0.2.10.60
Date: 2020-10-20
Authors@R: c(
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
......@@ -9,12 +9,13 @@ Authors@R: c(
person("Pierre", "Brigode", role = c("aut"), comment = c(ORCID = "0000-0001-8257-0741")),
person("Guillaume", "Thirel", role = c("ctb"), comment = c(ORCID = "0000-0002-1444-1830"))
)
Depends: airGR (>= 1.4.3.52)
Depends: airGR (>= 1.4.3.87)
Imports: dygraphs (>= 1.1.1.6), markdown, plotrix, shiny (>= 1.1.0), shinyjs (>= 1.0), xts
Suggests: knitr, rmarkdown
Description: Add-on package to the 'airGR' package that simplifies its use and is aimed at being used for teaching hydrology. The package provides 1) three functions that allow to complete very simply a hydrological modelling exercise 2) plotting functions to help students to explore observed data and to interpret the results of calibration and simulation of the GR ('Génie rural') models 3) a 'Shiny' graphical interface that allows for displaying the impact of model parameters on hydrographs and models internal variables.
License: GPL-2
NeedsCompilation: no
URL: https://hydrogr.github.io/airGRteaching/
BugReports: https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/issues
Encoding: UTF-8
VignetteBuilder: knitr
......@@ -32,5 +32,5 @@ plot.SimGR Synthetic plotting of model outputs
Shiny interface:
======================
ShinyGR Interactive Web applications to run the GR4J, GR5J
ShinyGR Interactive Web applications to run the GR2M, GR4J, GR5J
and GR6J hydrological models whith or without CemaNeige
......@@ -4,6 +4,21 @@
### 0.2.10.60 Release Notes (2020-10-20)
#### Version control and issue tracking
- Users can now track changes (https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching) and issues (https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/issues)
#### User-visible changes
- the <code>theme</code> agument of the <code>ShinyGR()<code> function now uses partial matching
____________________________________________________________________________________
### 0.2.9.26 Release Notes (2020-10-20)
......@@ -25,6 +40,7 @@
____________________________________________________________________________________
### 0.2.8.69 Release Notes (2020-02-28)
......@@ -49,13 +65,13 @@ ________________________________________________________________________________
#### User-visible changes
- it is now possible to use the GR4H and GR5H hourly models with or without CemaNeige. For that, in the <code>PrepGR()</code>, the <code>HydroModel</code> argument could be set to <code>"GR4H"</code> or <code>"GR5H"</code>. In the GUI, launched by <code>ShinyGR()</code> function, nothing changed, only the daily models are available. So, now airGRteaching depends on the version of airGR >= 1.4.3.52) ([#7](https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/-/issues/7))
- it is now possible to use the GR4H and GR5H hourly models with or without CemaNeige. For that, in the <code>PrepGR()</code>, the <code>HydroModel</code> argument could be set to <code>"GR4H"</code> or <code>"GR5H"</code>. In the GUI, launched by <code>ShinyGR()</code> function, nothing changed, only the daily models are available. So, now airGRteaching depends on the version of 'airGR' >= 1.4.3.52)
- it is now possible to run the <code>PrepGR()</code> function when discharge is not provided in <code>Qobs</code>. If it is the case, the <code>CalGR()</code> function will return an error message because it is not possible to calibrate the model. The <code>SimGR()</code> function will return a warning message because it is not possible to compute any efficiency criterion
- it is now possible to run the <code>ShinyGR()</code> function when discharge is not provided in <code>Qobs</code>
- when observed discharge is provided in <code>ShinyGR()</code>, the first plotting panel now draws the flow error time series ([#4](https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/-/issues/4))
- when observed discharge is provided in <code>ShinyGR()</code>, the first plotting panel now draws the flow error time series
- the <code>plot()</code> function is now exported
......@@ -66,7 +82,7 @@ ________________________________________________________________________________
#### CRAN-compatibility updates
- when the package is loaded, a message warns the users if they use a version of 'htmlwidgets' < 1.5.1.9000. The latest version of this package, available on GitHub, avoids troubles with the use of dynamic graphics of the 'dygraphs' package (called by the <code>dyplot&#42;()</code> and the <code>ShinyGR()</code> functions) ([#5](https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/-/issues/5))
- when the package is loaded, a message warns the users if they use a version of 'htmlwidgets' < 1.5.1.9000. The latest version of this package, available on GitHub, avoids troubles with the use of dynamic graphics of the 'dygraphs' package (called by the <code>dyplot&#42;()</code> and the <code>ShinyGR()</code> functions)
____________________________________________________________________________________
......@@ -113,7 +129,7 @@ ________________________________________________________________________________
- now depends on the latest version (1.2.13.16) of the 'airGR' package: <code>CalGR()</code>, <code>SimGR()</code> and <code>ShinyGR()</code> have been updated
- the 'htmlwidget' package is no longer imported
- the 'htmlwidgets' package is no longer imported
#### User-visible changes
......@@ -308,7 +324,7 @@ ________________________________________________________________________________
#### Bug fixes
- period slider is linked to the dygraphs selected period
- period slider is linked to the 'dygraphs' selected period
#### Deprecated and defunct
......@@ -322,7 +338,7 @@ ________________________________________________________________________________
#### CRAN-compatibility updates
- <code>dyplot()</code> updated to be compatible with dygraphs >= 1.1.1.4 (available only on GitHub)
- <code>dyplot()</code> updated to be compatible with 'dygraphs' >= 1.1.1.4 (available only on GitHub)
____________________________________________________________________________________
......@@ -332,7 +348,7 @@ ________________________________________________________________________________
#### New features
- <code>ShinyGR()</code> now use dygraph devices (except for model perf.)
- <code>ShinyGR()</code> now use 'dygraphs' devices (except for model perf.)
#### User-visible changes
......
CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
WupPer = NULL, CalPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) {
CalCrit <- match.arg(arg = CalCrit)
CalCrit <- sprintf("ErrorCrit_%s", CalCrit)
FUN_CRIT <- get(CalCrit)
if (! any(transfo %in% c("", "sqrt", "log", "inv", "sort"))) {
stop("Non convenient transformation \"transfo\"")
} else {
transfo <- transfo[1L]
}
if (! any(class(PrepGR) %in% "PrepGR")) {
stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
}
......@@ -41,19 +52,7 @@ CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
}
}
if (! any(CalCrit %in% c("NSE", "KGE", "KGE2", "RMSE"))) {
stop("Non convenient efficiency criteria \"EffCrit\"")
} else {
CalCrit <- CalCrit[1L]
CalCrit <- sprintf("ErrorCrit_%s", CalCrit)
FUN_CRIT <- get(CalCrit)
}
if (! any(transfo %in% c("", "sqrt", "log", "inv", "sort"))) {
stop("Non convenient transformation \"transfo\"")
} else {
transfo <- transfo[1L]
}
MOD_opt <- CreateRunOptions(FUN_MOD = get(PrepGR$TypeModel), InputsModel = PrepGR$InputsModel,
IndPeriod_WarmUp = WupInd, IndPeriod_Run = CalInd, verbose = FALSE)
......
......@@ -3,6 +3,9 @@ PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q
HydroModel, CemaNeige = FALSE) {
SuiteGR <- paste0("GR", c("1A", "2M", "4J", "5J", "6J", "4H", "5H"))
HydroModel <- match.arg(arg = HydroModel, choices = SuiteGR)
if (is.null(ObsDF) && (is.null(DatesR) | is.null(Precip) | is.null(PotEvap))) {
stop("Missing input data")
}
......@@ -45,23 +48,17 @@ PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q
stop("Non convenient date format. Time zone must be defined as \"UTC\"")
}
SuiteGR <- paste0("GR", c("1A", "2M", "4J", "5J", "6J", "4H", "5H"))
if (! any(HydroModel %in% SuiteGR)) {
stop("Non convenient model")
} else {
if (! CemaNeige) {
TypeModel <- sprintf("RunModel_%s", HydroModel)
}
if (CemaNeige && grepl("J|H", HydroModel)) {
TypeModel <- sprintf("RunModel_CemaNeige%s", HydroModel)
}
if (CemaNeige && !grepl("J|H", HydroModel)) {
warning("CemaNeige can not be used with ", HydroModel)
TypeModel <- sprintf("RunModel_%s", HydroModel)
}
FUN_MOD <- get(TypeModel)
if (! CemaNeige) {
TypeModel <- sprintf("RunModel_%s", HydroModel)
}
if (CemaNeige && grepl("J|H", HydroModel)) {
TypeModel <- sprintf("RunModel_CemaNeige%s", HydroModel)
}
if (CemaNeige && !grepl("J|H", HydroModel)) {
warning("CemaNeige can not be used with ", HydroModel)
TypeModel <- sprintf("RunModel_%s", HydroModel)
}
FUN_MOD <- get(TypeModel)
MOD_obs <- CreateInputsModel(FUN_MOD = FUN_MOD, DatesR = ObsDF$DatesR,
......
ShinyGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5, SimPer, NamesObsBV = NULL,
theme = "RStudio") {
.onAttach()
theme <- match.arg(arg = theme,
choices = c("RStudio", "Cerulean", "Cyborg", "Flatly", "Inrae", "Saclay", "United", "Yeti"))
if ((is.null(ObsDF) | any(sapply(ObsDF, is.null))) && (is.null(DatesR) | is.null(Precip) | is.null(PotEvap) | is.null(Qobs))) {
stop("Missing input data")
}
......@@ -149,7 +152,7 @@ ShinyGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
.GlobalEnv$.ShinyGR.args <- list(ObsDF = ObsDF, NamesObsBV = NamesObsBV,
DatesR = DatesR, Precip = Precip, PotEvap = PotEvap, Qobs = Qobs, TempMean = TempMean,
ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers, SimPer = SimPer,
theme = tolower(theme))
theme = theme)
## timezone used
# oTZ <- Sys.timezone()
......
SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2", "RMSE"),
WupPer = NULL, SimPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) {
EffCrit <- match.arg(arg = EffCrit)
EffCrit <- sprintf("ErrorCrit_%s", EffCrit)
FUN_CRIT <- get(EffCrit)
if (! any(transfo %in% c("", "sqrt", "log", "inv", "sort"))) {
stop("Non convenient transformation \"transfo\"")
} else {
transfo <- transfo[1L]
}
if (! any(class(PrepGR) %in% "PrepGR")) {
stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
}
......@@ -61,20 +72,6 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2",
SimInd <- which(PrepGR$InputsModel$DatesR == SimPer[1]):which(PrepGR$InputsModel$DatesR == SimPer[2])
}
}
if (! any(EffCrit %in% c("NSE", "KGE", "KGE2", "RMSE"))) {
stop("Non convenient efficiency criteria \"EffCrit\"")
} else {
EffCrit <- EffCrit[1L]
EffCrit <- sprintf("ErrorCrit_%s", EffCrit)
FUN_CRIT <- get(EffCrit)
}
if (! any(transfo %in% c("", "sqrt", "log", "inv", "sort"))) {
stop("Non convenient transformation \"transfo\"")
} else {
transfo <- transfo[1L]
}
......
......@@ -107,7 +107,7 @@ if (getRversion() >= "2.15.1") {
## function to plot the gr models diagrams (only GR4J and GR5J)
## =================================================================================
.DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel, CemaNeige) {
.DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel, CemaNeige, Theme = NULL) {
# --------------------------------------------------------------------------------
......@@ -168,13 +168,15 @@ if (getRversion() >= "2.15.1") {
par(col.axis = par("fg"), cex.axis = 1.3, cex.lab = 1.3, cex = 0.7, mgp = mgp)
if (.GlobalEnv$.ShinyGR.args$theme == "cyborg") {
col_mod_bg <- rgb(255-245, 255-245, 255-245, maxColorValue = 255)
col_mod_bd <- rgb(255-231, 255-231, 255-231, maxColorValue = 255)
}
if (.GlobalEnv$.ShinyGR.args$theme == "Flatly") {
col_mod_bg <- "#ECF0F1"
col_mod_bd <- "#ECF0F1"
if (!is.null(Theme)) {
if (Theme == "Cyborg") {
col_mod_bg <- rgb(255-245, 255-245, 255-245, maxColorValue = 255)
col_mod_bd <- rgb(255-231, 255-231, 255-231, maxColorValue = 255)
}
if (Theme == "Flatly") {
col_mod_bg <- "#ECF0F1"
col_mod_bd <- "#ECF0F1"
}
}
# Pas de temps
......@@ -211,30 +213,30 @@ if (getRversion() >= "2.15.1") {
}
# Calcul des ordonnees SH2 de l' "hydrogramme unitaire cumule" UH2
SH2 <- array(NA, 2*NH)
for (i in 1:(2*NH)) {
if (i <= 0) SH2[i] <- 0
if (i > 0 & i < Param[4]) SH2[i] <- 0.5*(i/Param[4])^(D)
if (i >= Param[4] & i < 2*Param[4]) SH2[i] <- 1 - (0.5*(2-i/Param[4])^(D))
if (i >= 2*Param[4]) SH2[i] <- 1
}
# Calcul des ordonnees UH2 de l' "hydrogramme unitaire discret" UH2
UH2 <- array(NA, 2*NH)
for (j in 1:(2*NH)) {
if (j == 1) {
UH2[j] <- SH2[j]
} else {
UH2[j] <- SH2[j] - SH2[j-1]
}
if (HydroModel != "GR2M") {
# Calcul des ordonnees SH2 de l' "hydrogramme unitaire cumule" UH2
SH2 <- array(NA, 2*NH)
for (i in 1:(2*NH)) {
if (i <= 0) SH2[i] <- 0
if (i > 0 & i < Param[4]) SH2[i] <- 0.5*(i/Param[4])^(D)
if (i >= Param[4] & i < 2*Param[4]) SH2[i] <- 1 - (0.5*(2-i/Param[4])^(D))
if (i >= 2*Param[4]) SH2[i] <- 1
}
# Calcul des ordonnees UH2 de l' "hydrogramme unitaire discret" UH2
UH2 <- array(NA, 2*NH)
for (j in 1:(2*NH)) {
if (j == 1) {
UH2[j] <- SH2[j]
} else {
UH2[j] <- SH2[j] - SH2[j-1]
}
}
# Parametres
max_UH2 <- log(sqrt(max(max(UH2)*OutputsModel$PR*0.1))+1)
}
# Parametres
max_UH2 <- log(sqrt(max(max(UH2)*OutputsModel$PR*0.1))+1)
# --------------------------------------------------------------------------------
# PARTITIONNEMENT FENETRE GRAPHIQUE
# --------------------------------------------------------------------------------
......@@ -308,13 +310,18 @@ if (getRversion() >= "2.15.1") {
# NEUTRALISATION DE P
# --------------------------------------------------------------------------------
# Interception
segments(x0 = xy_E[1]-50, x1 = xy_P[1]+50,
y0 = y_interception+tmp_decal, y1 = y_interception+tmp_decal)
text(x = xy_P[1]+50, y = y_interception+20, labels = "Interception", pos = 4, font = 1, cex = 1.4)
if (HydroModel != "GR2M") {
# Interception
segments(x0 = xy_E[1]-50, x1 = xy_P[1]+50,
y0 = y_interception+tmp_decal, y1 = y_interception+tmp_decal)
text(x = xy_P[1]+50, y = y_interception+20, labels = "Interception", pos = 4, font = 1, cex = 1.4)
}
# E vers Es et P vers Ps ou Pn
y_Xs <- ifelse(HydroModel == "GR2M", y_rendement+2*tmp_decal, y_interception+tmp_decal)
# P vers Pn
segments(x0 = xy_P[1], x1 = xy_P[1], y0 = xy_P[2], y1 = y_interception+tmp_decal)
segments(x0 = xy_P[1], x1 = xy_P[1], y0 = xy_P[2], y1 = y_Xs)
# Pn vers Ps
segments(x0 = xy_P[1], x1 = xy_P[1],
......@@ -324,27 +331,29 @@ if (getRversion() >= "2.15.1") {
segments(x0 = x_Ps, x1 = x_Ps,
y0 = y_rendement+2*tmp_decal, y1 = y_rendement)
# Pn vers Pn - Ps
# Pn vers Pn - Ps (P vers Pn si GR2M)
segments(x0 = xy_P[1], x1 = x_PnPs,
y0 = y_rendement+2*tmp_decal, y1 = y_rendement+2*tmp_decal)
segments(x0 = x_PnPs , x1 = x_PnPs,
y0 = y_rendement+2*tmp_decal, y1 = y_rendement)
# Pn - Ps vers Pr
# Pn - Ps vers Pr (Pn vers Pr si GR2M)
segments(x0 = x_PnPs, x1 = x_PnPs,
y0 = y_rendement, y1 = y_percolation)
# E vers En puis Es
segments(x0 = xy_E[1], x1 = xy_E[1],
y0 = xy_E[2], y1 = y_interception+tmp_decal)
y0 = xy_E[2], y1 = y_Xs)
segments(x0 = xy_E[1], x1 = xy_E[1],
y0 = y_interception, y1 = y_rendement)
if (HydroModel != "GR2M") {
# Ecriture
plotrix::boxed.labels(x = xy_P[1], y = y_interception, labels = "Pn",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
plotrix::boxed.labels(x = xy_E[1], y = y_interception, labels = "En",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
}
# ETP
if (OutputsModel$PotEvap[i_pdt] != 0) {
......@@ -361,14 +370,18 @@ if (getRversion() >= "2.15.1") {
}
# Pn et Ps
points(x = x_Ps, y = y_rendement+1.2*tmp_decal,
type = "p", pch = tri_B, col = col_P,
cex = cex_tri(OutputsModel$Ps[i_pdt], fact = fact_triangle, max = cex_max_poly))
points(x = x_PnPs, y = y_rendement+1.2*tmp_decal,
type = "p", pch = tri_B, col = col_P,
cex = cex_tri(OutputsModel$Pn[i_pdt] - OutputsModel$Ps[i_pdt], fact = fact_triangle, max = cex_max_poly))
if (HydroModel != "GR2M") {
points(x = x_PnPs, y = y_rendement+1.2*tmp_decal,
type = "p", pch = tri_B, col = col_P,
cex = cex_tri(OutputsModel$Pn[i_pdt] - OutputsModel$Ps[i_pdt], fact = fact_triangle, max = cex_max_poly))
} else {
points(x = x_PnPs, y = y_rendement+1.2*tmp_decal,
type = "p", pch = tri_B, col = col_P,
cex = cex_tri(OutputsModel$Pn[i_pdt], fact = fact_triangle, max = cex_max_poly))
}
# --------------------------------------------------------------------------------
......@@ -386,10 +399,10 @@ if (getRversion() >= "2.15.1") {
cex = cex_tri(OutputsModel$AE[i_pdt], fact = fact_triangle, max = cex_max_poly))
}
# Ps et Pn - Ps
# Ps et Pn - Ps (Ps et Pn si GR2M)
plotrix::boxed.labels(x = x_Ps , y = y_rendement, labels = "Ps" ,
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
plotrix::boxed.labels(x = x_PnPs, y = y_rendement, labels = "Pn - Ps",
plotrix::boxed.labels(x = x_PnPs, y = y_rendement, labels = ifelse(HydroModel != "GR2M", "Pn - Ps", "Pn"),
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Reservoir de production
......@@ -429,9 +442,23 @@ if (getRversion() >= "2.15.1") {
# parametres
tmp_decal <- (y_percolation - y_entreeUH) / 2
# Pr vers UH
# Pr vers UH (Pr vers reservoir de routage si GR2M)
k <- ifelse(HydroModel == "GR2M", 0.5, 1)
segments(x0 = x_PnPs, x1 = x_PnPs,
y0 = y_percolation, y1 = y_entreeUH+tmp_decal/2)
y0 = y_percolation, y1 = (y_entreeUH*k) + tmp_decal/2)
if (HydroModel == "GR2M") {
plotrix::boxed.labels(x = x_PnPs, y = y_percolation, labels = "Pr",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
if (OutputsModel$PR[i_pdt] != 0) {
points(x = x_PnPs[1], y = y_entreeUH+tmp_decal,
type = "p", pch = tri_B, col = col_P,
cex = cex_tri(OutputsModel$PR[i_pdt], fact = fact_triangle, max = cex_max_poly))
}
}
if (HydroModel %in% c("GR4J", "GR6J")) {
......@@ -494,7 +521,6 @@ if (getRversion() >= "2.15.1") {
cex = cex_tri(OutputsModel$PR[i_pdt]*0.1, fact = fact_triangle, max = cex_max_poly))
}
# Remplissage de UH2
PR_mat_UH2_lg <- ceiling(Param[4]*2)
PR_mat_UH2_id <- max(i_pdt-PR_mat_UH2_lg+1, 1):i_pdt
......@@ -578,49 +604,51 @@ if (getRversion() >= "2.15.1") {
y0 = y_routage, y1 = y_routage)
}
# Q9
if (OutputsModel$Q9[i_pdt] != 0) {
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,
if (HydroModel != "GR2M") {
# Q9
if (OutputsModel$Q9[i_pdt] != 0) {
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]*0.4, fact = fact_triangle, max = cex_max_poly))
# Q9 rout
points(x = xy_Q9[1]*1.30, y = xy_Q9[1]*0.73,
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)
# Q1
if (OutputsModel$Q1[i_pdt] != 0) {
points(x = xy_Q1[1], y = xy_Q1[2]+tmp_decal,
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)
cex = cex_tri(OutputsModel$Q1[i_pdt], fact = fact_triangle, max = cex_max_poly))
segments(x0 = xy_Q[1], x1 = xy_Q1[1], y0 = y_routage, y1 = y_routage)
}
plotrix::boxed.labels(x = xy_Q1[1], y = xy_Q1[2], labels = "Q1", bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Valeur de Qd
if (OutputsModel$QD[i_pdt] != 0) {
points(x = xy_Q[1]+30, y = y_routage,
type = "p", pch = tri_L, col = col_P,
cex = cex_tri(OutputsModel$QD[i_pdt], fact = fact_triangle, max = cex_max_poly))
}
# Qd
plotrix::boxed.labels(x = xy_Q1[1], y = y_routage, labels = "Qd", 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)
# Q1
if (OutputsModel$Q1[i_pdt] != 0) {
points(x = xy_Q1[1], y = xy_Q1[2]+tmp_decal,
type = "p", pch = tri_B, col = col_P,
cex = cex_tri(OutputsModel$Q1[i_pdt], fact = fact_triangle, max = cex_max_poly))
segments(x0 = xy_Q[1], x1 = xy_Q1[1], y0 = y_routage, y1 = y_routage)
}
plotrix::boxed.labels(x = xy_Q1[1], y = xy_Q1[2], labels = "Q1", bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Valeur de Qd
if (OutputsModel$QD[i_pdt] != 0) {
points(x = xy_Q[1]+30, y = y_routage,
type = "p", pch = tri_L, col = col_P,
cex = cex_tri(OutputsModel$QD[i_pdt], fact = fact_triangle, max = cex_max_poly))
}
# Qd
plotrix::boxed.labels(x = xy_Q1[1], y = y_routage, labels = "Qd", bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# --------------------------------------------------------------------------------
# RESERVOIR DE ROUTAGE
# --------------------------------------------------------------------------------
......@@ -629,6 +657,10 @@ if (getRversion() >= "2.15.1") {
tmp_triche <- 0#80
# Reservoir de routage
if (HydroModel == "GR2M") {
xy_min_ROUT[1] <- x_PnPs - base_res/2
Param[