Commit fdeaff25 authored by unknown's avatar unknown
Browse files

v0.1.10.0 ObsGR function (and relatives arguments in CalGR and SimGR) has been...

v0.1.10.0 ObsGR function (and relatives arguments in CalGR and SimGR) has been renamed PrepGR  #5017
parent bd1f2e11
Package: airGRteaching Package: airGRteaching
Type: Package Type: Package
Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface) Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface)
Version: 0.1.9.29 Version: 0.1.10.0
Date: 2018-01-29 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"))) 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) Depends: airGR (>= 1.0.9.43)
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
Modelling functions: Modelling functions:
==================== ====================
ObsGR Creation of the inputs required to the CalGR PrepGR Creation of the inputs required to the CalGR
and SimGR functions and SimGR functions
CalGR Calibration algorithm optimises the error CalGR Calibration algorithm optimises the error
criterion selected as objective function criterion selected as objective function
...@@ -12,9 +12,9 @@ SimGR Run GR hydrological models ...@@ -12,9 +12,9 @@ SimGR Run GR hydrological models
Plotting functions: Plotting functions:
==================== ====================
dyplot Interactive time series plotting of ObsGR, CalGR dyplot Interactive time series plotting of PrepGR, CalGR
and SimGR objects and SimGR objects
plot.ObsGR Time series plotting GR objects from inputs plot.PrepGR Time series plotting GR objects from inputs
plot.CalGR Plotting of the evolution of parameters and plot.CalGR Plotting of the evolution of parameters and
objective function during the calibration step, objective function during the calibration step,
and time series plotting GR objects from calibration and time series plotting GR objects from calibration
...@@ -25,6 +25,5 @@ plot.SimGR Synthetic plotting of model outputs ...@@ -25,6 +25,5 @@ plot.SimGR Synthetic plotting of model outputs
Shiny interface: Shiny interface:
==================== ====================
ShinyGR Interactive Web applications to run the GR4J, GR5J ShinyGR Interactive Web applications to run the GR4J, GR5J
and GR6J and GR6J hydrological models whith or without CemaNeige
hydrological models whith or without CemaNeige
...@@ -4,11 +4,11 @@ ...@@ -4,11 +4,11 @@
##################################### #####################################
## S3 methods ## ## S3 methods ##
##################################### #####################################
S3method("plot","ObsGR") S3method("plot","PrepGR")
S3method("plot","CalGR") S3method("plot","CalGR")
S3method("plot","SimGR") S3method("plot","SimGR")
S3method("dyplot","default") S3method("dyplot","default")
S3method("dyplot","ObsGR") S3method("dyplot","PrepGR")
S3method("dyplot","CalGR") S3method("dyplot","CalGR")
S3method("dyplot","SimGR") S3method("dyplot","SimGR")
...@@ -18,14 +18,14 @@ S3method("dyplot","SimGR") ...@@ -18,14 +18,14 @@ S3method("dyplot","SimGR")
## Export ## ## Export ##
##################################### #####################################
export(CalGR) export(CalGR)
export(ObsGR) export(PrepGR)
export(SimGR) export(SimGR)
export(plot.ObsGR) export(plot.PrepGR)
export(plot.CalGR) export(plot.CalGR)
export(plot.SimGR) export(plot.SimGR)
export(dyplot) export(dyplot)
export(dyplot.default) export(dyplot.default)
export(dyplot.ObsGR) export(dyplot.PrepGR)
export(dyplot.CalGR) export(dyplot.CalGR)
export(dyplot.SimGR) export(dyplot.SimGR)
export(ShinyGR) export(ShinyGR)
......
CalGR <- function(ObsGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"), CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
WupPer = NULL, CalPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) { WupPer = NULL, CalPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) {
if (! any(class(ObsGR) %in% "ObsGR")) { if (! any(class(PrepGR) %in% "PrepGR")) {
stop("Non convenient data for argument \"ObsGR\". Must be of class \"ObsGR\"") stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
} }
WupInd <- NULL WupInd <- NULL
...@@ -11,10 +11,10 @@ CalGR <- function(ObsGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"), ...@@ -11,10 +11,10 @@ CalGR <- function(ObsGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
if (any(is.na(WupPer))) { if (any(is.na(WupPer))) {
stop("Non convenient date format for the warm-up period \"WupPer\"") stop("Non convenient date format for the warm-up period \"WupPer\"")
} else { } else {
if (! (any(ObsGR$InputsModel$DatesR == WupPer[1]) & any(ObsGR$InputsModel$DatesR == WupPer[2]))) { if (! (any(PrepGR$InputsModel$DatesR == WupPer[1]) & any(PrepGR$InputsModel$DatesR == WupPer[2]))) {
stop("Non convenient date for the warm-up period \"WupPer\"") stop("Non convenient date for the warm-up period \"WupPer\"")
} else { } else {
WupInd <- which(ObsGR$InputsModel$DatesR == WupPer[1]):which(ObsGR$InputsModel$DatesR == WupPer[2]) WupInd <- which(PrepGR$InputsModel$DatesR == WupPer[1]):which(PrepGR$InputsModel$DatesR == WupPer[2])
} }
} }
} }
...@@ -23,10 +23,10 @@ CalGR <- function(ObsGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"), ...@@ -23,10 +23,10 @@ CalGR <- function(ObsGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
if (any(is.na(CalPer))) { if (any(is.na(CalPer))) {
stop("Non convenient date format for the calibration period \"CalPer\"") stop("Non convenient date format for the calibration period \"CalPer\"")
} else { } else {
if (! (any(ObsGR$InputsModel$DatesR == CalPer[1]) & any(ObsGR$InputsModel$DatesR == CalPer[2]))) { if (! (any(PrepGR$InputsModel$DatesR == CalPer[1]) & any(PrepGR$InputsModel$DatesR == CalPer[2]))) {
stop("Non convenient date for the calibration period \"CalPer\"") stop("Non convenient date for the calibration period \"CalPer\"")
} else { } else {
CalInd <- which(ObsGR$InputsModel$DatesR == CalPer[1]):which(ObsGR$InputsModel$DatesR == CalPer[2]) CalInd <- which(PrepGR$InputsModel$DatesR == CalPer[1]):which(PrepGR$InputsModel$DatesR == CalPer[2])
} }
} }
...@@ -44,31 +44,31 @@ CalGR <- function(ObsGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"), ...@@ -44,31 +44,31 @@ CalGR <- function(ObsGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
transfo <- transfo[1L] transfo <- transfo[1L]
} }
MOD_opt <- CreateRunOptions(FUN_MOD = get(ObsGR$TypeModel), InputsModel = ObsGR$InputsModel, MOD_opt <- CreateRunOptions(FUN_MOD = get(PrepGR$TypeModel), InputsModel = PrepGR$InputsModel,
IndPeriod_WarmUp = WupInd, IndPeriod_Run = CalInd, verbose = FALSE) IndPeriod_WarmUp = WupInd, IndPeriod_Run = CalInd, verbose = FALSE)
MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = ObsGR$InputsModel, MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = PrepGR$InputsModel,
RunOptions = MOD_opt, Qobs = ObsGR$Qobs[CalInd], transfo = transfo) RunOptions = MOD_opt, Qobs = PrepGR$Qobs[CalInd], transfo = transfo)
CAL_opt <- CreateCalibOptions(FUN_MOD = get(ObsGR$TypeModel), FUN_CALIB = Calibration_Michel) CAL_opt <- CreateCalibOptions(FUN_MOD = get(PrepGR$TypeModel), FUN_CALIB = Calibration_Michel)
CAL <- Calibration(InputsModel = ObsGR$InputsModel, RunOptions = MOD_opt, CAL <- Calibration(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt,
InputsCrit = MOD_crt, CalibOptions = CAL_opt, InputsCrit = MOD_crt, CalibOptions = CAL_opt,
FUN_MOD = get(ObsGR$TypeModel), FUN_CRIT = FUN_CRIT, FUN_MOD = get(PrepGR$TypeModel), FUN_CRIT = FUN_CRIT,
FUN_CALIB = Calibration_Michel, verbose = verbose) FUN_CALIB = Calibration_Michel, verbose = verbose)
SIM <- RunModel(InputsModel = ObsGR$InputsModel, RunOptions = MOD_opt, SIM <- RunModel(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt,
Param = CAL$ParamFinalR, FUN_MOD = get(ObsGR$TypeModel)) Param = CAL$ParamFinalR, FUN_MOD = get(PrepGR$TypeModel))
CalGR <- list(OptionsCalib = MOD_opt, Qobs = ObsGR$Qobs[CalInd], CalGR <- list(OptionsCalib = MOD_opt, Qobs = PrepGR$Qobs[CalInd],
OutputsCalib = CAL, OutputsModel = SIM, OutputsCalib = CAL, OutputsModel = SIM,
TypeModel = ObsGR$TypeModel, CalCrit = CalCrit, TypeModel = PrepGR$TypeModel, CalCrit = CalCrit,
PeriodModel = list(WarmUp = as.POSIXct(ObsGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)]), PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)]),
Run = CalPer)) Run = CalPer))
class(CalGR) <- c("CalGR", "GR") class(CalGR) <- c("CalGR", "GR")
return(CalGR) return(CalGR)
......
ObsGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL, PrepGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5, ZInputs = NULL, HypsoData = NULL, NLayers = 5,
HydroModel, CemaNeige = FALSE) { HydroModel, CemaNeige = FALSE) {
...@@ -63,8 +63,8 @@ ObsGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qo ...@@ -63,8 +63,8 @@ ObsGR <- function(ObsBV = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qo
ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers, verbose = FALSE) ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers, verbose = FALSE)
ObsGR <- list(InputsModel = MOD_obs, Qobs = ObsBV$Qobs, TypeModel = TypeModel) PrepGR <- list(InputsModel = MOD_obs, Qobs = ObsBV$Qobs, TypeModel = TypeModel)
class(ObsGR) <- c("ObsGR", "GR") class(PrepGR) <- c("PrepGR", "GR")
return(ObsGR) return(PrepGR)
} }
SimGR <- function(ObsGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", "KGE2", "RMSE"), SimGR <- function(PrepGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", "KGE2", "RMSE"),
WupPer = NULL, SimPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) { WupPer = NULL, SimPer, transfo = c("", "sqrt", "log", "inv", "sort"), verbose = TRUE) {
if (! any(class(ObsGR) %in% "ObsGR")) { if (! any(class(PrepGR) %in% "PrepGR")) {
stop("Non convenient data for argument \"ObsGR\". Must be of class \"ObsGR\"") stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
} }
if (! any(class(CalGR) %in% "CalGR") & !is.null(CalGR)) { if (! any(class(CalGR) %in% "CalGR") & !is.null(CalGR)) {
...@@ -22,10 +22,10 @@ SimGR <- function(ObsGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", " ...@@ -22,10 +22,10 @@ SimGR <- function(ObsGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", "
if (any(is.na(WupPer))) { if (any(is.na(WupPer))) {
stop("Non convenient date format for the warm-up period \"WupPer\"") stop("Non convenient date format for the warm-up period \"WupPer\"")
} else { } else {
if (! (any(ObsGR$InputsModel$DatesR == WupPer[1]) & any(ObsGR$InputsModel$DatesR == WupPer[1]))) { if (! (any(PrepGR$InputsModel$DatesR == WupPer[1]) & any(PrepGR$InputsModel$DatesR == WupPer[1]))) {
stop("Non convenient date for the warm-up period \"WupPer\"") stop("Non convenient date for the warm-up period \"WupPer\"")
} else { } else {
WupInd <- which(ObsGR$InputsModel$DatesR == WupPer[1]):which(ObsGR$InputsModel$DatesR == WupPer[2]) WupInd <- which(PrepGR$InputsModel$DatesR == WupPer[1]):which(PrepGR$InputsModel$DatesR == WupPer[2])
} }
} }
} }
...@@ -34,10 +34,10 @@ SimGR <- function(ObsGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", " ...@@ -34,10 +34,10 @@ SimGR <- function(ObsGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", "
if (any(is.na(SimPer))) { if (any(is.na(SimPer))) {
stop("Non convenient date format for the simulation period \"SimPer\"") stop("Non convenient date format for the simulation period \"SimPer\"")
} else { } else {
if (! (any(ObsGR$InputsModel$DatesR == SimPer[1]) & any(ObsGR$InputsModel$DatesR == SimPer[2]))) { if (! (any(PrepGR$InputsModel$DatesR == SimPer[1]) & any(PrepGR$InputsModel$DatesR == SimPer[2]))) {
stop("Non convenient date for the simulation period \"SimPer\"") stop("Non convenient date for the simulation period \"SimPer\"")
} else { } else {
SimInd <- which(ObsGR$InputsModel$DatesR == SimPer[1]):which(ObsGR$InputsModel$DatesR == SimPer[2]) SimInd <- which(PrepGR$InputsModel$DatesR == SimPer[1]):which(PrepGR$InputsModel$DatesR == SimPer[2])
} }
} }
...@@ -55,25 +55,25 @@ SimGR <- function(ObsGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", " ...@@ -55,25 +55,25 @@ SimGR <- function(ObsGR, CalGR = NULL, Param = NULL, EffCrit = c("NSE", "KGE", "
transfo <- transfo[1L] transfo <- transfo[1L]
} }
MOD_opt <- CreateRunOptions(FUN_MOD = get(ObsGR$TypeModel), InputsModel = ObsGR$InputsModel, MOD_opt <- CreateRunOptions(FUN_MOD = get(PrepGR$TypeModel), InputsModel = PrepGR$InputsModel,
IndPeriod_WarmUp = WupInd, IndPeriod_Run = SimInd, verbose = verbose) IndPeriod_WarmUp = WupInd, IndPeriod_Run = SimInd, verbose = verbose)
MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = ObsGR$InputsModel, MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = PrepGR$InputsModel,
RunOptions = MOD_opt, Qobs = ObsGR$Qobs[SimInd], transfo = transfo) RunOptions = MOD_opt, Qobs = PrepGR$Qobs[SimInd], transfo = transfo)
SIM <- RunModel(InputsModel = ObsGR$InputsModel, RunOptions = MOD_opt, SIM <- RunModel(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt,
Param = Param, FUN_MOD = get(ObsGR$TypeModel)) Param = Param, FUN_MOD = get(PrepGR$TypeModel))
CRT <- ErrorCrit(InputsCrit = MOD_crt, OutputsModel = SIM, FUN_CRIT = FUN_CRIT, verbose = verbose) CRT <- ErrorCrit(InputsCrit = MOD_crt, OutputsModel = SIM, FUN_CRIT = FUN_CRIT, verbose = verbose)
SimGR <- list(OptionsSimul = MOD_opt, OptionsCrit = MOD_crt, OutputsModel = SIM, Qobs = ObsGR$Qobs[SimInd], SimGR <- list(OptionsSimul = MOD_opt, OptionsCrit = MOD_crt, OutputsModel = SIM, Qobs = PrepGR$Qobs[SimInd],
TypeModel = ObsGR$TypeModel, TypeModel = PrepGR$TypeModel,
CalCrit = CalGR$CalCrit, EffCrit = CRT, CalCrit = CalGR$CalCrit, EffCrit = CRT,
PeriodModel = list(WarmUp = as.POSIXct(ObsGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)]), PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)]),
Run = SimPer)) Run = SimPer))
class(SimGR) <- c("SimGR", "GR") class(SimGR) <- c("SimGR", "GR")
return(SimGR) return(SimGR)
......
...@@ -34,7 +34,7 @@ if (getRversion() >= "2.15.1") { ...@@ -34,7 +34,7 @@ if (getRversion() >= "2.15.1") {
if (!is.list(x)) { if (!is.list(x)) {
x <- list(TypeModel = x) x <- list(TypeModel = x)
} }
if (any(class(x) %in% c("ObsGR", "CalGR", "SimGR")) || names(x) %in% "TypeModel") { if (any(class(x) %in% c("PrepGR", "CalGR", "SimGR")) || names(x) %in% "TypeModel") {
x <- x$TypeModel x <- x$TypeModel
} }
......
dyplot.ObsGR <- function(x, ...) { dyplot.PrepGR <- function(x, ...) {
if (! any(class(x) %in% "ObsGR")) { if (! any(class(x) %in% "PrepGR")) {
stop("Non convenient data for x argument. Must be of class \"ObsGR\"") stop("Non convenient data for x argument. Must be of class \"PrepGR\"")
} }
dyplot.default(x, ...) dyplot.default(x, ...)
......
...@@ -7,8 +7,8 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup", ...@@ -7,8 +7,8 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup",
# barChartPrecip <- scan(file = system.file("plugins/barChartPrecip.js", package = "airGRteaching"), # barChartPrecip <- scan(file = system.file("plugins/barChartPrecip.js", package = "airGRteaching"),
# what = "character", quiet = TRUE) # what = "character", quiet = TRUE)
if (! any(class(x) %in% c("ObsGR", "CalGR", "SimGR"))) { if (! any(class(x) %in% c("PrepGR", "CalGR", "SimGR"))) {
stop("Non convenient data for x argument. Must be of class \"ObsGR\", \"CalGR\" or \"SimGR\"") stop("Non convenient data for x argument. Must be of class \"PrepGR\", \"CalGR\" or \"SimGR\"")
} }
if (is.null(xlab)) { if (is.null(xlab)) {
...@@ -37,7 +37,7 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup", ...@@ -37,7 +37,7 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup",
} }
if (any(class(x) %in% "ObsGR")) { if (any(class(x) %in% "PrepGR")) {
data <- data.frame(DatesR = x$InputsModel$DatesR, data <- data.frame(DatesR = x$InputsModel$DatesR,
Precip = x$InputsModel$Precip, Precip = x$InputsModel$Precip,
Qobs = x$Qobs, Qobs = x$Qobs,
......
plot.ObsGR <- function(x, type = "l", col.Precip = "royalblue", col.Q = "black", col.na = "grey", plot.PrepGR <- function(x, type = "l", col.Precip = "royalblue", col.Q = "black", col.na = "grey",
xlab = NULL, ylab = NULL, main = NULL, plot.na = TRUE, ...) { xlab = NULL, ylab = NULL, main = NULL, plot.na = TRUE, ...) {
if (! any(class(x) %in% "ObsGR")) { if (! any(class(x) %in% "PrepGR")) {
stop("Non convenient data for x argument. Must be of class \"ObsGR\"") stop("Non convenient data for x argument. Must be of class \"PrepGR\"")
} }
if (is.null(xlab)) { if (is.null(xlab)) {
......
...@@ -33,23 +33,23 @@ shinyServer(function(input, output, session) { ...@@ -33,23 +33,23 @@ shinyServer(function(input, output, session) {
# ObsBV <- get(input$Dataset) # ObsBV <- get(input$Dataset)
ObsBV <- .ShinyGR.args$ObsBV[[input$Dataset]] ObsBV <- .ShinyGR.args$ObsBV[[input$Dataset]]
} }
OBS <- ObsGR(ObsBV = ObsBV, PREP <- PrepGR(ObsBV = ObsBV,
DatesR = .ShinyGR.args$DatesR, DatesR = .ShinyGR.args$DatesR,
Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap, Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap,
Qobs = .ShinyGR.args$Qobs, TempMean = .ShinyGR.args$TempMean, Qobs = .ShinyGR.args$Qobs, TempMean = .ShinyGR.args$TempMean,
ZInputs = .ShinyGR.args$ZInputs[[input$Dataset]], ZInputs = .ShinyGR.args$ZInputs[[input$Dataset]],
HypsoData = .ShinyGR.args$HypsoData[[input$Dataset]], HypsoData = .ShinyGR.args$HypsoData[[input$Dataset]],
NLayers = .ShinyGR.args$NLayers[[input$Dataset]], NLayers = .ShinyGR.args$NLayers[[input$Dataset]],
HydroModel = input$HydroModel, HydroModel = input$HydroModel,
CemaNeige = input$SnowModel == "CemaNeige") CemaNeige = input$SnowModel == "CemaNeige")
WUPPER <- c(OBS$InputsModel$DatesR[1L], input$Period[1]-.TypeModelGR(OBS)$TimeLag) WUPPER <- c(PREP$InputsModel$DatesR[1L], input$Period[1]-.TypeModelGR(PREP)$TimeLag)
if (WUPPER[2] < WUPPER[1]) { if (WUPPER[2] < WUPPER[1]) {
WUPPER[2] <- WUPPER[1] WUPPER[2] <- WUPPER[1]
} }
## Enable or disable automatic calibration (if there is Qobs or not) ## 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]])) isQobs <- !all(is.na(PREP$Qobs[PREP$InputsModel$Dates >= input$Period[1] & PREP$InputsModel$Dates <= input$Period[2]]))
if (isQobs | input$Period[1L] != input$Period[2L]) { if (isQobs | input$Period[1L] != input$Period[2L]) {
shinyjs::enable("CalButton") shinyjs::enable("CalButton")
} }
...@@ -57,7 +57,7 @@ shinyServer(function(input, output, session) { ...@@ -57,7 +57,7 @@ shinyServer(function(input, output, session) {
shinyjs::disable("CalButton") shinyjs::disable("CalButton")
} }
return(list(TMGR = TMGR, OBS = OBS, WUPPER = WUPPER)) return(list(TMGR = TMGR, PREP = PREP, WUPPER = WUPPER))
}) })
...@@ -79,7 +79,7 @@ shinyServer(function(input, output, session) { ...@@ -79,7 +79,7 @@ shinyServer(function(input, output, session) {
## Model calibration ## Model calibration
CAL_opt <- list(Crit = gsub(" .*", "", input$TypeCrit), CAL_opt <- list(Crit = gsub(" .*", "", input$TypeCrit),
Transfo = gsub("1", "inv", gsub("(\\D{3} \\[)(\\w{0,4})(\\W*Q\\W*\\])", "\\2", input$TypeCrit))) Transfo = gsub("1", "inv", gsub("(\\D{3} \\[)(\\w{0,4})(\\W*Q\\W*\\])", "\\2", input$TypeCrit)))
CAL <- CalGR(ObsGR = getPrep()$OBS, CalCrit = CAL_opt$Crit, transfo = CAL_opt$Transfo, CAL <- CalGR(PrepGR = getPrep()$PREP, CalCrit = CAL_opt$Crit, transfo = CAL_opt$Transfo,
WupPer = substr(getPrep()$WUPPER, 1, 10), WupPer = substr(getPrep()$WUPPER, 1, 10),
CalPer = substr(c(input$Period[1], input$Period[2]), 1, 10), verbose = FALSE) CalPer = substr(c(input$Period[1], input$Period[2]), 1, 10), verbose = FALSE)
PARAM <- CAL$OutputsCalib$ParamFinalR PARAM <- CAL$OutputsCalib$ParamFinalR
...@@ -159,7 +159,7 @@ shinyServer(function(input, output, session) { ...@@ -159,7 +159,7 @@ shinyServer(function(input, output, session) {
## Simulated flows computation ## Simulated flows computation
SIM <- SimGR(ObsGR = getPrep()$OBS, Param = PARAM, SIM <- SimGR(PrepGR = getPrep()$PREP, Param = PARAM,
WupPer = substr(getPrep()$WUPPER, 1, 10), WupPer = substr(getPrep()$WUPPER, 1, 10),
SimPer = substr(c(input$Period[1], input$Period[2]), 1, 10), #substr(c(zzz1, zzz2), 1, 10), # SimPer = substr(c(input$Period[1], input$Period[2]), 1, 10), #substr(c(zzz1, zzz2), 1, 10), #
verbose = FALSE) verbose = FALSE)
...@@ -208,9 +208,9 @@ shinyServer(function(input, output, session) { ...@@ -208,9 +208,9 @@ shinyServer(function(input, output, session) {
isEqualTypeModel <- .GlobalEnv$.ShinyGR.hist[[1]]$TypeModel == .GlobalEnv$.ShinyGR.hist[[2]]$TypeModel isEqualTypeModel <- .GlobalEnv$.ShinyGR.hist[[1]]$TypeModel == .GlobalEnv$.ShinyGR.hist[[2]]$TypeModel
if (length(.GlobalEnv$.ShinyGR.hist[[1]]$Qsim) != length(.GlobalEnv$.ShinyGR.hist[[2]]$Qsim) | if (length(.GlobalEnv$.ShinyGR.hist[[1]]$Qsim) != length(.GlobalEnv$.ShinyGR.hist[[2]]$Qsim) |
(isEqualSumQsim & isEqualTypeModel)) { (isEqualSumQsim & isEqualTypeModel)) {
OBSold <- getPrep()$OBS OBSold <- getPrep()$PREP
OBSold$TypeModel <- .GlobalEnv$.ShinyGR.hist[[1]]$TypeModel OBSold$TypeModel <- .GlobalEnv$.ShinyGR.hist[[1]]$TypeModel
if (.TypeModelGR(OBSold)$CemaNeige & !.TypeModelGR(getPrep()$OBS)$CemaNeige | # present: No CemaNeige ; old: CemaNeige if (.TypeModelGR(OBSold)$CemaNeige & !.TypeModelGR(getPrep()$PREP)$CemaNeige | # present: No CemaNeige ; old: CemaNeige
isEqualSumQsim & isEqualTypeModel) { isEqualSumQsim & isEqualTypeModel) {
if (input$Dataset == "Unnamed watershed") { if (input$Dataset == "Unnamed watershed") {
ObsBV <- NULL ObsBV <- NULL
...@@ -218,7 +218,7 @@ shinyServer(function(input, output, session) { ...@@ -218,7 +218,7 @@ shinyServer(function(input, output, session) {
# ObsBV <- get(input$Dataset) # ObsBV <- get(input$Dataset)
ObsBV <- .ShinyGR.args$ObsBV[[input$Dataset]] ObsBV <- .ShinyGR.args$ObsBV[[input$Dataset]]
} }
OBSold <- ObsGR(ObsBV = ObsBV, OBSold <- PrepGR(ObsBV = ObsBV,
Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap, Precip = .ShinyGR.args$Precip, PotEvap = .ShinyGR.args$PotEvap,
Qobs = .ShinyGR.args$Qobs, TempMean = .ShinyGR.args$TempMean, Qobs = .ShinyGR.args$Qobs, TempMean = .ShinyGR.args$TempMean,
ZInputs = .ShinyGR.args$ZInputs[[input$Dataset]], ZInputs = .ShinyGR.args$ZInputs[[input$Dataset]],
...@@ -227,7 +227,7 @@ shinyServer(function(input, output, session) { ...@@ -227,7 +227,7 @@ shinyServer(function(input, output, session) {
HydroModel = input$HydroModel, HydroModel = input$HydroModel,
CemaNeige = input$SnowModel == "CemaNeige") CemaNeige = input$SnowModel == "CemaNeige")
} }
SIMold <- SimGR(ObsGR = OBSold, SIMold <- SimGR(PrepGR = OBSold,
Param = .GlobalEnv$.ShinyGR.hist[[1]]$Param, Param = .GlobalEnv$.ShinyGR.hist[[1]]$Param,
WupPer = substr(getPrep()$WUPPER, 1, 10), WupPer = substr(getPrep()$WUPPER, 1, 10),
SimPer = substr(c(input$Period[1], input$Period[2]), 1, 10), SimPer = substr(c(input$Period[1], input$Period[2]), 1, 10),
...@@ -739,21 +739,21 @@ shinyServer(function(input, output, session) { ...@@ -739,21 +739,21 @@ shinyServer(function(input, output, session) {
filename <- sprintf("airGR_%s_%s.csv", filename, gsub("(.*)( )(\\d{2})(:)(\\d{2})(:)(\\d{2})", "\\1_\\3h\\5m\\7s", Sys.time())) filename <- sprintf("airGR_%s_%s.csv", filename, gsub("(.*)( )(\\d{2})(:)(\\d{2})(:)(\\d{2})", "\\1_\\3h\\5m\\7s", Sys.time()))
}, },
content = function(file) { content = function(file) {
OBS <- getPrep()$OBS PREP <- getPrep()$PREP
SIM <- getSim()$SIM SIM <- getSim()$SIM
if (input$SnowModel != "CemaNeige") { if (input$SnowModel != "CemaNeige") {
PrecipSim <- NA PrecipSim <- NA
FracSolid <- NA FracSolid <- NA
TempMean <- NA TempMean <- NA
} else { } else {
PrecipSol <- rowMeans(as.data.frame(OBS$InputsModel$LayerPrecip) * as.data.frame(OBS$InputsModel$LayerFracSolidPrecip), na.rm = TRUE) PrecipSol <- rowMeans(as.data.frame(PREP$InputsModel$LayerPrecip) * as.data.frame(PREP$InputsModel$LayerFracSolidPrecip), na.rm = TRUE)
PrecipSim <- rowMeans(as.data.frame(OBS$InputsModel$LayerPrecip), na.rm = TRUE) PrecipSim <- rowMeans(as.data.frame(PREP$InputsModel$LayerPrecip), na.rm = TRUE)
FracSolid <- PrecipSol / PrecipSim FracSolid <- PrecipSol / PrecipSim
FracSolid <- ifelse(is.na(FracSolid) & PrecipSol == 0 & PrecipSim == 0, 0, FracSolid) FracSolid <- ifelse(is.na(FracSolid) & PrecipSol == 0 & PrecipSim == 0, 0, FracSolid)
PrecipSim <- PrecipSim[SIM$OptionsSimul$IndPeriod_Run] PrecipSim <- PrecipSim[SIM$OptionsSimul$IndPeriod_Run]
FracSolid <- FracSolid[SIM$OptionsSimul$IndPeriod_Run]