diff --git a/DESCRIPTION b/DESCRIPTION index 21e1e492de748f83269071f980d96dc3da4da0e5..70f369e392792366ac7565bad8a259de89dfe66e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: airGRteaching Type: Package 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 Authors@R: c( person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"), diff --git a/NEWS.md b/NEWS.md index 205b7ba1f6355235a2de7e08c4466db17d441387..9d48fef0c0135c2f3bc639af2ad9e15450dfc855 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,7 @@ -### 0.2.10.10 Release Notes (2020-04-14) +### 0.2.10.11 Release Notes (2020-04-14) #### New features diff --git a/inst/ShinyGR/server.R b/inst/ShinyGR/server.R index 61b2b2b83897aee2a7b004d112c29d436c504d31..d2d57561a025a10b8782fdfb75c8fba8233b2734 100644 --- a/inst/ShinyGR/server.R +++ b/inst/ShinyGR/server.R @@ -384,7 +384,7 @@ shinyServer(function(input, output, session) { precip. = OutputsModel2$Precip, PET = OutputsModel2$PotEvap, 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)), @@ -405,10 +405,10 @@ shinyServer(function(input, output, session) { data$'QrExp' <- OutputsModel2$QRExp } if (input$HydroModel != "GR2M") { - data$'rout.' <- OutputsModel2$Rout data$'Qr' <- OutputsModel2$QR data$'Qd' <- OutputsModel2$QD } + return(list(OutputsModel = OutputsModel2, Tab = data)) } }) @@ -657,11 +657,11 @@ shinyServer(function(input, output, session) { # data <- data.frame(DatesR = OutputsModel$DatesR, # prod. = OutputsModel$Prod, # 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") colors <- c("#00008B", "#008B8B", "#10B510", "#FF0303")[seq_len(ncol(data.xts))] - + op <- getPlotPar()$par dgSVs <- dygraphs::dygraph(data.xts, group = "state_var", ylab = "store [mm]") dgSVs <- dygraphs::dyOptions(dgSVs, colors = colors, @@ -983,7 +983,7 @@ shinyServer(function(input, output, session) { # } colSelec <- c("DatesR", "prod.", - grep("^rout.$", colnames(getData()$Tab), value = TRUE), + "rout.", grep("^Qr$", colnames(getData()$Tab), value = TRUE), grep("^Qd$", colnames(getData()$Tab), value = TRUE), grep("^QrExp|exp", colnames(getData()$Tab), value = TRUE), @@ -992,40 +992,28 @@ shinyServer(function(input, output, session) { data <- getData()$Tab[, colSelec] 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) - if (input$HydroModel != "GR6J" & input$HydroModel != "GR2M") { + if (input$HydroModel != "GR6J") { plot(range(data$Dates), range(data$prod., data$rout., na.rm = TRUE), 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") { data$exp. <- rowSums(data[, c("exp. (+)", "exp. (-)")], na.rm = TRUE) plot(range(data$Dates), range(data$prod., data$rout., data$rout., data$exp.), 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)) - 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") { minQrExp <- min(data$prod., data$rout., data$exp., 0) 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)) } - if (input$HydroModel != "GR6J" & input$HydroModel != "GR2M") { + if (input$HydroModel != "GR6J") { legend("topright", bty = "n", legend = c("prod.", "rout."), cex = 0.8, pt.bg = adjustcolor(c("darkblue", "cyan4"), alpha.f = 0.30), col = c("darkblue", "cyan4"), 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") { 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),