Skip to content

GitLab

Commit a5f6e809 authored by unknown's avatar unknown
Browse files

v0.1.7.0 management of package imports

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