Commit 9d6f59ad authored by unknown's avatar unknown
Browse files

v0.1.9.2 it is now possible to draw the model diagram in ShinyGR using the GR6J model

parent 3e7dfa93
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.1
Date: 2018-01-17
Version: 0.1.9.2
Date: 2018-01-18
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)
Imports: devtools, dygraphs (>= 1.1.1.4), markdown, plotrix, shiny, shinyjs, xts
......
......@@ -67,7 +67,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
# --------------------------------------------------------------------------------
# Parametres
mgp <- c(3, 0.75, 0)
mgp <- c(0, 0.75, 0)
col_P <- rgb(066, 139, 202, maxColorValue = 255) #"royalblue"
col_E <- rgb(164, 196, 000, maxColorValue = 255) #"forestgreen"
col_Q <- "orangered"
......@@ -95,6 +95,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
NH <- 10
xy_min_PROD <- c(200, 610)
xy_min_ROUT <- c(250, 150)
xy_min_EXPO <- c(200, 250)
y_entreeUH <- 500
xy_UH1 <- c(500, 420)
xy_UH2 <- c(900, 420)
......@@ -116,15 +117,15 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
tri_L <- -0x25C4
tri_T <- -0x25B2
par(col.axis = par("fg"), cex.axis = 1.3, cex.lab = 1.3, cex = 0.7)
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)
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"
col_mod_bg <- "#ECF0F1"
col_mod_bd <- "#ECF0F1"
}
# Pas de temps
......@@ -138,7 +139,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
# UH 1 & 2
# --------------------------------------------------------------------------------
if (HydroModel == "GR4J") {
if (HydroModel %in% c("GR4J", "GR6J")) {
# Calcul des ordonnees SH1 de l' "hydrogramme unitaire cumule" UH1
SH1 <- array(NA, NH)
for (i in 1:NH) {
......@@ -381,7 +382,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
segments(x0 = x_PnPs, x1 = x_PnPs,
y0 = y_percolation, y1 = y_entreeUH+tmp_decal/2)
if (HydroModel == "GR4J") {
if (HydroModel %in% c("GR4J", "GR6J")) {
# --------------------------------------------------------------------------------
# SEPARATION DE PR
......@@ -508,6 +509,20 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
}
# sortie de UH1 vers reservoirs exponentiel et de routage
if (HydroModel == "GR6J") {
segments(x0 = xy_Q9[1], x1 = xy_Q9[1],
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]*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)
}
# Q9
if (OutputsModel$Q9[i_pdt] != 0) {
points(x = xy_Q9[1], y = xy_Q9[2]+tmp_decal,
......@@ -538,6 +553,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
# 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
# --------------------------------------------------------------------------------
......@@ -584,6 +600,38 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
}
# --------------------------------------------------------------------------------
# RESERVOIR EXPONENTIEL
# --------------------------------------------------------------------------------
if (HydroModel == "GR6J") {
# Triche pour la taille du reservoire exponentiel
tmp_triche <- 0#80
# Reservoir exponentiel
rect(xleft = xy_min_EXPO[1], xright = xy_min_EXPO[1]+base_res,
ybottom = xy_min_EXPO[2], ytop = xy_min_EXPO[2]+OutputsModel$Exp[i_pdt]*fact_res+tmp_triche,
col = ifelse(OutputsModel$Exp[i_pdt] > 0, "green3", "red"), border = NA)
# rect(xleft = xy_min_EXPO[1], xright = xy_min_EXPO[1]+base_res,
# ybottom = xy_min_EXPO[2], ytop = xy_min_EXPO[2]-OutputsModel$Exp[i_pdt]*fact_res-tmp_triche,
# col = col_SR, border = NA)
segments(x0 = xy_min_EXPO[1], x1 = xy_min_EXPO[1]+base_res,
y0 = xy_min_EXPO[2], y1 = xy_min_EXPO[2])
segments(x0 = xy_min_EXPO[1], x1 = xy_min_EXPO[1],
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)
segments(x0 = xy_min_EXPO[1], x1 = xy_min_EXPO[1],
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",
cex = 1.4, pos = 4)
}
# --------------------------------------------------------------------------------
# EXCHANGE
# --------------------------------------------------------------------------------
......@@ -606,7 +654,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
type = "p", pch = pch, col = col_P,
cex = cex_tri(OutputsModel$AExch2[i_pdt], fact = fact_triangle, max = cex_max_poly))
if (HydroModel == "GR4J") {
if (HydroModel%in% c("GR4J", "GR6J")) {
# --------------------------------------------------------------------------------
# UH 1 & 2 PLOT
......
......@@ -263,7 +263,7 @@ shinyServer(function(input, output, session) {
## Models available considering the plot type
observe({
if (getPlotType() == 4) {
updateSelectInput(session, inputId = "HydroModel", choice = c("GR4J", "GR5J"), selected = input$HydroModel)
updateSelectInput(session, inputId = "HydroModel", choice = c("GR4J", "GR5J", "GR6J"), selected = input$HydroModel)
updateSelectInput(session, inputId = "SnowModel" , choice = c("None"))
} else {
updateSelectInput(session, inputId = "HydroModel", choice = c("GR4J", "GR5J", "GR6J"), selected = input$HydroModel)
......@@ -273,17 +273,17 @@ shinyServer(function(input, output, session) {
## Plots available considering the model type
observe({
if (input$HydroModel == "GR6J") {
updateSelectInput(session, inputId = "PlotType",
choice = c("Flow time series", "Model performance", "State variables"),
selected = input$PlotType)
} else {
updateSelectInput(session, inputId = "PlotType",
choice = c("Flow time series", "Model performance", "State variables", "Model diagram"),
selected = input$PlotType)
}
})
# observe({
# if (input$HydroModel == "GR6J") {
# updateSelectInput(session, inputId = "PlotType",
# choice = c("Flow time series", "Model performance", "State variables"),
# selected = input$PlotType)
# } else {
# updateSelectInput(session, inputId = "PlotType",
# choice = c("Flow time series", "Model performance", "State variables", "Model diagram"),
# selected = input$PlotType)
# }
# })
# Formated simulation results
......
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