Commit 3014fb30 authored by unknown's avatar unknown
Browse files

v0.1.2.21 the shiny.ShimGR function has been renamed into ShinyGR

parent 57143da8
Package: airGRteaching
Type: Package
Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Application)
Version: 0.1.2.20
Version: 0.1.2.21
Date: 2017-04-07
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.5.22)
......
......@@ -24,5 +24,5 @@ plot.SimGR Synthetic plotting of model outputs
Shiny interface:
====================
shiny.SimGR Interactive Web applications to run the GR4J, GR5J and GR6J
ShinyGR Interactive Web applications to run the GR4J, GR5J and GR6J
hydrological models whith or without CemaNeige
......@@ -28,7 +28,7 @@ export(dyplot.default)
export(dyplot.ObsGR)
export(dyplot.CalGR)
export(dyplot.SimGR)
export(shiny.SimGR)
export(ShinyGR)
export(.TypeModelGR)
......
ShinyGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5,
Param = c(200, 0, 100, 2), WupPer = NULL, SimPer = NULL,
theme = "RStudio") {
.GlobalEnv$.ShinyGR.args <- list(ObsBV = as.list(ObsBV),
DatesR = DatesR, Precip = Precip, PotEvap = PotEvap, Qobs = Qobs, TempMean = TempMean,
ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers,
Param = Param, WupPer = WupPer, SimPer = SimPer,
theme = theme)
on.exit(rm(.ShinyGR.args, envir = .GlobalEnv))
shiny::runApp(system.file("ShinyGR", package = "airGRteaching"), launch.browser = TRUE)
return(NULL)
}
......@@ -5,10 +5,8 @@
## =================================================================================
if (getRversion() >= "2.15.1") {
utils::globalVariables(c(".SimGR.args"))
utils::suppressForeignCheck(c(".SimGR.args"))
utils::globalVariables(c(".SimGR4J.args"))
utils::suppressForeignCheck(c(".SimGR4J.args"))
utils::globalVariables(c(".ShinyGR.args"))
utils::suppressForeignCheck(c(".ShinyGR.args"))
}
......@@ -103,7 +101,7 @@ DiagramGR4J <- function(OutputsModel, Param, SimPer, EventDate) {
par(col.axis = par("fg"), cex.axis = 1.2, cex.lab = 1.2)
if (.GlobalEnv$.SimGR.args$theme == "Cyborg") {
if (.GlobalEnv$.ShinyGR.args$theme == "Cyborg") {
col_mod_bg <- rgb(255-245, 255-245, 255-245, maxColorValue = 255)
col_mod_bd <- rgb(255-231, 255-231, 255-231, maxColorValue = 255)
}
......
shiny.SimGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5,
Param = c(200, 0, 100, 2), WupPer = NULL, SimPer = NULL,
theme = "RStudio") {
.GlobalEnv$.SimGR.args <- list(ObsBV = as.list(ObsBV),
DatesR = DatesR, Precip = Precip, PotEvap = PotEvap, Qobs = Qobs, TempMean = TempMean,
ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers,
Param = Param, WupPer = WupPer, SimPer = SimPer,
theme = theme)
on.exit(rm(.SimGR.args, envir = .GlobalEnv))
shiny::runApp(system.file("shinySimGR", package = "airGRteaching"), launch.browser = TRUE)
return(NULL)
}
......@@ -12,17 +12,17 @@ shinyServer(function(input, output, session) {
OBS <- ObsGR(ObsBV = get(input$Dataset), TypeModel = input$TypeModel,
CemaNeige = input$CemaNeige == "CemaNeige",
Precip = .SimGR.args$Precip, PotEvap = .SimGR.args$PotEvap, Qobs = get(input$Dataset), TempMean = .SimGR.args$TempMean,
ZInputs = .SimGR.args$ZInputs, HypsoData = .SimGR.args$HypsoData,
NLayers = .SimGR.args$NLayers)
Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap, Qobs = get(input$Dataset), TempMean = .ShinyGR.args$TempMean,
ZInputs = .ShinyGR.args$ZInputs, HypsoData = .ShinyGR.args$HypsoData,
NLayers = .ShinyGR.args$NLayers)
return(list(TMGR = TMGR, OBS = OBS))
})
observeEvent(input$CalButton, {
TMGR <- getPrep()$TMGR
OBS <- getPrep()$OBS
CAL <- CalGR(ObsGR = OBS, WupPer = .SimGR.args$WupPer, CalPer = substr(c(input$Period[1], input$Period[2]), 1, 10), verbose = FALSE)
CAL <- CalGR(ObsGR = OBS, 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])
......@@ -54,14 +54,14 @@ shinyServer(function(input, output, session) {
if (input$CemaNeige == "CemaNeige") {
PARAM <- c(PARAM, input$C1, input$C2)
}
list_CRIT <- c("ErrorCrit_NSE", "ErrorCrit_KGE")
list_TRSF <- c("NO", "log", "sqrt")
SIM <- lapply(list_CRIT, function(iCRIT) {
SIM_transfo <- lapply(list_TRSF, function(iTRSF) {
iTRSF <- gsub("NO", "", iTRSF)
iSIM <- SimGR(ObsGR = OBS, Param = PARAM, WupPer = .SimGR.args$WupPer, SimPer = substr(c(input$Period[1], input$Period[2]), 1, 10), transfo = iTRSF, verbose = FALSE)
iSIM <- SimGR(ObsGR = OBS, Param = PARAM, WupPer = .ShinyGR.args$WupPer, SimPer = substr(c(input$Period[1], input$Period[2]), 1, 10), transfo = iTRSF, verbose = FALSE)
iCRIT <- ErrorCrit(InputsCrit = iSIM$OptionsCrit, OutputsModel = iSIM$OutputsModel, FUN_CRIT = get(iCRIT), verbose = FALSE)
iCRIT <- iCRIT[c("CritName", "CritValue")]
return(list(SIM = iSIM, CRIT = iCRIT))
......@@ -81,7 +81,7 @@ shinyServer(function(input, output, session) {
rownames(CRIT) <- NULL
CRIT$Value <- as.numeric(CRIT$Value)
CRIT$Criteria <- gsub("\\[", " [", CRIT$Criteria)
# suppressWarnings(rm(list = ls()[!ls() %in% c("PARAM", "SIM", "CRIT")]))
# gc()
return(list(PARAM = PARAM, SIM = SIM$ErrorCrit_KGE$NO$SIM, Crit = CRIT))
......@@ -96,14 +96,14 @@ shinyServer(function(input, output, session) {
"State variables" = 3,
"Model diagram" = 4)
})
output$myPlot <- renderPlot({
OutputsModel <- getRES()$SIM$OutputsModel
RunOptions <- getRES()$SIM$OptionsSimul
if (.GlobalEnv$.SimGR.args$theme == "Cyborg") {
if (.GlobalEnv$.ShinyGR.args$theme == "Cyborg") {
par(bg = "black", fg = "white", col.axis = "white", col.lab = "white")
}
......@@ -132,9 +132,6 @@ shinyServer(function(input, output, session) {
if (getPlotType() == 2) {
par(mfrow = c(1, 1), par(oma = c(7, 2, 3, 0)))
# plot(OutputsModel$DatesR[IndPlot], getRES()$SIM$Qobs[IndPlot], type = "l", lwd = 1, col = "black", xlab = "", ylab = "flow [mm/d]")
# lines(OutputsModel$DatesR[IndPlot], OutputsModel$Qsim[IndPlot], lwd = 1, col = "orangered")
# legend("topright", bty = "n", c("obs.", "sim."), col = c("black", "orangered"), lwd = 2)
plot(OutputsModel, Qobs = getRES()$SIM$Qobs, IndPeriod_Plot = IndPlot, which = "Flows", cex.lab = 1.4, cex.axis = 1.5, cex.leg = 1.5)
}
......
This diff is collapsed.
......@@ -233,8 +233,8 @@ $(document).ready(function () {
</div>
<div id="shiny-interface" class="section level3">
<h3><em>Shiny</em> interface</h3>
<p>The <strong><font color="#009EE0">airGRteaching</font></strong> package also provide the <code>shiny.SimGR()</code> function, which allows to run the <em>Shiny</em> interface that is proposed on this website.</p>
<p>The <code>shiny.SimGR()</code> function just needs:</p>
<p>The <strong><font color="#009EE0">airGRteaching</font></strong> package also provide the <code>ShinyGR()</code> function, which allows to run the <em>Shiny</em> interface that is proposed on this website.</p>
<p>The <code>ShinyGR()</code> function just needs:</p>
<ul>
<li><code>ObsBV</code>: a name of a <code>data.frame</code> (or a <code>list</code> of names)</li>
<li><code>SimPer</code>: a vector of 2 dates to define the simulation period</li>
......@@ -248,7 +248,7 @@ $(document).ready(function () {
<ul>
<li><code>WupPer</code>: a vector of 2 dates to define the warm-up period</li>
</ul>
<pre class="r"><code>shiny.SimGR(ObsBV = &quot;BasinObs&quot;, SimPer = c(&quot;1994-01-01&quot;, &quot;1998-12-31&quot;))</code></pre>
<pre class="r"><code>ShinyGR(ObsBV = &quot;BasinObs&quot;, SimPer = c(&quot;1994-01-01&quot;, &quot;1998-12-31&quot;))</code></pre>
<p>Only daily models are currently available GR4J, GR5J, GR6J + CemaNeige).</p>
<p>It is also possible to change the interface look; different thema are propose (argument <code>theme</code>).</p>
<p>XXXX SCREENSHOTS</p>
......
......@@ -189,9 +189,9 @@ dyplot(SIM)
### *Shiny* interface
The <strong><font color="#009EE0">airGRteaching</font></strong> package also provide the `shiny.SimGR()` function, which allows to run the *Shiny* interface that is proposed on this website.
The <strong><font color="#009EE0">airGRteaching</font></strong> package also provide the `ShinyGR()` function, which allows to run the *Shiny* interface that is proposed on this website.
The `shiny.SimGR()` function just needs:
The `ShinyGR()` function just needs:
* `ObsBV`: a name of a `data.frame` (or a `list` of names)
* `SimPer`: a vector of 2 dates to define the simulation period
......@@ -208,7 +208,7 @@ You can obviously define your an other objective function or a warm-up period:
```r
shiny.SimGR(ObsBV = "BasinObs", SimPer = c("1994-01-01", "1998-12-31"))
ShinyGR(ObsBV = "BasinObs", SimPer = c("1994-01-01", "1998-12-31"))
```
Only daily models are currently available GR4J, GR5J, GR6J + CemaNeige).
......
......@@ -173,9 +173,9 @@ dyplot(SIM)
### *Shiny* interface
The `r airGRteaching` package also provide the `shiny.SimGR()` function, which allows to run the *Shiny* interface that is proposed on this website.
The `r airGRteaching` package also provide the `ShinyGR()` function, which allows to run the *Shiny* interface that is proposed on this website.
The `shiny.SimGR()` function just needs:
The `ShinyGR()` function just needs:
* `ObsBV`: a name of a `data.frame` (or a `list` of names)
* `SimPer`: a vector of 2 dates to define the simulation period
......@@ -191,7 +191,7 @@ You can obviously define your an other objective function or a warm-up period:
* `WupPer`: a vector of 2 dates to define the warm-up period
```{r, eval=FALSE}
shiny.SimGR(ObsBV = "BasinObs", SimPer = c("1994-01-01", "1998-12-31"))
ShinyGR(ObsBV = "BasinObs", SimPer = c("1994-01-01", "1998-12-31"))
```
Only daily models are currently available GR4J, GR5J, GR6J + CemaNeige).
......
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