Commit 57143da8 authored by unknown's avatar unknown
Browse files

v0.1.2.20 exchange values en plotting fixed in shiny.SimGR

parent 145fc454
Package: airGRteaching
Type: Package
Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Application)
Version: 0.1.2.19
Version: 0.1.2.20
Date: 2017-04-07
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.5.22)
......
......@@ -93,10 +93,10 @@ DiagramGR4J <- function(OutputsModel, Param, SimPer, EventDate) {
max_triangle <- max(unlist(OutputsModel[c("Perc", "PR", "Q9", "Q1", "QR", "QD")]))
fact_var <- 40
fact_triangle <- 100#25
cex_tri <- function(cex, fact = 25, max) suppressWarnings(log(cex * fact + 1) / max)
cex_max_poly <- 2 # 0.005
cex_tri <- function(cex, fact = 25, max) suppressWarnings(log(abs(cex) * fact + 1) / max)
radius1 <- 0
radius2 <- 60
cex_max_poly <- 2 # 0.005
tri_R <- -0x25BA
tri_B <- -0x25BC
tri_L <- -0x25C4
......@@ -411,20 +411,6 @@ DiagramGR4J <- function(OutputsModel, Param, SimPer, EventDate) {
# Q1
boxed.labels(x = xy_Q1[1], y = xy_Q1[2], labels = "Q1", bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Echange
tmp_Exch <- Param[2]*(OutputsModel$Rout[i_pdt]/Param[3])^(7/2)
if (tmp_Exch < 0) {
tmp_sens <- "G"
} else {
tmp_sens <- "D"
}
arrows(x0 = xy_Q1[1], x1 = 1025,
y0 = y_Ech_Q1, y1 = y_Ech_Q1,
length = 0.075, angle = 20, code = 3)
points(x = xy_Q1[1]+100, y = y_Ech_Q1,
type = "p", pch = ifelse(tmp_Exch < 0, tri_R, tri_L), col = col_P,
cex = cex_tri(tmp_Exch, fact = fact_triangle, max = cex_max_poly))
# Valeur de Qd
if (OutputsModel$QD[i_pdt] != 0) {
points(x = xy_Q[1]+30, y = y_routage,
......@@ -462,11 +448,6 @@ DiagramGR4J <- function(OutputsModel, Param, SimPer, EventDate) {
segments(x0 = xy_min_ROUT[1]+base_res/2, x1 = xy_Q[1],
y0 = y_routage, y1 = y_routage)
# Echange
arrows(x0 = xy_min_ROUT[1]+base_res, x1 = 1025,
y0 = y_Ech_Q9 , y1 = y_Ech_Q9,
length = 0.075, angle = 20, code = 3)
# Qr
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)
......@@ -480,14 +461,43 @@ DiagramGR4J <- function(OutputsModel, Param, SimPer, EventDate) {
# Q final
segments(x0 = xy_Q[1], x1 = xy_Q[1], y0 = y_routage, y1 = xy_Q[2]+10)
# Echange
# --------------------------------------------------------------------------------
# EXCHANGE
# --------------------------------------------------------------------------------
# Potential exchange
ExchPot <- Param[2]*(OutputsModel$Rout[i_pdt]/Param[3])^(7/2)
# Actual exchange Q9
ExchActuQ9 <- ifelse(test = (OutputsModel$Rout[i_pdt] + OutputsModel$Q9[i_pdt] + ExchPot) < 0,
yes = -(OutputsModel$Rout[i_pdt] + OutputsModel$Q9[i_pdt]),
no = ExchPot)
arrows(x0 = xy_min_ROUT[1]+base_res, x1 = 1025,
y0 = y_Ech_Q9 , y1 = y_Ech_Q9,
length = 0.075, angle = 20, code = 3)
points(x = xy_min_ROUT[1]+base_res+100, y = y_Ech_Q9,
type = "p", pch = ifelse(tmp_Exch < 0, tri_R, tri_L), col = col_P,
cex = cex_tri(tmp_Exch, fact = fact_triangle, max = cex_max_poly))
type = "p", pch = ifelse(ExchActuQ9 < 0, tri_R, tri_L), col = col_P,
cex = cex_tri(ExchActuQ9, fact = fact_triangle, max = cex_max_poly))
# Actual exchange Q1
ExchActuQ1 <- ifelse(test = (OutputsModel$Q1[i_pdt] + ExchPot) < 0,
yes = -(OutputsModel$Q1[i_pdt]),
no = ExchPot)
arrows(x0 = xy_Q1[1], x1 = 1025,
y0 = y_Ech_Q1, y1 = y_Ech_Q1,
length = 0.075, angle = 20, code = 3)
points(x = xy_Q1[1]+100, y = y_Ech_Q1,
type = "p", pch = ifelse(ExchActuQ1 < 0, tri_R, tri_L), col = col_P,
cex = cex_tri(ExchActuQ1, fact = fact_triangle, max = cex_max_poly))
# UH1&2
tmpUH1 <- PR_mat_UH1 %*% UH1[seq_len(PR_mat_UH1_lg)] * 0.75 # 0.75 au lieu de 0.90 pour reduire dif. visuelle
# --------------------------------------------------------------------------------
# UH1&2 PLOT
# --------------------------------------------------------------------------------
tmpUH1 <- PR_mat_UH1 %*% UH1[seq_len(PR_mat_UH1_lg)] * 0.75 # 0.75 au lieu de 0.90 pour reduire dif. visuelle
tmpUH2 <- PR_mat_UH2 %*% UH2[seq_len(PR_mat_UH2_lg)] * 0.25 # 0.25 au lieu de 0.10 pour reduire dif. visuelle
palUH0 <- colorRampPalette(c("#428BCA", "#B5D2EA"))
par(mar = rep(1, 4))
......@@ -501,6 +511,7 @@ DiagramGR4J <- function(OutputsModel, Param, SimPer, EventDate) {
par(new = TRUE)
barplot(tmpUH2, beside = TRUE, space = 0, col = palUH0(length(tmpUH2)),
ylim = range(c(0, 5/length(PR_mat_UH2_lg)), na.rm = TRUE))
}
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