diff --git a/DESCRIPTION b/DESCRIPTION
index 67ff791b96dd56883d48b739128cd8ed9aa9013d..308b4a040d8850be5bc31bf97c122d0d026a2f68 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
Package: airGRteaching
Type: Package
Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface)
-Version: 0.1.5.20
-Date: 2017-09-13
+Version: 0.1.5.21
+Date: 2017-09-14
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, plotrix, markdown
diff --git a/inst/ShinyGR/server.R b/inst/ShinyGR/server.R
index 8e2acb2e47457753d02cbeb0e89b593080f32ee8..138a706d04aea0981bf566c1cfb3018bd76e0196 100644
--- a/inst/ShinyGR/server.R
+++ b/inst/ShinyGR/server.R
@@ -41,7 +41,7 @@ shinyServer(function(input, output, session) {
CAL <- CalGR(ObsGR = getPrep()$OBS, CalCrit = CAL_opt$Crit, transfo = CAL_opt$Transfo,
WupPer = .ShinyGR.args$WupPer, CalPer = substr(c(input$Period[1], input$Period[2]), 1, 10), verbose = FALSE)
PARAM <- CAL$OutputsCalib$ParamFinalR
-
+
updateSliderInput(session, inputId = "X1", value = PARAM[1L])
updateSliderInput(session, inputId = "X2", value = PARAM[2L])
updateSliderInput(session, inputId = "X3", value = PARAM[3L])
@@ -102,7 +102,7 @@ shinyServer(function(input, output, session) {
return(SIM_transfo)
})
names(SIM) <- SIM_opt$Crit
-
+
## Criteria computation
CRIT <- lapply(SIM, function(iCRIT) {
lapply(SIM_opt$Transfo, function(iTRSF) {
@@ -137,10 +137,10 @@ shinyServer(function(input, output, session) {
observe({
if (getPlotType() == 4) {
updateSelectInput(session, inputId = "HydroModel", choice = c("GR4J", "GR5J"), selected = input$HydroModel)
- updateSelectInput(session, inputId = "SnowModel", choice = c("None"))
+ updateSelectInput(session, inputId = "SnowModel" , choice = c("None"))
} else {
updateSelectInput(session, inputId = "HydroModel", choice = c("GR4J", "GR5J", "GR6J"), selected = input$HydroModel)
- updateSelectInput(session, inputId = "SnowModel", choice = c("None", "CemaNeige") , selected = input$SnowModel)
+ updateSelectInput(session, inputId = "SnowModel" , choice = c("None", "CemaNeige") , selected = input$SnowModel)
}
})
@@ -241,7 +241,7 @@ shinyServer(function(input, output, session) {
par(oma = c(20, 0, 0, 0))
}
plot(OutputsModel, Qobs = getRES()$SIM$Qobs, IndPeriod_Plot = IndPlot, cex.lab = 1.2, cex.axis = 1.4, cex.leg = 1.4)
- })
+ }, bg = "transparent")
## Plot flow time series
@@ -375,7 +375,7 @@ shinyServer(function(input, output, session) {
airGRteaching:::DiagramGR(OutputsModel = OutputsModel2, Param = getRES()$PARAM,
SimPer = input$Period, EventDate = input$Event,
HydroModel = input$HydroModel)
- })
+ }, bg = "transparent")
@@ -385,7 +385,7 @@ shinyServer(function(input, output, session) {
## Table created in order to choose order the criteria in the table output
tabCrit_gauge <- data.frame(Criterion = c("NSE [Q]", "NSE [sqrt(Q)]", "NSE [log(Q)]",
- "KGE [Q]", "KGE [sqrt(Q)]", "KGE [log(Q)]"),
+ "KGE [Q]", "KGE [sqrt(Q)]", "KGE [log(Q)]"),
ID = 1:6, stringsAsFactors = FALSE)
tabCrit_out <- merge(tabCrit_gauge, getRES()$Crit, by = "Criterion", all.x = TRUE)
@@ -402,5 +402,68 @@ shinyServer(function(input, output, session) {
return(tabCrit_out)
}, sanitize.text.function = function(x) x)
+
+
+
+ ## --------------- Download buttons
+
+ ## simulation table
+ output$DownloadTab <- downloadHandler(
+ filename = function() {
+ filename <- "TabSim"
+ filename <- sprintf("airGRteaching_%s.csv", filename)
+ },
+ content = function(file) {
+ OBS <- getPrep()$OBS
+ SIM <- getRES()$SIM
+ if (input$SnowModel != "CemaNeige") {
+ PrecipSim <- NA
+ FracSolid <- NA
+ } else {
+ PrecipSol <- rowMeans(as.data.frame(OBS$InputsModel$LayerPrecip) * as.data.frame(OBS$InputsModel$LayerFracSolidPrecip), na.rm = TRUE)
+ PrecipSim <- rowMeans(as.data.frame(OBS$InputsModel$LayerPrecip), na.rm = TRUE)
+ FracSolid <- PrecipSol / PrecipSim
+ FracSolid <- ifelse(is.na(FracSolid) & PrecipSol == 0 & PrecipSim == 0, 0, FracSolid)
+ PrecipSim <- PrecipSim[SIM$OptionsSimul$IndPeriod_Run]
+ FracSolid <- FracSolid[SIM$OptionsSimul$IndPeriod_Run]
+ FracSolid <- round(FracSolid, digits = 2)
+ }
+ TabSim <- data.frame(Dates = SIM$OutputsModel$DatesR,
+ PotEvap = SIM$OutputsModel$PotEvap,
+ PrecipObs = SIM$OutputsModel$Precip,
+ PrecipSim = PrecipSim,
+ PrecipFracSolid = FracSolid,
+ Qobs = SIM$OptionsCrit$Qobs,
+ Qsim = SIM$OutputsModel$Qsim)
+ write.table(TabSim, file = file, row.names = FALSE, sep = ";")
+ }
+ )
+
+ ## plots
+ output$DownloadPlot <- downloadHandler(
+ filename = function() {
+ filename <- switch(input$PlotType,
+ "Model performance" = "PlotModelPerf",
+ "Flow time series" = "PlotFlowTimeSeries",
+ "State variables" = "PlotStateVar",
+ "Model diagram" = "PlotModelDiag")
+ filename <- sprintf("airGRteaching_%s.png", filename)
+ },
+ content = function(file) {
+ k <- 1.75
+ if (getPlotType() == 1) {
+ png(filename = file, width = 1000*k, height = ifelse(input$SnowModel != "CemaNeige", 700*k, 1100*k), pointsize = 14, res = 150)
+ plot(getRES()$SIM)
+ dev.off()
+ }
+ if (getPlotType() == 2) {
+ png(filename = file, width = 1000*k, height = 600*k, pointsize = 14, res = 150)
+ plot(getRES()$SIM, which = c( "Precip", "Flows"))
+ dev.off()
+ }
+ }
+ )
+
+
})
diff --git a/inst/ShinyGR/ui.R b/inst/ShinyGR/ui.R
index cffea62249b9d7ce2e2dcec36b38afde9da562d3..543f7dbac7067f54bba171978aa1f3fe1822fffc 100644
--- a/inst/ShinyGR/ui.R
+++ b/inst/ShinyGR/ui.R
@@ -103,10 +103,10 @@ navbarPage(title = div("airGRteaching",
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",
- "color: #fff; background-color: #A4C400; border-color: #A4C400; margin-top: 25px; padding:6px;",
- "")))
+ icon = icon("refresh"),
+ style = ifelse(.GlobalEnv$.ShinyGR.args$theme != "Cerulean",
+ "color:#ffffff; background-color:#A4C400; border-color:#A4C400; margin-top:25px; padding:6px;",
+ "color:#565656; background-color:#ECF0F1; border-color:#DCDCDC; margin-top:25px; padding:6px;")))
)
),
@@ -145,7 +145,7 @@ navbarPage(title = div("airGRteaching",
fluidRow(conditionalPanel(condition = "input.PlotType == 'Model performance'",
column(width = 10,
- plotOutput("stPlotMP", width = "100%", height = "900px"))), #"665px"
+ plotOutput("stPlotMP", width = "100%", height = "900px"))),
conditionalPanel(condition = "input.PlotType == 'Flow time series'",
column(width = 10,
dygraphOutput("dyPlotTS", width = "100%", height = "400px"))),
@@ -160,9 +160,17 @@ navbarPage(title = div("airGRteaching",
dygraphOutput("dyPlotMDq", width = "100%", height = "235px")),
column(width = 04,
plotOutput("stPlotMD", width = "100%", height = "665px"))),
- column(02, tableOutput("Criteria"))
+ column(width = 02,
+ tableOutput("Criteria"),
+ downloadButton("DownloadTab" , label = "Download sim. as txt",
+ style = "color:#565656; background-color:#ECF0F1; border-color:#DCDCDC; width:170px; height:25px; font-size:90%; padding-top:2px;"),
+ conditionalPanel(condition = "input.PlotType == 'Model performance' || input.PlotType == 'Flow time series'",
+ downloadButton("DownloadPlot", label = "Download plot as png",
+ style = "color:#565656; background-color:#ECF0F1; border-color:#DCDCDC; width:170px; height:25px; font-size:90%; padding-top:2px; margin-top:10px;")
+ )
+
+ )
)
-
)
)
),