Commit fd766a6e authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v0.2.10.11 BUG: missing routing store time series added in GUI when GR2M is used #14

Showing with 10 additions and 22 deletions
+10 -22
Package: airGRteaching Package: airGRteaching
Type: Package Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included) Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
Version: 0.2.10.10 Version: 0.2.10.11
Date: 2020-04-14 Date: 2020-04-14
Authors@R: c( Authors@R: c(
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"), person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
### 0.2.10.10 Release Notes (2020-04-14) ### 0.2.10.11 Release Notes (2020-04-14)
#### New features #### New features
......
...@@ -384,7 +384,7 @@ shinyServer(function(input, output, session) { ...@@ -384,7 +384,7 @@ shinyServer(function(input, output, session) {
precip. = OutputsModel2$Precip, precip. = OutputsModel2$Precip,
PET = OutputsModel2$PotEvap, PET = OutputsModel2$PotEvap,
prod. = OutputsModel2$Prod, prod. = OutputsModel2$Prod,
# rout. = OutputsModel2$Rout, rout. = OutputsModel2$Rout,
# exp. = rep(NA, length(OutputsModel2$DatesR)), # exp. = rep(NA, length(OutputsModel2$DatesR)),
# 'exp. (+)'= rep(NA, length(OutputsModel2$DatesR)), # 'exp. (+)'= rep(NA, length(OutputsModel2$DatesR)),
# 'exp. (-)'= rep(NA, length(OutputsModel2$DatesR)), # 'exp. (-)'= rep(NA, length(OutputsModel2$DatesR)),
...@@ -405,10 +405,10 @@ shinyServer(function(input, output, session) { ...@@ -405,10 +405,10 @@ shinyServer(function(input, output, session) {
data$'QrExp' <- OutputsModel2$QRExp data$'QrExp' <- OutputsModel2$QRExp
} }
if (input$HydroModel != "GR2M") { if (input$HydroModel != "GR2M") {
data$'rout.' <- OutputsModel2$Rout
data$'Qr' <- OutputsModel2$QR data$'Qr' <- OutputsModel2$QR
data$'Qd' <- OutputsModel2$QD data$'Qd' <- OutputsModel2$QD
} }
return(list(OutputsModel = OutputsModel2, Tab = data)) return(list(OutputsModel = OutputsModel2, Tab = data))
} }
}) })
...@@ -657,11 +657,11 @@ shinyServer(function(input, output, session) { ...@@ -657,11 +657,11 @@ shinyServer(function(input, output, session) {
# data <- data.frame(DatesR = OutputsModel$DatesR, # data <- data.frame(DatesR = OutputsModel$DatesR,
# prod. = OutputsModel$Prod, # prod. = OutputsModel$Prod,
# rout. = OutputsModel$Rout) # rout. = OutputsModel$Rout)
data <- getData()$Tab[, c("DatesR", "prod.", grep("^rout", colnames(getData()$Tab), value = TRUE), grep("^exp", colnames(getData()$Tab), value = TRUE))] data <- getData()$Tab[, c("DatesR", "prod.", "rout.", grep("^exp", colnames(getData()$Tab), value = TRUE))]
data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR, tzone = "UTC") data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR, tzone = "UTC")
colors <- c("#00008B", "#008B8B", "#10B510", "#FF0303")[seq_len(ncol(data.xts))] colors <- c("#00008B", "#008B8B", "#10B510", "#FF0303")[seq_len(ncol(data.xts))]
op <- getPlotPar()$par op <- getPlotPar()$par
dgSVs <- dygraphs::dygraph(data.xts, group = "state_var", ylab = "store [mm]") dgSVs <- dygraphs::dygraph(data.xts, group = "state_var", ylab = "store [mm]")
dgSVs <- dygraphs::dyOptions(dgSVs, colors = colors, dgSVs <- dygraphs::dyOptions(dgSVs, colors = colors,
...@@ -983,7 +983,7 @@ shinyServer(function(input, output, session) { ...@@ -983,7 +983,7 @@ shinyServer(function(input, output, session) {
# } # }
colSelec <- c("DatesR", colSelec <- c("DatesR",
"prod.", "prod.",
grep("^rout.$", colnames(getData()$Tab), value = TRUE), "rout.",
grep("^Qr$", colnames(getData()$Tab), value = TRUE), grep("^Qr$", colnames(getData()$Tab), value = TRUE),
grep("^Qd$", colnames(getData()$Tab), value = TRUE), grep("^Qd$", colnames(getData()$Tab), value = TRUE),
grep("^QrExp|exp", colnames(getData()$Tab), value = TRUE), grep("^QrExp|exp", colnames(getData()$Tab), value = TRUE),
...@@ -992,40 +992,28 @@ shinyServer(function(input, output, session) { ...@@ -992,40 +992,28 @@ shinyServer(function(input, output, session) {
data <- getData()$Tab[, colSelec] data <- getData()$Tab[, colSelec]
par(mfrow = c(2, 1), oma = c(3, 0, 4, 0)) par(mfrow = c(2, 1), oma = c(3, 0, 4, 0))
par(mar = c(0.6, 4.0, 0.0, 2.0), xaxt = "n", cex = 0.8) par(mar = c(0.6, 4.0, 0.0, 2.0), xaxt = "n", cex = 0.8)
if (input$HydroModel != "GR6J" & input$HydroModel != "GR2M") { if (input$HydroModel != "GR6J") {
plot(range(data$Dates), range(data$prod., data$rout., na.rm = TRUE), plot(range(data$Dates), range(data$prod., data$rout., na.rm = TRUE),
type = "n", xlab = "", ylab = "store [mm]") type = "n", xlab = "", ylab = "store [mm]")
} }
if (input$HydroModel == "GR2M") {
plot(range(data$Dates), range(data$prod., na.rm = TRUE),
type = "n", xlab = "", ylab = "store [mm]")
}
if (input$HydroModel == "GR6J") { if (input$HydroModel == "GR6J") {
data$exp. <- rowSums(data[, c("exp. (+)", "exp. (-)")], na.rm = TRUE) data$exp. <- rowSums(data[, c("exp. (+)", "exp. (-)")], na.rm = TRUE)
plot(range(data$Dates), range(data$prod., data$rout., data$rout., data$exp.), plot(range(data$Dates), range(data$prod., data$rout., data$rout., data$exp.),
type = "n", xlab = "", ylab = "store [mm]") type = "n", xlab = "", ylab = "store [mm]")
} }
polygon(c(data$Dates, rev(range(data$Dates))), c(data$prod., rep(0, 2)), border = "darkblue", col = adjustcolor("darkblue", alpha.f = 0.30)) polygon(c(data$Dates, rev(range(data$Dates))), c(data$prod., rep(0, 2)), border = "darkblue", col = adjustcolor("darkblue", alpha.f = 0.30))
if (input$HydroModel != "GR2M") { polygon(c(data$Dates, rev(range(data$Dates))), c(data$rout., rep(0, 2)), border = "cyan4" , col = adjustcolor("cyan4" , alpha.f = 0.30))
polygon(c(data$Dates, rev(range(data$Dates))), c(data$rout., rep(0, 2)), border = "cyan4" , col = adjustcolor("cyan4" , alpha.f = 0.30))
}
if (input$HydroModel == "GR6J") { if (input$HydroModel == "GR6J") {
minQrExp <- min(data$prod., data$rout., data$exp., 0) minQrExp <- min(data$prod., data$rout., data$exp., 0)
colQrExp <- ifelse(minQrExp > 0, "#10B510", "#FF0303") colQrExp <- ifelse(minQrExp > 0, "#10B510", "#FF0303")
polygon(c(data$Dates, rev(range(data$Dates))), c(data$exp., rep(0, 2)), border = colQrExp, col = adjustcolor(colQrExp, alpha.f = 0.30)) polygon(c(data$Dates, rev(range(data$Dates))), c(data$exp., rep(0, 2)), border = colQrExp, col = adjustcolor(colQrExp, alpha.f = 0.30))
} }
if (input$HydroModel != "GR6J" & input$HydroModel != "GR2M") { if (input$HydroModel != "GR6J") {
legend("topright", bty = "n", legend = c("prod.", "rout."), cex = 0.8, legend("topright", bty = "n", legend = c("prod.", "rout."), cex = 0.8,
pt.bg = adjustcolor(c("darkblue", "cyan4"), alpha.f = 0.30), pt.bg = adjustcolor(c("darkblue", "cyan4"), alpha.f = 0.30),
col = c("darkblue", "cyan4"), col = c("darkblue", "cyan4"),
pch = 22) pch = 22)
} }
if (input$HydroModel == "GR2M") {
legend("topright", bty = "n", legend = c("prod."), cex = 0.8,
pt.bg = adjustcolor(c("darkblue"), alpha.f = 0.30),
col = c("darkblue"),
pch = 22)
}
if (input$HydroModel == "GR6J") { if (input$HydroModel == "GR6J") {
legend("topright", bty = "n", legend = c("prod.", "rout.", "exp. (+)", "exp. (-)"), cex = 0.8, legend("topright", bty = "n", legend = c("prod.", "rout.", "exp. (+)", "exp. (-)"), cex = 0.8,
pt.bg = adjustcolor(c("darkblue", "cyan4", "#10B510", "#FF0303"), alpha.f = 0.30), pt.bg = adjustcolor(c("darkblue", "cyan4", "#10B510", "#FF0303"), alpha.f = 0.30),
......
Supports Markdown
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