Skip to content
GitLab
Commit 07afad11 authored by unknown's avatar unknown
Browse files

v0.1.5.21 it is now possible to export some plots and tables from ShinyGR interface

parent 5dfbd245
dev master CRAN_v0.3.5 CRAN_v0.3.4 CRAN_v0.3.3 CRAN_v0.3.2 CRAN_v0.3.1 CRAN_v0.3.0 CRAN_v0.2.13 CRAN_v0.2.12 CRAN_v0.2.11 CRAN_v0.2.10.112 CRAN_v0.2.9.25 CRAN_v0.2.9.23 CRAN_v0.2.8.69 CRAN_v0.2.6.29 CRAN_v0.2.6.27 CRAN_v0.2.0.9 CRAN_v0.2.0.8 CRAN_v0.1.11.25 CRAN_V0.2.2.0
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 87 additions and 16 deletions
+87 -16
DESCRIPTION
+ 2
− 2
View file @ 07afad11
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
......
inst/ShinyGR/server.R
+ 70
− 7
View file @ 07afad11
......@@ -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()
}
}
)
})
inst/ShinyGR/ui.R
+ 15
− 7
View file @ 07afad11
......@@ -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;")
)
)
)
)
)
),
......
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