Commit a5f6e809 authored by unknown's avatar unknown
Browse files

v0.1.7.0 management of package imports

parent 0ec29fe7
Package: airGRteaching Package: airGRteaching
Type: Package Type: Package
Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface) Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface)
Version: 0.1.6.15 Version: 0.1.7.0
Date: 2017-09-29 Date: 2017-10-01
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"))) 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) Depends: airGR (>= 1.0.9.43)
Imports: xts, dygraphs (>= 1.1.1.4), shiny, shinyjs, plotrix, markdown Imports: xts, dygraphs (>= 1.1.1.4), shiny, shinyjs, plotrix, markdown
......
...@@ -41,8 +41,11 @@ import(graphics) ...@@ -41,8 +41,11 @@ import(graphics)
import(grDevices) import(grDevices)
import(utils) import(utils)
import(airGR) import(airGR)
import(xts) importFrom(xts, xts)
import(dygraphs) import(dygraphs)
import(shiny) import(shiny)
importFrom(shinyjs, useShinyjs)
importFrom(shinyjs, enable)
importFrom(shinyjs, disable)
import(markdown) import(markdown)
importFrom(plotrix, boxed.labels) importFrom(plotrix, boxed.labels)
\ No newline at end of file
...@@ -274,10 +274,10 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -274,10 +274,10 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
y0 = y_interception, y1 = y_rendement) y0 = y_interception, y1 = y_rendement)
# Ecriture # Ecriture
boxed.labels(x = xy_P[1], y = y_interception, labels = "Pn", plotrix::boxed.labels(x = xy_P[1], y = y_interception, labels = "Pn",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
boxed.labels(x = xy_E[1], y = y_interception, labels = "En", plotrix::boxed.labels(x = xy_E[1], y = y_interception, labels = "En",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# ETP # ETP
if (OutputsModel$PotEvap[i_pdt] != 0) { if (OutputsModel$PotEvap[i_pdt] != 0) {
...@@ -309,8 +309,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -309,8 +309,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
# -------------------------------------------------------------------------------- # --------------------------------------------------------------------------------
# Es # Es
boxed.labels(x = xy_E[1], y = y_rendement, labels = "Es", plotrix::boxed.labels(x = xy_E[1], y = y_rendement, labels = "Es",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Evaporation reelle # Evaporation reelle
if (OutputsModel$AE[i_pdt] != 0) { if (OutputsModel$AE[i_pdt] != 0) {
...@@ -320,10 +320,10 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -320,10 +320,10 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
} }
# Ps et Pn - Ps # Ps et Pn - Ps
boxed.labels(x = x_Ps , y = y_rendement, labels = "Ps" , plotrix::boxed.labels(x = x_Ps , y = y_rendement, labels = "Ps" ,
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
boxed.labels(x = x_PnPs, y = y_rendement, labels = "Pn - Ps", plotrix::boxed.labels(x = x_PnPs, y = y_rendement, labels = "Pn - Ps",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Reservoir de production # Reservoir de production
rect(xleft = xy_min_PROD[1], xright = xy_min_PROD[1]+base_res, rect(xleft = xy_min_PROD[1], xright = xy_min_PROD[1]+base_res,
...@@ -350,8 +350,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -350,8 +350,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
y0 = y_percolation, y1 = y_percolation) y0 = y_percolation, y1 = y_percolation)
# Perc # Perc
boxed.labels(x = xy_min_PROD[1]+base_res/2, y = y_percolation, labels = "Perc.", plotrix::boxed.labels(x = xy_min_PROD[1]+base_res/2, y = y_percolation, labels = "Perc.",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Valeur de Perc # Valeur de Perc
if (OutputsModel$Perc[i_pdt] != 0) { if (OutputsModel$Perc[i_pdt] != 0) {
...@@ -386,8 +386,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -386,8 +386,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
y0 = y_entreeUH+tmp_decal/2, y1 = y_routage) y0 = y_entreeUH+tmp_decal/2, y1 = y_routage)
# Pr # Pr
boxed.labels(x = x_PnPs, y = y_percolation, labels = "Pr", plotrix::boxed.labels(x = x_PnPs, y = y_percolation, labels = "Pr",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Pr # Pr
if (OutputsModel$PR[i_pdt] != 0) { if (OutputsModel$PR[i_pdt] != 0) {
...@@ -460,8 +460,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -460,8 +460,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
y0 = y_entreeUH-3*tmp_decal, y1 = y_routage) y0 = y_entreeUH-3*tmp_decal, y1 = y_routage)
# Pr # Pr
boxed.labels(x = x_PnPs, y = y_percolation, labels = "Pr", plotrix::boxed.labels(x = x_PnPs, y = y_percolation, labels = "Pr",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# -------------------------------------------------------------------------------- # --------------------------------------------------------------------------------
...@@ -501,8 +501,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -501,8 +501,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
cex = cex_tri(OutputsModel$Q9[i_pdt], fact = fact_triangle, max = cex_max_poly)) cex = cex_tri(OutputsModel$Q9[i_pdt], fact = fact_triangle, max = cex_max_poly))
} }
boxed.labels(x = xy_Q9[1], y = xy_Q9[2], labels = "Q9", plotrix::boxed.labels(x = xy_Q9[1], y = xy_Q9[2], labels = "Q9",
bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Q1 # Q1
if (OutputsModel$Q1[i_pdt] != 0) { if (OutputsModel$Q1[i_pdt] != 0) {
...@@ -512,7 +512,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -512,7 +512,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
segments(x0 = xy_Q[1], x1 = xy_Q1[1], y0 = y_routage, y1 = y_routage) segments(x0 = xy_Q[1], x1 = xy_Q1[1], y0 = y_routage, y1 = y_routage)
} }
boxed.labels(x = xy_Q1[1], y = xy_Q1[2], labels = "Q1", bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) plotrix::boxed.labels(x = xy_Q1[1], y = xy_Q1[2], labels = "Q1", bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Valeur de Qd # Valeur de Qd
if (OutputsModel$QD[i_pdt] != 0) { if (OutputsModel$QD[i_pdt] != 0) {
...@@ -522,7 +522,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -522,7 +522,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
} }
# Qd # Qd
boxed.labels(x = xy_Q1[1], y = y_routage, labels = "Qd", bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad) 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 # RESERVOIR DE ROUTAGE
...@@ -551,8 +551,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -551,8 +551,8 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
y0 = y_routage, y1 = y_routage) y0 = y_routage, y1 = y_routage)
# Qr # Qr
boxed.labels(x = xy_min_ROUT[1]+base_res/2, y = y_routage, labels = "Qr", plotrix::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) bg = col_mod_bg, border = NA, xpad = xpad, ypad = ypad)
# Valeur de Qr # Valeur de Qr
if (OutputsModel$QR[i_pdt] != 0) { if (OutputsModel$QR[i_pdt] != 0) {
...@@ -582,7 +582,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -582,7 +582,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
points(x = xy_min_ROUT[1]+base_res+100, y = y_Ech_Q9, points(x = xy_min_ROUT[1]+base_res+100, y = y_Ech_Q9,
type = "p", pch = pch, col = col_P, type = "p", pch = pch, col = col_P,
cex = cex_tri(OutputsModel$AExch1[i_pdt], fact = fact_triangle, max = cex_max_poly)) cex = cex_tri(OutputsModel$AExch1[i_pdt], fact = fact_triangle, max = cex_max_poly))
# Actual exchange Q1 # Actual exchange Q1
arrows(x0 = xy_Q1[1], x1 = 1025, arrows(x0 = xy_Q1[1], x1 = 1025,
y0 = y_Ech_Q1, y1 = y_Ech_Q1, y0 = y_Ech_Q1, y1 = y_Ech_Q1,
...@@ -591,7 +591,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) { ...@@ -591,7 +591,7 @@ DiagramGR <- function(OutputsModel, Param, SimPer, EventDate, HydroModel) {
points(x = xy_Q1[1]+100, y = y_Ech_Q1, points(x = xy_Q1[1]+100, y = y_Ech_Q1,
type = "p", pch = pch, col = col_P, type = "p", pch = pch, col = col_P,
cex = cex_tri(OutputsModel$AExch2[i_pdt], fact = fact_triangle, max = cex_max_poly)) cex = cex_tri(OutputsModel$AExch2[i_pdt], fact = fact_triangle, max = cex_max_poly))
if (HydroModel == "GR4J") { if (HydroModel == "GR4J") {
# -------------------------------------------------------------------------------- # --------------------------------------------------------------------------------
......
...@@ -35,8 +35,8 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup", ...@@ -35,8 +35,8 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup",
if (!is.character(Qsup.name)) { if (!is.character(Qsup.name)) {
Qsup.name <- as.character(Qsup.name) Qsup.name <- as.character(Qsup.name)
} }
if (any(class(x) %in% "ObsGR")) { if (any(class(x) %in% "ObsGR")) {
data <- data.frame(DatesR = x$InputsModel$DatesR, data <- data.frame(DatesR = x$InputsModel$DatesR,
Precip = x$InputsModel$Precip, Precip = x$InputsModel$Precip,
...@@ -60,8 +60,8 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup", ...@@ -60,8 +60,8 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup",
data$Precip <- NULL data$Precip <- NULL
} }
} }
data.xts <- xts(data[, -1L], order.by = data$DatesR) data.xts <- xts::xts(data[, -1L], order.by = data$DatesR)
rgba <- function(x, alpha = 1) { rgba <- function(x, alpha = 1) {
sprintf("rgba(%s, %f)", paste0(col2rgb(x), collapse = ", "), alpha) sprintf("rgba(%s, %f)", paste0(col2rgb(x), collapse = ", "), alpha)
...@@ -85,17 +85,17 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup", ...@@ -85,17 +85,17 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup",
} }
dg <- dygraph(data.xts, main = main) dg <- dygraphs::dygraph(data.xts, main = main)
dg <- dySeries(dygraph = dg, name = "Qobs", axis = 'y' , color = col.Q[1L], drawPoints = TRUE) dg <- dygraphs::dySeries(dygraph = dg, name = "Qobs", axis = 'y' , color = col.Q[1L], drawPoints = TRUE)
dg <- dySeries(dygraph = dg, name = "Qsim", axis = 'y' , color = col.Q[2L]) dg <- dygraphs::dySeries(dygraph = dg, name = "Qsim", axis = 'y' , color = col.Q[2L])
dg <- dySeries(dygraph = dg, name = "Qsup", axis = 'y' , color = col.Q[3L], label = Qsup.name, strokePattern = "dashed") dg <- dygraphs::dySeries(dygraph = dg, name = "Qsup", axis = 'y' , color = col.Q[3L], label = Qsup.name, strokePattern = "dashed")
dg <- dyStackedBarGroup(dygraph = dg, name = grep("^P", colnames(data.xts), value = TRUE), axis = "y2", color = rev(col.Precip)) dg <- dygraphs::dyStackedBarGroup(dygraph = dg, name = grep("^P", colnames(data.xts), value = TRUE), axis = "y2", color = rev(col.Precip))
dg <- dyAxis(dygraph = dg, name = "y" , label = ylab[1L], dg <- dygraphs::dyAxis(dygraph = dg, name = "y" , label = ylab[1L],
valueRange = range(data.xts[, grep("^Q", colnames(data.xts))], na.rm = TRUE) * c(0.01, 1.59)) valueRange = range(data.xts[, grep("^Q", colnames(data.xts))], na.rm = TRUE) * c(0.01, 1.59))
dg <- dyAxis(dygraph = dg, name = "y2", label = ylab[2L], independentTicks = FALSE, dg <- dygraphs::dyAxis(dygraph = dg, name = "y2", label = ylab[2L], independentTicks = FALSE,
valueRange = rev(Plim) * c(2.99, 0.01)) valueRange = rev(Plim) * c(2.99, 0.01))
if (RangeSelector) { if (RangeSelector) {
dg <- dyRangeSelector(dygraph = dg, height = 15) dg <- dygraphs::dyRangeSelector(dygraph = dg, height = 15)
} }
if (plot.na) { if (plot.na) {
naQ_rle <- rle(is.na(data$Qobs)) naQ_rle <- rle(is.na(data$Qobs))
...@@ -103,22 +103,22 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup", ...@@ -103,22 +103,22 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup",
naQ_ids <- naQ_ide - naQ_rle$lengths[naQ_rle$values] -1 naQ_ids <- naQ_ide - naQ_rle$lengths[naQ_rle$values] -1
IDna <- data.frame(start = naQ_ids, end = naQ_ide) IDna <- data.frame(start = naQ_ids, end = naQ_ide)
for (i in seq_len(nrow(IDna))) { for (i in seq_len(nrow(IDna))) {
dg <- dyShading(dygraph = dg, dg <- dygraphs::dyShading(dygraph = dg,
from = as.character(data$DatesR)[IDna[i, "start"]], from = as.character(data$DatesR)[IDna[i, "start"]],
to = as.character(data$DatesR)[IDna[i, "end" ]], to = as.character(data$DatesR)[IDna[i, "end" ]],
color = col.na) color = col.na)
} }
} }
if (Roller) { if (Roller) {
dg <- dyRoller(dygraph = dg, rollPeriod = 5) dg <- dygraphs::dyRoller(dygraph = dg, rollPeriod = 5)
} }
if (is.numeric(Roller)) { if (is.numeric(Roller)) {
dg <- dyRoller(dygraph = dg, rollPeriod = Roller) dg <- dygraphs::dyRoller(dygraph = dg, rollPeriod = Roller)
} }
if (any(LegendShow %in% c("follow", "auto", "always", "onmouseover", "never"))) { if (any(LegendShow %in% c("follow", "auto", "always", "onmouseover", "never"))) {
dg <- dyLegend(dygraph = dg, show = LegendShow[1L]) dg <- dygraphs::dyLegend(dygraph = dg, show = LegendShow[1L])
} }
dg <- dyOptions(dygraph = dg, useDataTimezone = TRUE) dg <- dygraphs::dyOptions(dygraph = dg, useDataTimezone = TRUE)
return(dg) return(dg)
......
...@@ -310,7 +310,7 @@ shinyServer(function(input, output, session) { ...@@ -310,7 +310,7 @@ shinyServer(function(input, output, session) {
## Plot flow time series ## Plot flow time series
output$dyPlotTS <- renderDygraph({ output$dyPlotTS <- dygraphs::renderDygraph({
if (length(.GlobalEnv$.ShinyGR.hist) == 2 & input$ShowOldQsim == "Yes") { if (length(.GlobalEnv$.ShinyGR.hist) == 2 & input$ShowOldQsim == "Yes") {
QsimOld <- getRES()$SIMold[[1]]$Qsim QsimOld <- getRES()$SIMold[[1]]$Qsim
} else { } else {
...@@ -320,31 +320,31 @@ shinyServer(function(input, output, session) { ...@@ -320,31 +320,31 @@ shinyServer(function(input, output, session) {
op <- getPlotPar()$par op <- getPlotPar()$par
dg1 <- dyplot(getRES()$SIM, Qsup = QsimOld, Qsup.name = "Qold", RangeSelector = FALSE, LegendShow = "auto", dg1 <- dyplot(getRES()$SIM, Qsup = QsimOld, Qsup.name = "Qold", RangeSelector = FALSE, LegendShow = "auto",
col.Q = c(op$fg, "orangered", "grey"), col.Precip = "#428BCA") col.Q = c(op$fg, "orangered", "grey"), col.Precip = "#428BCA")
dg1 <- dyOptions(dg1, axisLineColor = op$fg, axisLabelColor = op$fg, retainDateWindow = FALSE) dg1 <- dygraphs::dyOptions(dg1, axisLineColor = op$fg, axisLabelColor = op$fg, retainDateWindow = FALSE)
dg1 <- dyLegend(dg1, show = "follow", width = 325) dg1 <- dygraphs::dyLegend(dg1, show = "follow", width = 325)
}) })
## Plot state variables stores ## Plot state variables stores
output$dyPlotSVs <- renderDygraph({ output$dyPlotSVs <- dygraphs::renderDygraph({
OutputsModel <- getRES()$SIM$OutputsModel OutputsModel <- getRES()$SIM$OutputsModel
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.xts <- xts(data[, -1L], order.by = data$DatesR) data.xts <- xts::xts(data[, -1L], order.by = data$DatesR)
op <- getPlotPar()$par op <- getPlotPar()$par
dg2 <- dygraph(data.xts, group = "state_var", ylab = "store [mm]") dg2 <- dygraphs::dygraph(data.xts, group = "state_var", ylab = "store [mm]")
dg2 <- dyOptions(dg2, colors = c("#00008B", "#008B8B"), dg2 <- dygraphs::dyOptions(dg2, colors = c("#00008B", "#008B8B"),
fillGraph = TRUE, fillAlpha = 0.3, fillGraph = TRUE, fillAlpha = 0.3,
drawXAxis = FALSE, axisLineColor = op$fg, axisLabelColor = op$fg, retainDateWindow = FALSE) drawXAxis = FALSE, axisLineColor = op$fg, axisLabelColor = op$fg, retainDateWindow = FALSE)
dg2 <- dyLegend(dg2, show = "always", width = 325) dg2 <- dygraphs::dyLegend(dg2, show = "always", width = 325)
dg2 <- dyCrosshair(dg2, direction = "vertical") dg2 <- dygraphs::dyCrosshair(dg2, direction = "vertical")
}) })
## Plot state variables Q ## Plot state variables Q
output$dyPlotSVq <- renderDygraph({ output$dyPlotSVq <- dygraphs::renderDygraph({
OutputsModel <- getRES()$SIM$OutputsModel OutputsModel <- getRES()$SIM$OutputsModel
IndPlot <- which(OutputsModel$DatesR >= input$Period[1L] & OutputsModel$DatesR <= input$Period[2L]) IndPlot <- which(OutputsModel$DatesR >= input$Period[1L] & OutputsModel$DatesR <= input$Period[2L])
OutputsModel2 <- sapply(OutputsModel[seq_len(which(names(OutputsModel) == "Qsim"))], function(x) x[IndPlot]) OutputsModel2 <- sapply(OutputsModel[seq_len(which(names(OutputsModel) == "Qsim"))], function(x) x[IndPlot])
...@@ -360,60 +360,60 @@ shinyServer(function(input, output, session) { ...@@ -360,60 +360,60 @@ shinyServer(function(input, output, session) {
} else { } else {
data$QrExp <- NA data$QrExp <- NA
} }
data.xts <- xts(data[, -1L], order.by = data$DatesR) data.xts <- xts::xts(data[, -1L], order.by = data$DatesR)
op <- getPlotPar()$par op <- getPlotPar()$par
dg3 <- dygraph(data.xts, group = "state_var", ylab = "flow [mm/d]", main = " ") dg3 <- dygraphs::dygraph(data.xts, group = "state_var", ylab = "flow [mm/d]", main = " ")
dg3 <- dyOptions(dg3, fillAlpha = 1.0, dg3 <- dygraphs::dyOptions(dg3, fillAlpha = 1.0,
axisLineColor = op$fg, axisLabelColor = op$fg, axisLineColor = op$fg, axisLabelColor = op$fg,
titleHeight = 10, retainDateWindow = FALSE) titleHeight = 10, retainDateWindow = FALSE)
dg3 <- dyStackedRibbonGroup(dg3, name = c("Qd", "Qr", "QrExp"), dg3 <- dygraphs::dyStackedRibbonGroup(dg3, name = c("Qd", "Qr", "QrExp"),
color = c("#FFD700", "#EE6300", "brown"), strokeBorderColor = "black") color = c("#FFD700", "#EE6300", "brown"), strokeBorderColor = "black")
dg3 <- dySeries(dg3, name = "Qobs", fillGraph = FALSE, drawPoints = TRUE, color = op$fg) dg3 <- dygraphs::dySeries(dg3, name = "Qobs", fillGraph = FALSE, drawPoints = TRUE, color = op$fg)
dg3 <- dySeries(dg3, name = "Qsim", fillGraph = FALSE, color = "orangered") dg3 <- dygraphs::dySeries(dg3, name = "Qsim", fillGraph = FALSE, color = "orangered")
dg3 <- dyCrosshair(dg3, direction = "vertical") dg3 <- dygraphs::dyCrosshair(dg3, direction = "vertical")
dg3 <- dyLegend(dg3, show = "always", width = 325) dg3 <- dygraphs::dyLegend(dg3, show = "always", width = 325)
}) })
## Plot model diagram precipitation ## Plot model diagram precipitation
output$dyPlotMDp <- renderDygraph({ output$dyPlotMDp <- dygraphs::renderDygraph({
# barChartPrecip <- scan(file = system.file("plugins/barChartPrecip.js", package = "airGRteaching"), # barChartPrecip <- scan(file = system.file("plugins/barChartPrecip.js", package = "airGRteaching"),
# what = "character", quiet = TRUE) # what = "character", quiet = TRUE)
data <- data.frame(DatesR = getRES()$SIM$OutputsModel$DatesR, data <- data.frame(DatesR = getRES()$SIM$OutputsModel$DatesR,
precip. = getRES()$SIM$OutputsModel$Precip) precip. = getRES()$SIM$OutputsModel$Precip)
data.xts <- xts(data[, -1L, drop = FALSE], order.by = data$DatesR) data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR)
dg4 <- dygraph(data.xts, group = "mod_diag", ylab = "precip. [mm/d]") dg4 <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = "precip. [mm/d]")
dg4 <- dyOptions(dg4, colors = "#428BCA", drawXAxis = FALSE, retainDateWindow = FALSE) dg4 <- dygraphs::dyOptions(dg4, colors = "#428BCA", drawXAxis = FALSE, retainDateWindow = FALSE)
dg4 <- dyBarSeries(dg4, name = "precip.") dg4 <- dygraphs::dyBarSeries(dg4, name = "precip.")
dg4 <- dyAxis(dg4, name = "y", valueRange = c(max(data.xts[, "precip."], na.rm = TRUE), -1e-3)) dg4 <- dygraphs::dyAxis(dg4, name = "y", valueRange = c(max(data.xts[, "precip."], na.rm = TRUE), -1e-3))
dg4 <- dyEvent(dg4, input$Event, color = "orangered") dg4 <- dygraphs::dyEvent(dg4, input$Event, color = "orangered")
dg4 <- dyLegend(dg4, show = "onmouseover", width = 225) dg4 <- dygraphs::dyLegend(dg4, show = "onmouseover", width = 225)
dg4 <- dyCrosshair(dg4, direction = "vertical") dg4 <- dygraphs::dyCrosshair(dg4, direction = "vertical")
}) })
## Plot model diagram ETP ## Plot model diagram ETP
output$dyPlotMDe <- renderDygraph({ output$dyPlotMDe <- dygraphs::renderDygraph({
op <- getPlotPar()$par op <- getPlotPar()$par
data <- data.frame(DatesR = getRES()$SIM$OutputsModel$DatesR, data <- data.frame(DatesR = getRES()$SIM$OutputsModel$DatesR,
PET = getRES()$SIM$OutputsModel$PotEvap) PET = getRES()$SIM$OutputsModel$PotEvap)
data.xts <- xts(data[, -1L, drop = FALSE], order.by = data$DatesR) data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR)
dg5 <- dygraph(data.xts, group = "mod_diag", ylab = "PET [mm/d]", main = " ") dg5 <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = "PET [mm/d]", main = " ")
dg5 <- dyOptions(dg5, colors = "#A4C400", drawPoints = TRUE, dg5 <- dygraphs::dyOptions(dg5, colors = "#A4C400", drawPoints = TRUE,
strokeWidth = 0, pointSize = 2, drawXAxis = FALSE, strokeWidth = 0, pointSize = 2, drawXAxis = FALSE,
axisLineColor = op$fg, axisLabelColor = op$fg, axisLineColor = op$fg, axisLabelColor = op$fg,
titleHeight = 10, retainDateWindow = FALSE) titleHeight = 10, retainDateWindow = FALSE)
dg5 <- dyEvent(dg5, input$Event, color = "orangered") dg5 <- dygraphs::dyEvent(dg5, input$Event, color = "orangered")
dg5 <- dyLegend(dg5, show = "onmouseover", width = 225) dg5 <- dygraphs::dyLegend(dg5, show = "onmouseover", width = 225)
dg5 <- dyCrosshair(dg5, direction = "vertical") dg5 <- dygraphs::dyCrosshair(dg5, direction = "vertical")
}) })
## Plot model diagram flow ## Plot model diagram flow
output$dyPlotMDq <- renderDygraph({ output$dyPlotMDq <- dygraphs::renderDygraph({
if (length(.GlobalEnv$.ShinyGR.hist) == 2 & input$ShowOldQsim == "Yes") { if (length(.GlobalEnv$.ShinyGR.hist) == 2 & input$ShowOldQsim == "Yes") {
QsimOld <- getRES()$SIMold[[1]]$Qsim QsimOld <- getRES()$SIMold[[1]]$Qsim
} else { } else {
...@@ -430,18 +430,18 @@ shinyServer(function(input, output, session) { ...@@ -430,18 +430,18 @@ shinyServer(function(input, output, session) {
Qobs = OutputsModel2$Qobs, Qobs = OutputsModel2$Qobs,
Qsim = OutputsModel2$Qsim, Qsim = OutputsModel2$Qsim,
QsimOld = OutputsModel2$Qold) QsimOld = OutputsModel2$Qold)
data.xts <- xts(data[, -1L, drop = FALSE], order.by = data$DatesR) data.xts <- xts::xts(data[, -1L, drop = FALSE], order.by = data$DatesR)
op <- getPlotPar()$par op <- getPlotPar()$par
dg6 <- dygraph(data.xts, group = "mod_diag", ylab = "flow [mm/d]", main = " ") dg6 <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = "flow [mm/d]", main = " ")
dg6 <- dyOptions(dg6, colors = c(op$fg, "grey", "orangered"), drawPoints = TRUE, dg6 <- dygraphs::dyOptions(dg6, colors = c(op$fg, "grey", "orangered"), drawPoints = TRUE,
axisLineColor = op$fg, axisLabelColor = op$fg, axisLineColor = op$fg, axisLabelColor = op$fg,
titleHeight = 10, retainDateWindow = FALSE) titleHeight = 10, retainDateWindow = FALSE)
dg6 <- dySeries(dg6, name = "QsimOld", drawPoints = FALSE, strokePattern = "dashed") dg6 <- dygraphs::dySeries(dg6, name = "QsimOld", drawPoints = FALSE, strokePattern = "dashed")
dg6 <- dySeries(dg6, name = "Qsim" , drawPoints = FALSE) dg6 <- dygraphs::dySeries(dg6, name = "Qsim" , drawPoints = FALSE)
dg6 <- dyEvent(dg6, input$Event, color = "orangered") dg6 <- dygraphs::dyEvent(dg6, input$Event, color = "orangered")
dg6 <- dyLegend(dg6, show = "onmouseover", width = 225) dg6 <- dygraphs::dyLegend(dg6, show = "onmouseover", width = 225)
dg6 <- dyCrosshair(dg6, direction = "vertical") dg6 <- dygraphs::dyCrosshair(dg6, direction = "vertical")
}) })
...@@ -487,7 +487,7 @@ shinyServer(function(input, output, session) { ...@@ -487,7 +487,7 @@ shinyServer(function(input, output, session) {
## --------------- Download buttons ## --------------- Download buttons
## simulation table ## Download simulation table
output$DownloadTab <- downloadHandler( output$DownloadTab <- downloadHandler(
filename = function() { filename = function() {