Skip to content
GitLab
Commit 29dec7ea authored by Dorchies David's avatar Dorchies David
Browse files

refactor(RunModel_*GR*): argument check with the function .ArgumentsCheckGR 

Refs #129
parent 8431b150
dev 115-add-pcict-date-format-managment 136-decreased-performance-of-calibration-execution-time 161-runmodel_lag-proposal-for-a-better-transformation-and-screening-of-the-parameters 165-add-missing-isintstore-argument-in-createcaliboptions 171-check-error-direct-call-of-as-data-frame-posixct-is-deprecated-use-as-data-frame-vector-or-as 191-speed-up-runmodel_lag-when-it-is-used-alone 33-merge-airgr-and-airgrplus-functions master rmOptions CRAN_v1.7.6 CRAN_v1.7.5 CRAN_v1.7.4 CRAN_v1.7.3 CRAN_v1.7.2 CRAN_v1.7.1 CRAN_v1.7.0
2 merge requests!73Merge branch 'dev' into 'master',!50Resolve "Optimisation of OutputsModel creation in RunModel*"
Pipeline #24009 passed with stages
in 32 minutes and 55 seconds
Hide whitespace changes
Inline Side-by-side
Showing
with 76 additions and 333 deletions
+76 -333
R/CreateRunOptions.R
+ 5
− 4
View file @ 29dec7ea
......@@ -25,9 +25,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
TimeStepMean <- FeatFUN_MOD$TimeStepMean
## Model output variable list
ModelHydro <- gsub("CemaNeige", "", FeatFUN_MOD$CodeMod)
FortranOutputs <- .FortranOutputs(GR = ModelHydro,
isCN = substr(FeatFUN_MOD$CodeMod, 1, 9) == "CemaNeige")
FortranOutputs <- .FortranOutputs(GR = FeatFUN_MOD$CodeModHydro,
isCN = "CemaNeige" %in% FeatFUN_MOD$Class)
## manage class
if (IsIntStore) {
......@@ -35,6 +34,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
}
if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis")
FeatFUN_MOD$NbParam <- FeatFUN_MOD$NbParam + 2
}
if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
......@@ -479,7 +479,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
IniResLevels = IniResLevels,
Outputs_Cal = Outputs_Cal,
Outputs_Sim = Outputs_Sim,
FortranOutputs = FortranOutputs)
FortranOutputs = FortranOutputs,
FeatFUN_MOD = FeatFUN_MOD)
if ("CemaNeige" %in% ObjectClass) {
RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip))
......
R/RunModel_CemaNeigeGR4H.R
+ 3
− 30
View file @ 29dec7ea
......@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 8L, no = 6L)
NParamCN <- NParam - 4L
NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 4L
NStates <- 4L
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
Param <- as.double(Param)
......
R/RunModel_CemaNeigeGR4J.R
+ 3
− 30
View file @ 29dec7ea
......@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR4J <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 8L, no = 6L)
NParamCN <- NParam - 4L
NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 4L
NStates <- 4L
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
Param <- as.double(Param)
......
R/RunModel_CemaNeigeGR5H.R
+ 2
− 30
View file @ 29dec7ea
......@@ -3,8 +3,7 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 9L, no = 7L)
NParamCN <- NParam - 5L
NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 5L
NStates <- 4L
IsIntStore <- inherits(RunOptions, "interception")
if (IsIntStore) {
......@@ -13,35 +12,8 @@ RunModel_CemaNeigeGR5H <- function(InputsModel, RunOptions, Param) {
Imax <- -99
}
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param)
......
R/RunModel_CemaNeigeGR5J.R
+ 3
− 30
View file @ 29dec7ea
......@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR5J <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 9L, no = 7L)
NParamCN <- NParam - 5L
NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 5L
NStates <- 4L
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
Param <- as.double(Param)
......
R/RunModel_CemaNeigeGR6J.R
+ 3
− 30
View file @ 29dec7ea
......@@ -3,39 +3,12 @@ RunModel_CemaNeigeGR6J <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
IsHyst <- inherits(RunOptions, "hysteresis")
NParam <- ifelse(test = IsHyst, yes = 10L, no = 8L)
NParamCN <- NParam - 6L
NParamCN <- RunOptions$FeatFUN_MOD$NbParam - 6L
NStates <- 4L
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
Param <- as.double(Param)
......
R/RunModel_GR1A.R
+ 1
− 26
View file @ 29dec7ea
RunModel_GR1A <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 1
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "yearly")) {
stop("'InputsModel' must be of class 'yearly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param)
......
R/RunModel_GR2M.R
+ 1
− 26
View file @ 29dec7ea
RunModel_GR2M <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 2
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "monthly")) {
stop("'InputsModel' must be of class 'monthly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param)
Param_X1X2_threshold <- 1e-2
......
R/RunModel_GR4H.R
+ 1
− 26
View file @ 29dec7ea
RunModel_GR4H <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 4
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
......
R/RunModel_GR4J.R
+ 1
− 25
View file @ 29dec7ea
RunModel_GR4J <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 4
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
......
R/RunModel_GR5H.R
+ 1
− 23
View file @ 29dec7ea
......@@ -2,7 +2,6 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
NParam <- 5
IsIntStore <- inherits(RunOptions, "interception")
if (IsIntStore) {
Imax <- RunOptions$Imax
......@@ -10,29 +9,8 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
Imax <- -99
}
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
......
R/RunModel_GR5J.R
+ 1
− 26
View file @ 29dec7ea
RunModel_GR5J <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 5
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
......
R/RunModel_GR6J.R
+ 1
− 26
View file @ 29dec7ea
RunModel_GR6J <- function(InputsModel, RunOptions, Param) {
.ArgumentsCheckGR(InputsModel, RunOptions, Param)
## Initialization of variables
NParam <- 6
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != NParam) {
stop(paste("'Param' must be a vector of length", NParam, "and contain no NA"))
}
Param <- as.double(Param)
Param_X1X3X6_threshold <- 1e-2
......
R/Utils.R
+ 1
− 0
View file @ 29dec7ea
......@@ -71,6 +71,7 @@
stop("the time step of the model inputs must be ", res$TimeUnit)
}
}
res$CodeModHydro <- gsub("CemaNeige", "", res$CodeMod)
return(res)
}
}
......
R/UtilsRunModel.R
+ 49
− 1
View file @ 29dec7ea
......@@ -6,7 +6,7 @@
#' @param LInputSeries number of time steps of warm-up + run periods
#' @param CemaNeigeLayers outputs of Cemaneige pre-process
#'
#' @return
#' @return OutputsModel object
#' @noRd
#'
.GetOutputsModel <- function(InputsModel,
......@@ -48,3 +48,51 @@
return(OutputsModel)
}
#' Check arguments of `RunModel_*GR*` functions
#'
#' @param InputsModel see [CreateInputsModel]
#' @param RunOptions see [CreateRunOptions]
#' @param Param [numeric] [vector] model calibration parameters
#'
#' @return [NULL]
#' @noRd
#'
.ArgumentsCheckGR <- function(InputsModel, RunOptions, Param) {
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
if (!inherits(InputsModel, RunOptions$FeatFUN_MOD$TimeUnit)) {
stop("'InputsModel' must be of class '", RunOptions$FeatFUN_MOD$TimeUnit, "'")
}
if (!inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
}
if (class(RunOptions)[1] != "RunOptions") {
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
} else {
stop("'RunOptions' class of 'RunOptions' must be in first position")
}
}
if (!inherits(RunOptions, "GR")) {
stop("'RunOptions' must be of class 'GR'")
}
if ("CemaNeige" %in% RunOptions$FeatFUN_MOD$Class) {
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
}
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
if (sum(!is.na(Param)) != RunOptions$FeatFUN_MOD$NbParam) {
stop(paste("'Param' must be a vector of length", RunOptions$FeatFUN_MOD$NbParam, "and contain no NA"))
}
}
inst/vignettesData/vignetteParamOptimCaramel.rda
+ 0
− 0
View file @ 29dec7ea
No preview for this file type
Supports Markdown
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