Commit b871d1d4 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v0.2.8.15 NEW: PrepGR now runs if all Qobs are NA #8

CalGR: stop
SimGR: warning about the absence of efficiency criterion
parent 8c889638
Package: airGRteaching Package: airGRteaching
Type: Package Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included) Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
Version: 0.2.8.14 Version: 0.2.8.15
Date: 2020-02-07 Date: 2020-02-07
Authors@R: c( Authors@R: c(
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"), person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
### 0.2.8.14 Release Notes (2020-02-07) ### 0.2.8.15 Release Notes (2020-02-07)
#### New features #### New features
......
...@@ -5,6 +5,11 @@ CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"), ...@@ -5,6 +5,11 @@ CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"") stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
} }
isQobs <- !all(is.na(PrepGR$Qobs))
if (!isQobs) {
stop("\"PrepGR\" does not contain any Qobs values. It is not possible to calibrate the model")
}
WupInd <- NULL WupInd <- NULL
if (!is.null(WupPer)) { if (!is.null(WupPer)) {
WupPer <- as.POSIXct(WupPer, tz = "UTC") WupPer <- as.POSIXct(WupPer, tz = "UTC")
......
...@@ -3,7 +3,7 @@ PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q ...@@ -3,7 +3,7 @@ PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q
HydroModel, CemaNeige = FALSE) { HydroModel, CemaNeige = FALSE) {
if (is.null(ObsDF) && (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))) {
stop("Missing input data") stop("Missing input data")
} }
...@@ -13,6 +13,12 @@ PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q ...@@ -13,6 +13,12 @@ PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q
} }
} }
if (!is.null(Qobs)) {
Qobs <- Qobs
} else {
Qobs <- NA
}
if (!is.null(TempMean)) { if (!is.null(TempMean)) {
TempMean <- TempMean TempMean <- TempMean
} else { } else {
......
...@@ -5,10 +5,14 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2", ...@@ -5,10 +5,14 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2",
stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"") stop("Non convenient data for argument \"PrepGR\". Must be of class \"PrepGR\"")
} }
isQobs <- !all(is.na(PrepGR$Qobs))
if (!isQobs) {
warning("\"PrepGR\" does not contain any Qobs values. The efficiency criterion is not computed")
}
if (!missing(CalGR)) { if (!missing(CalGR)) {
warning("Deprecated \"CalGR\" argument. Use \"Param\" instead") warning("Deprecated \"CalGR\" argument. Use \"Param\" instead")
} }
### to remove when the CalGR will be removed ### to remove when the CalGR will be removed
if (missing(Param)) { if (missing(Param)) {
Param <- NULL Param <- NULL
...@@ -19,12 +23,10 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2", ...@@ -19,12 +23,10 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2",
if (is.null(CalGR) & is.null(Param)) { if (is.null(CalGR) & is.null(Param)) {
stop("Arguments \"CalGR\" and \"Param\" are missing, with no default. You must fill in one of these two arguments") stop("Arguments \"CalGR\" and \"Param\" are missing, with no default. You must fill in one of these two arguments")
} }
if (is.null(Param)) { if (is.null(Param)) {
Param <- CalGR$OutputsCalib$ParamFinalR Param <- CalGR$OutputsCalib$ParamFinalR
} }
### ###
if (inherits(Param, "CalGR")) { if (inherits(Param, "CalGR")) {
Param <- Param$OutputsCalib$ParamFinalR Param <- Param$OutputsCalib$ParamFinalR
} }
...@@ -74,19 +76,29 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2", ...@@ -74,19 +76,29 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2",
transfo <- transfo[1L] transfo <- transfo[1L]
} }
MOD_opt <- CreateRunOptions(FUN_MOD = get(PrepGR$TypeModel), InputsModel = PrepGR$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)
if (isQobs) {
MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = PrepGR$InputsModel, MOD_crt <- CreateInputsCrit(FUN_CRIT = FUN_CRIT, InputsModel = PrepGR$InputsModel,
RunOptions = MOD_opt, Obs = PrepGR$Qobs[SimInd], transfo = transfo) RunOptions = MOD_opt, Obs = PrepGR$Qobs[SimInd], transfo = transfo)
} else {
MOD_crt <- NULL
}
SIM <- RunModel(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt, SIM <- RunModel(InputsModel = PrepGR$InputsModel, RunOptions = MOD_opt,
Param = Param, FUN_MOD = get(PrepGR$TypeModel)) Param = Param, FUN_MOD = get(PrepGR$TypeModel))
if (isQobs) {
CRT <- ErrorCrit(InputsCrit = MOD_crt, OutputsModel = SIM, verbose = verbose) CRT <- ErrorCrit(InputsCrit = MOD_crt, OutputsModel = SIM, verbose = verbose)
} else {
CRT <- NULL
}
SimGR <- list(OptionsSimul = MOD_opt, OptionsCrit = MOD_crt, OutputsModel = SIM, Qobs = PrepGR$Qobs[SimInd], SimGR <- list(OptionsSimul = MOD_opt, OptionsCrit = MOD_crt, OutputsModel = SIM, Qobs = PrepGR$Qobs[SimInd],
......
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