Skip to content

GitLab

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
Hide whitespace changes
Inline Side-by-side
DESCRIPTION
View file @ 9d6f59ad
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
......
R/Utils.R
View file @ 9d6f59ad
......@@ -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
......
inst/ShinyGR/server.R
View file @ 9d6f59ad
......@@ -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