Commit 0ec29fe7 authored by unknown's avatar unknown
Browse files

v0.1.6.15 disable and enable buttons in ShinyGR interface (using the shinyjs package)

parent cbbc83d7
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.14
Date: 2017-09-28
Version: 0.1.6.15
Date: 2017-09-29
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
Imports: xts, dygraphs (>= 1.1.1.4), shiny, shinyjs, plotrix, markdown
Description: Add-on package to the airGR package that simplifies its use and is aimed at being used for teaching hydrology. The package provides 1) three functions that allow to complete very simply a hydrological modelling exercise 2) plotting functions to help students to explore observed data and to interpret the results of calibration and simulation of the GR models 3) a shiny graphical interface that allows for displaying the impact of model parameters on hydrographs and models internal variables.
License: GPL-2
NeedsCompilation: no
......
......@@ -3,6 +3,18 @@
shinyServer(function(input, output, session) {
## --------------- List of input names
getInputs <- reactive({
inputList <- sort(names(reactiveValuesToList(input)))
inputList <- inputList[!grepl("^dy", inputList)]
inputList <- inputList[!grepl("^CalButton", inputList)]
inputList <- c(inputList, "DownloadTab", "DownloadPlot")
return(inputList)
})
## --------------- Data preparation
getPrep <- reactive({
......@@ -26,6 +38,13 @@ shinyServer(function(input, output, session) {
WUPPER[2] <- WUPPER[1]
}
## Enable or disable automatic calibration (if there is Qobs or not)
isQobs <- !all(is.na(OBS$Qobs[OBS$InputsModel$Dates >= input$Period[1] & OBS$InputsModel$Dates <= input$Period[2]]))
if (isQobs) {
shinyjs::enable("CalButton")
} else {
shinyjs::disable("CalButton")
}
return(list(TMGR = TMGR, OBS = OBS, WUPPER = WUPPER))
})
......@@ -41,6 +60,11 @@ shinyServer(function(input, output, session) {
## Automatic calibration
observeEvent(input$CalButton, {
## Desable all inputs during automatic calibration
lapply(getInputs(), shinyjs::disable)
shinyjs::disable("CalButton")
## Model calibration
CAL_opt <- list(Crit = gsub(" .*", "", input$TypeCrit),
Transfo = gsub("(\\D{3} \\[)(\\w{0,4})(\\W*Q\\W*\\])", "\\2", input$TypeCrit))
......@@ -65,20 +89,24 @@ shinyServer(function(input, output, session) {
}
updateActionButton(session, inputId = "CalButton", label = "Model calibrated", icon = icon("check"))
CAL_click$valueButton <- 1
})
## Enable caliration
shinyjs::enable("CalButton")
}, priority = +20)
## Manual calibration
observeEvent({input$Dataset ; input$HydroModel ; input$SnowModel ;
input$X1 ; input$X2 ; input$X3 ; input$X4 ; input$X5 ; input$X6 ;
input$TypeCrit ; input$Period}, {
CAL_click$valueButton <- CAL_click$valueButton - 1
CAL_click$valueButton <- ifelse(CAL_click$valueButton < -1, -1, CAL_click$valueButton)
if (CAL_click$valueButton < 0) {
updateActionButton(session, inputId = "CalButton", label = "Run", icon = icon("refresh"))
}
## Enable all inputs except automatic calibration
lapply(getInputs(), shinyjs::enable)
})
......@@ -86,7 +114,6 @@ shinyServer(function(input, output, session) {
## --------------- Simulation
getRES <- reactive({
PARAM <- c(input$X1, input$X2, input$X3, input$X4, input$X5, input$X6)[seq_len(getPrep()$TMGR$NbParam)]
if (input$SnowModel == "CemaNeige") {
PARAM <- c(PARAM, input$C1, input$C2)
......@@ -126,7 +153,6 @@ shinyServer(function(input, output, session) {
.GlobalEnv$.ShinyGR.hist[[length(.GlobalEnv$.ShinyGR.hist)+1]] <- list(Qsim = SIM$ErrorCrit_KGE$NO$SIM$OutputsModel$Qsim,
Param = PARAM,
TypeModel = SIM$ErrorCrit_KGE$NO$SIM$TypeModel)
.GlobalEnv$.ShinyGR.hist <- .GlobalEnv$.ShinyGR.hist[!(duplicated(sapply(.GlobalEnv$.ShinyGR.hist, function(x) sum(x$Param)), fromLast = TRUE) &
duplicated(sapply(.GlobalEnv$.ShinyGR.hist, function(x) x$TypeModel ), fromLast = TRUE))]
.GlobalEnv$.ShinyGR.hist <- tail(.GlobalEnv$.ShinyGR.hist, n = 2)
......@@ -145,7 +171,6 @@ shinyServer(function(input, output, session) {
ZInputs = .ShinyGR.args$ZInputs, HypsoData = .ShinyGR.args$HypsoData,
NLayers = .ShinyGR.args$NLayers)
}
SIMold <- SimGR(ObsGR = OBSold,
Param = .GlobalEnv$.ShinyGR.hist[[1]]$Param,
WupPer = substr(getPrep()$WUPPER, 1, 10),
......@@ -438,7 +463,6 @@ shinyServer(function(input, output, session) {
## --------------- Criteria table
output$Criteria <- renderTable({
## 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)]"),
......
......@@ -22,6 +22,7 @@ navbarPage(title = div("airGRteaching",
tabPanel(title = "Interface",
icon = icon("bar-chart"),
shinyjs::useShinyjs(), # set up shinyjs
sidebarLayout(position = "left",
......
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