Commit 29c3bee3 authored by unknown's avatar unknown
Browse files

v0.1.11.0 ObsBV argument has been renamed ObsDF in PrepGR and ShinyGR functions

parent fdeaff25
Package: airGRteaching
Type: Package
Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface)
Version: 0.1.10.0
Version: 0.1.11.0
Date: 2018-01-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)
......
PrepGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5,
HydroModel, CemaNeige = FALSE) {
if (is.null(ObsBV) && (is.null(DatesR) | is.null(Precip) | is.null(PotEvap) | is.null(Qobs))) {
if (is.null(ObsDF) && (is.null(DatesR) | is.null(Precip) | is.null(PotEvap) | is.null(Qobs))) {
stop("Missing input data")
}
if (!is.null(ObsBV)) {
if (ncol(ObsBV) >= 5) {
TempMean <- ObsBV[, 5L]
if (!is.null(ObsDF)) {
if (ncol(ObsDF) >= 5) {
TempMean <- ObsDF[, 5L]
}
}
......@@ -19,23 +19,23 @@ PrepGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q
TempMean <- NA
}
if (is.null(ObsBV)) {
ObsBV <- data.frame(DatesR = DatesR,
if (is.null(ObsDF)) {
ObsDF <- data.frame(DatesR = DatesR,
Precip = Precip,
PotEvap = PotEvap,
Qobs = Qobs,
TempMean = TempMean)
}
if (!is.null(ObsBV)) {
ObsBV <- data.frame(DatesR = ObsBV[, 1L],
Precip = ObsBV[, 2L],
PotEvap = ObsBV[, 3L],
Qobs = ObsBV[, 4L],
if (!is.null(ObsDF)) {
ObsDF <- data.frame(DatesR = ObsDF[, 1L],
Precip = ObsDF[, 2L],
PotEvap = ObsDF[, 3L],
Qobs = ObsDF[, 4L],
TempMean = TempMean)
}
if (! any(attributes(ObsBV$DatesR[1])$tzone %in% "UTC")) {
if (! any(attributes(ObsDF$DatesR[1])$tzone %in% "UTC")) {
stop("Non convenient date format. Time zone must be defined as \"UTC\"")
}
......@@ -58,12 +58,12 @@ PrepGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q
}
MOD_obs <- CreateInputsModel(FUN_MOD = FUN_MOD, DatesR = ObsBV$DatesR,
Precip = ObsBV$Precip, PotEvap = ObsBV$PotEvap, TempMean = ObsBV$TempMean,
MOD_obs <- CreateInputsModel(FUN_MOD = FUN_MOD, DatesR = ObsDF$DatesR,
Precip = ObsDF$Precip, PotEvap = ObsDF$PotEvap, TempMean = ObsDF$TempMean,
ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers, verbose = FALSE)
PrepGR <- list(InputsModel = MOD_obs, Qobs = ObsBV$Qobs, TypeModel = TypeModel)
PrepGR <- list(InputsModel = MOD_obs, Qobs = ObsDF$Qobs, TypeModel = TypeModel)
class(PrepGR) <- c("PrepGR", "GR")
return(PrepGR)
......
ShinyGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
ShinyGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5, SimPer, NamesObsBV = NULL,
theme = "RStudio") {
if (is.data.frame(ObsBV)) {
ObsBV <- list(ObsBV)
if (is.data.frame(ObsDF)) {
ObsDF <- list(ObsDF)
}
ZInputs <- as.list(ZInputs)
HypsoData <- as.list(HypsoData)
......@@ -12,26 +12,26 @@ ShinyGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
SimPer <- list(SimPer)
}
if (is.null(names(ObsBV)) & !is.null(ObsBV)) {
if (is.null(names(ObsDF)) & !is.null(ObsDF)) {
if (is.null(NamesObsBV)) {
NamesObsBV <- paste0("%s %0", nchar(length(ObsBV)), "d")
NamesObsBV <- sprintf(NamesObsBV, rep("Unnamed watershed", times = length(ObsBV)), seq_along(ObsBV))
} else if (length(ObsBV) > length(NamesObsBV)) {
NamesObsBV <- paste0("%s %0", nchar(length(ObsDF)), "d")
NamesObsBV <- sprintf(NamesObsBV, rep("Unnamed watershed", times = length(ObsDF)), seq_along(ObsDF))
} else if (length(ObsDF) > length(NamesObsBV)) {
warning("Not enough 'NamesObsBV' values. Basin automatically renamed.")
NamesObsBV <- paste0("%s %0", nchar(length(ObsBV)), "d")
NamesObsBV <- sprintf(NamesObsBV, rep("Unnamed watershed", times = length(ObsBV)), seq_along(ObsBV))
} else if (length(ObsBV) < length(NamesObsBV)) {
NamesObsBV <- paste0("%s %0", nchar(length(ObsDF)), "d")
NamesObsBV <- sprintf(NamesObsBV, rep("Unnamed watershed", times = length(ObsDF)), seq_along(ObsDF))
} else if (length(ObsDF) < length(NamesObsBV)) {
warning("To long 'NamesObsBV'. First(s) element(s) used of 'NamesObsBV' argument.")
}
NamesObsBV <- NamesObsBV[seq_along(ObsBV)]
names(ObsBV) <- NamesObsBV
} else if (!is.null(names(ObsBV)) & !is.null(ObsBV)) {
NamesObsBV <- names(ObsBV)
} else if (is.null(ObsBV)) {
NamesObsBV <- NamesObsBV[seq_along(ObsDF)]
names(ObsDF) <- NamesObsBV
} else if (!is.null(names(ObsDF)) & !is.null(ObsDF)) {
NamesObsBV <- names(ObsDF)
} else if (is.null(ObsDF)) {
NamesObsBV <- ifelse(is.null(NamesObsBV), "Unnamed watershed", NamesObsBV[1L])
}
if (is.null(ObsBV)) {
if (is.null(ObsDF)) {
if (length(ZInputs) > 1) {
warning("To long 'ZInputs'. First element used of 'ZInputs' argument.")
ZInputs <- list(ZInputs[[1L]])
......@@ -50,30 +50,30 @@ ShinyGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
}
}
if (!is.null(ObsBV) & length(ObsBV) != length(ZInputs)) {
stop(sprintf("Not enough 'ZInputs' values. Length must be %i.", length(ObsBV)))
if (!is.null(ObsDF) & length(ObsDF) != length(ZInputs)) {
stop(sprintf("Not enough 'ZInputs' values. Length must be %i.", length(ObsDF)))
} else {
names(ZInputs) <- NamesObsBV
}
if (!is.null(ObsBV) & length(ObsBV) != length(HypsoData)) {
stop(sprintf("Not enough 'HypsoData' values. Length must be %i.", length(ObsBV)))
if (!is.null(ObsDF) & length(ObsDF) != length(HypsoData)) {
stop(sprintf("Not enough 'HypsoData' values. Length must be %i.", length(ObsDF)))
} else {
names(HypsoData) <- NamesObsBV
}
if (!is.null(ObsBV) & length(ObsBV) != length(NLayers)) {
stop(sprintf("Not enough 'NLayers' values. Length must be %i.", length(ObsBV)))
if (!is.null(ObsDF) & length(ObsDF) != length(NLayers)) {
stop(sprintf("Not enough 'NLayers' values. Length must be %i.", length(ObsDF)))
} else {
names(NLayers) <- NamesObsBV
}
if (!is.null(ObsBV) & length(ObsBV) != length(SimPer)) {
stop(sprintf("Not enough 'SimPer' values. Length must be %i.", length(ObsBV)))
if (!is.null(ObsDF) & length(ObsDF) != length(SimPer)) {
stop(sprintf("Not enough 'SimPer' values. Length must be %i.", length(ObsDF)))
} else {
names(SimPer) <- NamesObsBV
}
.GlobalEnv$.ShinyGR.hist <- list(list())#list(Param = list(), TypeModel = lsit(), Crit = list(), Qsim = list())
.GlobalEnv$.ShinyGR.args <- list(ObsBV = ObsBV, NamesObsBV = NamesObsBV,
.GlobalEnv$.ShinyGR.args <- list(ObsDF = ObsDF, NamesObsBV = NamesObsBV,
DatesR = DatesR, Precip = Precip, PotEvap = PotEvap, Qobs = Qobs, TempMean = TempMean,
ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers, SimPer = SimPer,
theme = theme)
......
......@@ -28,12 +28,12 @@ shinyServer(function(input, output, session) {
}
# if (input$Dataset == "Unnamed watershed") {
if (input$Dataset == "Unnamed watershed") {
ObsBV <- NULL
ObsDF <- NULL
} else {
# ObsBV <- get(input$Dataset)
ObsBV <- .ShinyGR.args$ObsBV[[input$Dataset]]
# ObsDF <- get(input$Dataset)
ObsDF <- .ShinyGR.args$ObsDF[[input$Dataset]]
}
PREP <- PrepGR(ObsBV = ObsBV,
PREP <- PrepGR(ObsDF = ObsDF,
DatesR = .ShinyGR.args$DatesR,
Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap,
Qobs = .ShinyGR.args$Qobs, TempMean = .ShinyGR.args$TempMean,
......@@ -213,12 +213,12 @@ shinyServer(function(input, output, session) {
if (.TypeModelGR(OBSold)$CemaNeige & !.TypeModelGR(getPrep()$PREP)$CemaNeige | # present: No CemaNeige ; old: CemaNeige
isEqualSumQsim & isEqualTypeModel) {
if (input$Dataset == "Unnamed watershed") {
ObsBV <- NULL
ObsDF <- NULL
} else {
# ObsBV <- get(input$Dataset)
ObsBV <- .ShinyGR.args$ObsBV[[input$Dataset]]
# ObsDF <- get(input$Dataset)
ObsDF <- .ShinyGR.args$ObsDF[[input$Dataset]]
}
OBSold <- PrepGR(ObsBV = ObsBV,
OBSold <- PrepGR(ObsDF = ObsDF,
Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap,
Qobs = .ShinyGR.args$Qobs, TempMean = .ShinyGR.args$TempMean,
ZInputs = .ShinyGR.args$ZInputs[[input$Dataset]],
......
......@@ -61,7 +61,7 @@ Before running a model, `r airGRteaching` functions require data and options wit
For this step, you just have to use the `PrepGR()` function. You have to define:
* `ObsBV`: `data.frame` of hydrometeorological observations time series
* `ObsDF`: `data.frame` of hydrometeorological observations time series
* `HydroModel`: the name of the hydrological model you want to run (GR1A, GR2M, GR4J, GR5J, GR6J or GR4H)
* `CemaNeige`: if you want or not to use the snowmelt and accumulation model
......@@ -72,7 +72,7 @@ If you want to use CemaNeige, you also have to define:
* `NLayers`: the number of elevation layers requested [-]
```{r, echo=TRUE, eval=TRUE}
PREP <- PrepGR(ObsBV = BasinObs, HydroModel = "GR5J", CemaNeige = FALSE)
PREP <- PrepGR(ObsDF = BasinObs, HydroModel = "GR5J", CemaNeige = FALSE)
```
<br>
......@@ -176,7 +176,7 @@ The `r airGRteaching` package also provides the `ShinyGR()` function, which allo
The `ShinyGR()` function just needs:
* `ObsBV`: a name of a `data.frame` (or a `list` of names)
* `ObsDF`: a name of a `data.frame` (or a `list` of names)
* `SimPer`: a vector of 2 dates to define the simulation period
By default, the objective function used is the Kling-Gupta criterion (KGE), and the warm-up period is automatically set (depending on model). You have to define:
......@@ -190,7 +190,7 @@ You can obviously define another objective function or warm-up period:
* `WupPer`: a vector of 2 dates to define the warm-up period
```{r, eval=FALSE}
ShinyGR(ObsBV = "BasinObs", SimPer = c("1994-01-01", "1998-12-31"))
ShinyGR(ObsDF = "BasinObs", SimPer = c("1994-01-01", "1998-12-31"))
```
Only daily models are currently available (GR4J, GR5J, GR6J + CemaNeige).
......
......@@ -57,7 +57,7 @@ data(L0123001)
BasinObs2 <- BasinObs[, c("DatesR", "P", "E", "Qmm", "T")]
## Preparation of observed data for modelling
PREP <- PrepGR(ObsBV = BasinObs2, HydroModel = "GR4J", CemaNeige = TRUE)
PREP <- PrepGR(ObsDF = BasinObs2, HydroModel = "GR4J", CemaNeige = TRUE)
## Calibration step
CAL <- CalGR(PrepGR = PREP, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
......
......@@ -5,7 +5,7 @@
\usage{
PrepGR(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
PrepGR(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
Qobs = NULL, TempMean = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5,
HydroModel, CemaNeige = FALSE)
......@@ -13,7 +13,7 @@ PrepGR(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
\arguments{
\item{ObsBV}{(optional) [data.frame] data.frame of dates, total precipitation, potential evapotranspiration, observed discharges and mean air temperature (only if CemaNeige is used) (variables must be in this order; see below for the units)}
\item{ObsDF}{(optional) [data.frame] data.frame of dates, total precipitation, potential evapotranspiration, observed discharges and mean air temperature (only if CemaNeige is used) (variables must be in this order; see below for the units)}
\item{DatesR}{(optional) [POSIXt] vector of dates required to create the GR and CemaNeige (if used) models inputs. Time zone must be defined as "UTC"}
......@@ -53,7 +53,7 @@ PrepGR(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
\description{Creation of the inputs required to run the CalGR and SimGR functions}
\details{
If the \code{ObsBV} argument is provided, \code{DatesR}, \code{Precip}, \code{PotEvap}, \code{Qobs} and \code{TempMean} are not necessary, and vice-versa. If one variable is provided in \code{ObsBV} and also separately, then only the data included in \code{ObsBV} are used.
If the \code{ObsDF} argument is provided, \code{DatesR}, \code{Precip}, \code{PotEvap}, \code{Qobs} and \code{TempMean} are not necessary, and vice-versa. If one variable is provided in \code{ObsDF} and also separately, then only the data included in \code{ObsDF} are used.
}
\author{Olivier Delaigue}
......@@ -67,7 +67,7 @@ data(L0123001)
BasinObs2 <- BasinObs[, c("DatesR", "P", "E", "Qmm", "T")]
## Preparation of observed data for modelling
PREP <- PrepGR(ObsBV = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
PREP <- PrepGR(ObsDF = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
str(PREP)
}
......@@ -5,7 +5,7 @@
\usage{
ShinyGR(ObsBV = NULL,
ShinyGR(ObsDF = NULL,
DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5,
SimPer, NamesObsBV = NULL, theme = "RStudio")
......@@ -13,7 +13,7 @@ ShinyGR(ObsBV = NULL,
\arguments{
\item{ObsBV}{(optional) [data.frame or list of data.frame] \code{data.frame}1 of dates, total precipitation, evapotranspiration, observed discharges and mean air temperature (only if CemaNeige is used) (variables must be in this order; see below for the units)}
\item{ObsDF}{(optional) [data.frame or list of data.frame] \code{data.frame}1 of dates, total precipitation, evapotranspiration, observed discharges and mean air temperature (only if CemaNeige is used) (variables must be in this order; see below for the units)}
\item{DatesR}{(optional) [POSIXt] vector of dates required to create the GR and CemaNeige models inputs. Time zone must be defined as "UTC"}
......@@ -33,7 +33,7 @@ ShinyGR(ObsBV = NULL,
\item{SimPer}{[character or list of characters] vector of 2 values to define the simulation period [\code{"YYYY-mm-dd"} or \code{"YYYY-mm-dd HH:MM:SS"}], see below for details}
\item{NamesObsBV}{(optional) [character] vector of values to define the data inputs name(s) (if the ObsBV list is not already named)}
\item{NamesObsBV}{(optional) [character] vector of values to define the data inputs name(s) (if the ObsDF list is not already named)}
\item{theme}{(optional) [character] alternative stylesheet [\code{"RStudio"} (default), \code{"Cerulean"}, \code{"Cyborg"}, \code{"Flatly"}, \code{"United"} or \code{"Yeti"}]}
}
......@@ -47,7 +47,7 @@ ShinyGR(ObsBV = NULL,
\description{Shiny application to understand the impact of each parameter of the GR models on the simulated flows}
\details{
If the \code{ObsBV} contains a list of several character names of datasets, the simulation period (defined in \code{SimPer}) will be applied on all datasets. As a consequence it is necessary to check that the periods are common to the different datasets. The warm-up period always starts from the first date to the step time just before the start of the simulation period.
If the \code{ObsDF} contains a list of several character names of datasets, the simulation period (defined in \code{SimPer}) will be applied on all datasets. As a consequence it is necessary to check that the periods are common to the different datasets. The warm-up period always starts from the first date to the step time just before the start of the simulation period.
}
\author{
......@@ -70,7 +70,7 @@ BI_L0123002 <- BasinInfo
## Interactive simulation step using default parameters
if (interactive()) {
ShinyGR(ObsBV = list("Low-land basin" = BV_L0123001, "Mountainous basin" = BV_L0123002),
ShinyGR(ObsDF = list("Low-land basin" = BV_L0123001, "Mountainous basin" = BV_L0123002),
ZInputs = list(NULL, median(BI_L0123002$HypsoData)),
HypsoData = list(NULL, BI_L0123002$HypsoData),
NLayers = list(5, 5),
......
......@@ -67,7 +67,7 @@ data(L0123001)
BasinObs2 <- BasinObs[, c("DatesR", "P", "E", "Qmm", "T")]
## Preparation of observed data for modelling
PREP <- PrepGR(ObsBV = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
PREP <- PrepGR(ObsDF = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
## Calibration step
CAL <- CalGR(PrepGR = PREP, CalCrit = "KGE2",
......
......@@ -68,7 +68,7 @@ data(L0123001)
BasinObs2 <- BasinObs[, c("DatesR", "P", "E", "Qmm", "T")]
## Preparation of observed data for modelling
PREP <- PrepGR(ObsBV = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
PREP <- PrepGR(ObsDF = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
dyplot(PREP, main = "Observation")
## Calibration step
......
......@@ -43,7 +43,7 @@ data(L0123001)
BasinObs2 <- BasinObs[, c("DatesR", "P", "E", "Qmm", "T")]
## Preparation of observed data for modelling
PREP <- PrepGR(ObsBV = BasinObs2, HydroModel = "GR5J", CemaNeige = TRUE)
PREP <- PrepGR(ObsDF = BasinObs2, HydroModel = "GR5J", CemaNeige = TRUE)
## Calibration step
CAL <- CalGR(PrepGR = PREP, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
......
......@@ -52,7 +52,7 @@ data(L0123001)
BasinObs2 <- BasinObs[, c("DatesR", "P", "E", "Qmm", "T")]
## Preparation of observed data for modelling
PREP <- PrepGR(ObsBV = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
PREP <- PrepGR(ObsDF = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
## Observed data plotting
plot(PREP)
......
......@@ -48,7 +48,7 @@ data(L0123001)
BasinObs2 <- BasinObs[, c("DatesR", "P", "E", "Qmm", "T")]
## Preparation of observed data for modelling
PREP <- PrepGR(ObsBV = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
PREP <- PrepGR(ObsDF = BasinObs2, HydroModel = "GR4J", CemaNeige = FALSE)
## Calibration step
CAL <- CalGR(PrepGR = PREP, CalCrit = "KGE2",
......
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