Skip to content
GitLab
Commit 1ff328ac authored by Dorchies David's avatar Dorchies David
Browse files

fix(CreateIniStates): crash with CreateIniStates(RunModel_Lag, ...) 

- Use .GetFeatModel for having always up to date function list

Refs #132
parent 51258480
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',!54Resolve "RunModel_Lag: add WarmUpQsim to OutputsModel"
Hide whitespace changes
Inline Side-by-side
Showing
with 25 additions and 53 deletions
+25 -53
R/CreateIniStates.R
+ 19
− 53
View file @ 1ff328ac
...@@ -12,45 +12,11 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -12,45 +12,11 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
UH1n <- 20L UH1n <- 20L
UH2n <- UH1n * 2L UH2n <- UH1n * 2L
nameFUN_MOD <- as.character(substitute(FUN_MOD))
FUN_MOD <- match.fun(FUN_MOD) FUN_MOD <- match.fun(FUN_MOD)
## check FUN_MOD FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = InputsModel$DatesR)
BOOL <- FALSE ObjectClass <- FeatFUN_MOD$Class
if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_GR5H)) {
ObjectClass <- c(ObjectClass, "GR", "hourly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR4J) |
identical(FUN_MOD, RunModel_GR5J) |
identical(FUN_MOD, RunModel_GR6J)) {
ObjectClass <- c(ObjectClass, "GR", "daily")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR2M)) {
ObjectClass <- c(ObjectClass, "GR", "monthly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR1A)) {
stop("'RunModel_GR1A' does not require 'IniStates' object")
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "hourly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "daily")
BOOL <- TRUE
}
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateIniStates'")
}
if (!"CemaNeige" %in% ObjectClass & IsHyst) { if (!"CemaNeige" %in% ObjectClass & IsHyst) {
stop("'IsHyst' cannot be TRUE if CemaNeige is not used in 'FUN_MOD'") stop("'IsHyst' cannot be TRUE if CemaNeige is not used in 'FUN_MOD'")
} }
...@@ -82,7 +48,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -82,7 +48,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
} }
} else if (!is.null(ExpStore)) { } else if (!is.null(ExpStore)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'ExpStore'. Value set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'ExpStore'. Value set to NA", FeatFUN_MOD$NameFunMod))
} }
ExpStore <- Inf ExpStore <- Inf
} }
...@@ -90,13 +56,13 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -90,13 +56,13 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
if (identical(FUN_MOD, RunModel_GR2M)) { if (identical(FUN_MOD, RunModel_GR2M)) {
if (!is.null(UH1)) { if (!is.null(UH1)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'UH1'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
UH1 <- rep(Inf, UH1n) UH1 <- rep(Inf, UH1n)
} }
if (!is.null(UH2)) { if (!is.null(UH2)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'UH2'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'UH2'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
UH2 <- rep(Inf, UH2n) UH2 <- rep(Inf, UH2n)
} }
...@@ -104,13 +70,13 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -104,13 +70,13 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !is.null(UH1)) { if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !is.null(UH1)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'UH1'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
UH1 <- rep(Inf, UH1n) UH1 <- rep(Inf, UH1n)
} }
if ((!identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & !is.null(IntStore)) { if ((!identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & !is.null(IntStore)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'IntStore'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'IntStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
IntStore <- Inf IntStore <- Inf
} }
...@@ -118,57 +84,57 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -118,57 +84,57 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
if ("CemaNeige" %in% ObjectClass & ! "GR" %in% ObjectClass) { if ("CemaNeige" %in% ObjectClass & ! "GR" %in% ObjectClass) {
if (!is.null(ProdStore)) { if (!is.null(ProdStore)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'ProdStore'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'ProdStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
} }
ProdStore <- Inf ProdStore <- Inf
if (!is.null(RoutStore)) { if (!is.null(RoutStore)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'RoutStore'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'RoutStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
} }
RoutStore <- Inf RoutStore <- Inf
if (!is.null(ExpStore)) { if (!is.null(ExpStore)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'ExpStore'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'ExpStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
} }
ExpStore <- Inf ExpStore <- Inf
if (!is.null(IntStore)) { if (!is.null(IntStore)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'IntStore'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'IntStore'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
} }
IntStore <- Inf IntStore <- Inf
if (!is.null(UH1)) { if (!is.null(UH1)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'UH1'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'UH1'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
} }
UH1 <- rep(Inf, UH1n) UH1 <- rep(Inf, UH1n)
if (!is.null(UH2)) { if (!is.null(UH2)) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'UH2'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'UH2'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
} }
UH2 <- rep(Inf, UH2n) UH2 <- rep(Inf, UH2n)
} }
if (IsIntStore & is.null(IntStore)) { if (IsIntStore & is.null(IntStore)) {
stop(sprintf("'%s' need values for 'IntStore'", nameFUN_MOD)) stop(sprintf("'%s' need values for 'IntStore'", FeatFUN_MOD$NameFunMod))
} }
if ("CemaNeige" %in% ObjectClass & !IsHyst & if ("CemaNeige" %in% ObjectClass & !IsHyst &
(is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) { (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) {
stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", nameFUN_MOD)) stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", FeatFUN_MOD$NameFunMod))
} }
if ("CemaNeige" %in% ObjectClass & IsHyst & if ("CemaNeige" %in% ObjectClass & IsHyst &
(is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers) | (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers) |
is.null(GthrCemaNeigeLayers) | is.null(GlocmaxCemaNeigeLayers))) { is.null(GthrCemaNeigeLayers) | is.null(GlocmaxCemaNeigeLayers))) {
stop(sprintf("'%s' need values for 'GCemaNeigeLayers', 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'", nameFUN_MOD)) stop(sprintf("'%s' need values for 'GCemaNeigeLayers', 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'", FeatFUN_MOD$NameFunMod))
} }
if ("CemaNeige" %in% ObjectClass & !IsHyst & if ("CemaNeige" %in% ObjectClass & !IsHyst &
(!is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) { (!is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
GthrCemaNeigeLayers <- Inf GthrCemaNeigeLayers <- Inf
GlocmaxCemaNeigeLayers <- Inf GlocmaxCemaNeigeLayers <- Inf
...@@ -176,7 +142,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F ...@@ -176,7 +142,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
if (!"CemaNeige" %in% ObjectClass & if (!"CemaNeige" %in% ObjectClass &
(!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) { (!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
if (verbose) { if (verbose) {
warning(sprintf("'%s' does not require 'GCemaNeigeLayers' 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD)) warning(sprintf("'%s' does not require 'GCemaNeigeLayers' 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", FeatFUN_MOD$NameFunMod))
} }
GCemaNeigeLayers <- Inf GCemaNeigeLayers <- Inf
eTGCemaNeigeLayers <- Inf eTGCemaNeigeLayers <- Inf
......
tests/testthat/test-CreateiniStates.R
+ 6
− 0
View file @ 1ff328ac
...@@ -96,3 +96,9 @@ test_that("Error: Number of items not equal to number of upstream connections", ...@@ -96,3 +96,9 @@ test_that("Error: Number of items not equal to number of upstream connections",
) )
}) })
}) })
test_that("FUN = RunModel_lag must work", {
IS <- CreateIniStates(RunModel_Lag, InputsModel, SD = list(rep(0, 10)))
expect_equal(IS$SD[[1]], rep(0, 10))
expect_s3_class(IS, "SD")
})
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