Skip to content
GitLab
Commit cb1e05b0 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

Merge branch '106-runmodel_cemaneige-fails-in-createinputsmodel-at-the-hourly-time-step' into 'dev' 

Resolve "RunModel_CemaNeige fails in CreateInputsModel at the hourly time step"

Closes #106

See merge request !36
parents 7e37d970 87bb2834
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 CRAN_v1.6.12 CRAN_v1.6.11
2 merge requests!46CRAN v1.6.12,!36Resolve "RunModel_CemaNeige fails in CreateInputsModel at the hourly time step"
Pipeline #22514 failed with stages
in 7 minutes and 53 seconds
Hide whitespace changes
Inline Side-by-side
Showing
with 155 additions and 175 deletions
+155 -175
NAMESPACE
+ 1
− 0
View file @ cb1e05b0
......@@ -66,6 +66,7 @@ export(TransfoParam_GR5J)
export(TransfoParam_GR6J)
export(TransfoParam_Lag)
export(.ErrorCrit)
export(.FeatModels)
#####################################
......
R/CreateInputsModel.R
+ 15
− 73
View file @ cb1e05b0
......@@ -11,87 +11,29 @@ CreateInputsModel <- function(FUN_MOD,
ObjectClass <- NULL
FUN_MOD <- match.fun(FUN_MOD)
##check_FUN_MOD
BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_GR5H)) {
ObjectClass <- c(ObjectClass, "hourly", "GR")
TimeStep <- as.integer(60 * 60)
BOOL <- TRUE
## check DatesR
if (is.null(DatesR)) {
stop("'DatesR' is missing")
}
if (identical(FUN_MOD, RunModel_GR4J) |
identical(FUN_MOD, RunModel_GR5J) |
identical(FUN_MOD, RunModel_GR6J)) {
ObjectClass <- c(ObjectClass, "daily", "GR")
TimeStep <- as.integer(24 * 60 * 60)
BOOL <- TRUE
if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
}
if (identical(FUN_MOD, RunModel_GR2M)) {
ObjectClass <- c(ObjectClass, "GR", "monthly")
TimeStep <- as.integer(c(28, 29, 30, 31) * 24 * 60 * 60)
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_GR1A)) {
ObjectClass <- c(ObjectClass, "GR", "yearly")
TimeStep <- as.integer(c(365, 366) * 24 * 60 * 60)
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass, "daily", "CemaNeige")
TimeStep <- as.integer(24 * 60 * 60)
BOOL <- TRUE
if (!"POSIXlt" %in% class(DatesR)) {
DatesR <- as.POSIXlt(DatesR)
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
ObjectClass <- c(ObjectClass, "daily", "GR", "CemaNeige")
TimeStep <- as.integer(24 * 60 * 60)
BOOL <- TRUE
if (any(duplicated(DatesR))) {
stop("'DatesR' must not include duplicated values")
}
if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
ObjectClass <- c(ObjectClass, "hourly", "GR", "CemaNeige")
LLL <- length(DatesR)
TimeStep <- as.integer(60 * 60)
## check FUN_MOD
FUN_MOD <- match.fun(FUN_MOD)
FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = DatesR)
ObjectClass <- FeatFUN_MOD$Class
BOOL <- TRUE
}
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'")
}
##check_arguments
if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
if (is.null(DatesR)) {
stop("'DatesR' is missing")
}
if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'")
}
if (!"POSIXlt" %in% class(DatesR)) {
DatesR <- as.POSIXlt(DatesR)
}
if (!difftime(tail(DatesR, 1), tail(DatesR, 2), units = "secs")[[1]] %in% TimeStep) {
TimeStepName <- grep("hourly|daily|monthly|yearly", ObjectClass, value = TRUE)
stop(paste0("the time step of the model inputs must be ", TimeStepName, "\n"))
}
if (any(duplicated(DatesR))) {
stop("'DatesR' must not include duplicated values")
}
LLL <- length(DatesR)
}
if ("GR" %in% ObjectClass) {
if (is.null(Precip)) {
stop("Precip is missing")
......
R/CreateRunOptions.R
+ 61
− 102
View file @ cb1e05b0
......@@ -4,7 +4,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
Outputs_Cal = NULL, Outputs_Sim = "all",
MeanAnSolidPrecip = NULL, IsHyst = FALSE,
warnings = TRUE, verbose = TRUE) {
if (!is.null(Imax)) {
if (!is.numeric(Imax) | length(Imax) != 1L) {
stop("'Imax' must be a non negative 'numeric' value of length 1")
......@@ -17,57 +17,28 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
} else {
IsIntStore <- FALSE
}
ObjectClass <- NULL
## check FUN_MOD
FUN_MOD <- match.fun(FUN_MOD)
##check_FUN_MOD
BOOL <- FALSE
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)) {
ObjectClass <- c(ObjectClass, "GR", "yearly")
BOOL <- TRUE
}
if (identical(FUN_MOD, RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass, "CemaNeige", "daily")
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 (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
ObjectClass <- c(ObjectClass, "GR", "CemaNeige", "hourly")
BOOL <- TRUE
}
FeatFUN_MOD <- .GetFeatModel(FUN_MOD = FUN_MOD, DatesR = InputsModel$DatesR)
ObjectClass <- FeatFUN_MOD$Class
TimeStepMean <- FeatFUN_MOD$TimeStepMean
## manage class
if (IsIntStore) {
ObjectClass <- c(ObjectClass, "interception")
}
if (IsHyst) {
ObjectClass <- c(ObjectClass, "hysteresis")
}
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateRunOptions'")
}
if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
stop("'IsHyst' cannot be TRUE for the chosen 'FUN_MOD'")
}
if (!(identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & "interception" %in% ObjectClass) {
stop("'IMax' cannot be set for the chosen 'FUN_MOD'")
}
##check_InputsModel
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
......@@ -94,8 +65,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
!inherits(InputsModel, "yearly")) {
stop("'InputsModel' must be of class 'yearly'")
}
##check_IndPeriod_Run
if (!is.vector(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values")
......@@ -109,8 +80,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
if (storage.mode(IndPeriod_Run) != "integer") {
stop("'IndPeriod_Run' should be of type integer")
}
##check_IndPeriod_WarmUp
WTxt <- NULL
if (is.null(IndPeriod_WarmUp)) {
......@@ -129,19 +100,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
TmpDateR <- TmpDateR - 1 * 24 * 60 * 60
}
IndPeriod_WarmUp <- which(InputsModel$DatesR == max(InputsModel$DatesR[1], TmpDateR)):(IndPeriod_Run[1] - 1)
if ("hourly" %in% ObjectClass) {
TimeStep <- as.integer(60 * 60)
}
if ("daily" %in% ObjectClass) {
TimeStep <- as.integer(24 * 60 * 60)
}
if ("monthly" %in% ObjectClass) {
TimeStep <- as.integer(30.44 * 24 * 60 * 60)
}
if ("yearly" %in% ObjectClass) {
TimeStep <- as.integer(365.25 * 24 * 60 * 60)
}
if (length(IndPeriod_WarmUp) * TimeStep / (365 * 24 * 60 * 60) >= 1) {
if (length(IndPeriod_WarmUp) * TimeStepMean / (365 * 24 * 60 * 60) >= 1) {
WTxt <- paste0(WTxt, "\n the year preceding the run period is used \n")
} else {
WTxt <- paste0(WTxt, "\n less than a year (without missing values) was found for model warm up:")
......@@ -169,34 +128,34 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
if (!is.null(WTxt) & warnings) {
warning(WTxt)
}
## check IniResLevels
## check IniResLevels
if ("GR" %in% ObjectClass & ("monthly" %in% ObjectClass | "daily" %in% ObjectClass | "hourly" %in% ObjectClass)) {
if (!is.null(IniResLevels)) {
# if (!is.vector(IniResLevels) | !is.numeric(IniResLevels) | any(is.na(IniResLevels))) {
if (!is.vector(IniResLevels) | is.character(IniResLevels) | is.factor(IniResLevels) | length(IniResLevels) != 4) {
if (!is.vector(IniResLevels) | is.character(IniResLevels) | is.factor(IniResLevels) | length(IniResLevels) != 4) {
stop("'IniResLevels' must be a vector of 4 numeric values")
}
# if ((identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H) |
# # (identical(FUN_MOD, RunModel_GR5H) & !IsIntStore) |
# identical(FUN_MOD, RunModel_GR5H) |
# identical(FUN_MOD, RunModel_GR5H) |
# identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
# identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
# identical(FUN_MOD, RunModel_GR2M)) &
# length(IniResLevels) != 2) {
# stop("the length of 'IniResLevels' must be 2 for the chosen 'FUN_MOD'")
# }
# }
if (any(is.na(IniResLevels[1:2]))) {
stop("the first 2 values of 'IniResLevels' cannot be missing values for the chosen 'FUN_MOD'")
}
# if ((identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J) |
# if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J) |
# (identical(FUN_MOD, RunModel_GR5H) & IsIntStore)) &
# length(IniResLevels) != 3) {
# stop("the length of 'IniResLevels' must be 3 for the chosen 'FUN_MOD'")
# }
if ((identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J))) {
if (is.na(IniResLevels[3L])) {
# }
if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J))) {
if (is.na(IniResLevels[3L])) {
stop("the third value of 'IniResLevels' cannot be a missing value for the chosen 'FUN_MOD'")
}
} else {
......@@ -205,20 +164,20 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
IniResLevels[3L] <- NA
}
}
if (identical(FUN_MOD,RunModel_GR5H) | identical(FUN_MOD,RunModel_CemaNeigeGR5H)) {
if (IsIntStore & is.na(IniResLevels[4L])) {
if (identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
if (IsIntStore & is.na(IniResLevels[4L])) {
stop("the fourth value of 'IniResLevels' cannot be a missing value for the chosen 'FUN_MOD' (GR5H with an interception store)")
}
if (!IsIntStore & !is.na(IniResLevels[4L])) {
if (!IsIntStore & !is.na(IniResLevels[4L])) {
warning("the fourth value of 'IniResLevels' is set to NA value for the chosen 'FUN_MOD'. Only GR5H used with an 'Imax' value presents an interception store")
IniResLevels[4L] <- NA
}
} else {
if (!is.na(IniResLevels[4L])) {
if (!is.na(IniResLevels[4L])) {
warning("the fourth value of 'IniResLevels' is set to NA value for the chosen 'FUN_MOD'. Only GR5H used with an 'Imax' value presents an interception store")
IniResLevels[4L] <- NA
}
}
}
} else if (is.null(IniStates)) {
IniResLevels <- as.double(c(0.3, 0.5, NA, NA))
if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
......@@ -229,7 +188,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
}
# if (!identical(FUN_MOD, RunModel_GR6J) & !identical(FUN_MOD, RunModel_CemaNeigeGR6J) &
# !identical(FUN_MOD, RunModel_GR5H) & !identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
# if (is.null(IniStates)) {
# if (is.null(IniStates)) {
# IniResLevels <- as.double(c(0.3, 0.5, NA, NA))
# }
}
......@@ -253,7 +212,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
NState <- NULL
if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
if ("hourly" %in% ObjectClass) {
NState <- 7 + 3 * 24 * 20+ 4 * NLayers
NState <- 7 + 3 * 24 * 20 + 4 * NLayers
}
if ("daily" %in% ObjectClass) {
NState <- 7 + 3 * 20 + 4 * NLayers
......@@ -266,7 +225,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
}
}
if (!is.null(IniStates)) {
if (!inherits(IniStates, "IniStates")) {
stop("'IniStates' must be an object of class 'IniStates'")
}
......@@ -278,14 +237,14 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
}
if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J) |
identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) &
!all(is.na(IniStates$UH$UH1))) { ## GR5J or GR5H
!all(is.na(IniStates$UH$UH1))) { ## GR5J or GR5H
stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' In 'IniStates', 'UH1' has to be a vector of NA for GR5J"))
}
if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & is.na(IniStates$Store$Exp)) { ## GR6J
stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' GR6J needs an exponential store value in 'IniStates'"))
}
if ((identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) & is.na(IniStates$Store$Int)) { ## GR5H interception
stop(paste0("non convenient 'IniStates' for the chosen 'FUN_MOD'.' GR5H (with interception store) needs an interception store value in 'IniStates'"))
}
if (!(identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & !is.na(IniStates$Store$Exp)) { ## except GR6J
......@@ -297,7 +256,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
# if (length(na.omit(unlist(IniStates))) != NState) {
# stop(paste0("the length of IniStates must be ", NState, " for the chosen FUN_MOD"))
# }
if ((!"CemaNeige" %in% ObjectClass & inherits(IniStates, "CemaNeige")) |
if ((!"CemaNeige" %in% ObjectClass & inherits(IniStates, "CemaNeige")) |
( "CemaNeige" %in% ObjectClass & !inherits(IniStates, "CemaNeige"))) {
stop("'FUN_MOD' and 'IniStates' must be both of class 'CemaNeige'")
}
......@@ -326,37 +285,37 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
} else {
IniStates <- as.double(rep(0.0, NState))
}
##check_Outputs_Cal_and_Sim
##Outputs_all
Outputs_all <- NULL
if (identical(FUN_MOD,RunModel_GR4H) | identical(FUN_MOD,RunModel_CemaNeigeGR4H)) {
if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4H")$GR)
}
if (identical(FUN_MOD,RunModel_GR5H) | identical(FUN_MOD,RunModel_CemaNeigeGR5H)) {
if (identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5H")$GR)
}
if (identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR4J)) {
if (identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR4J")$GR)
}
if (identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J)) {
if (identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5J")$GR)
}
if (identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)) {
if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR6J")$GR)
}
if (identical(FUN_MOD,RunModel_GR2M)) {
if (identical(FUN_MOD, RunModel_GR2M)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR2M")$GR)
}
if (identical(FUN_MOD,RunModel_GR1A)) {
if (identical(FUN_MOD, RunModel_GR1A)) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR1A")$GR)
}
if ("CemaNeige" %in% ObjectClass) {
Outputs_all <- c(Outputs_all, .FortranOutputs(GR = NULL, isCN = TRUE)$CN)
}
##check_Outputs_Sim
if (!is.vector(Outputs_Sim)) {
stop("'Outputs_Sim' must be a vector of characters")
......@@ -376,8 +335,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
paste(Outputs_Sim[Test], collapse = ", "), " not found"))
}
Outputs_Sim <- Outputs_Sim[!duplicated(Outputs_Sim)]
##check_Outputs_Cal
if (is.null(Outputs_Cal)) {
if ("GR" %in% ObjectClass) {
......@@ -403,7 +362,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
}
if ("all" %in% Outputs_Cal) {
Outputs_Cal <- c("DatesR", Outputs_all, "StateEnd")
}
Test <- which(!Outputs_Cal %in% c("DatesR", Outputs_all, "StateEnd"))
if (length(Test) != 0) {
......@@ -411,8 +370,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
paste(Outputs_Cal[Test], collapse = ", "), " not found"))
}
Outputs_Cal <- unique(Outputs_Cal)
##check_MeanAnSolidPrecip
if ("CemaNeige" %in% ObjectClass & is.null(MeanAnSolidPrecip)) {
NLayers <- length(InputsModel$LayerPrecip)
......@@ -461,8 +420,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
stop(paste0("'MeanAnSolidPrecip' must be a numeric vector of length ", NLayers, ""))
}
}
##check_PliqAndMelt
if ("GR" %in% ObjectClass & "CemaNeige" %in% ObjectClass) {
if (!"PliqAndMelt" %in% Outputs_Cal & !"all" %in% Outputs_Cal) {
......@@ -484,8 +443,8 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
Outputs_Sim <- c(Outputs_Sim, "PliqAndMelt")
}
}
##check_Qsim
if ("GR" %in% ObjectClass) {
if (!"Qsim" %in% Outputs_Cal & !"all" %in% Outputs_Cal) {
......@@ -507,7 +466,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
Outputs_Sim <- c(Outputs_Sim, "Qsim")
}
}
##Create_RunOptions
RunOptions <- list(IndPeriod_WarmUp = IndPeriod_WarmUp,
IndPeriod_Run = IndPeriod_Run,
......@@ -515,7 +474,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
IniResLevels = IniResLevels,
Outputs_Cal = Outputs_Cal,
Outputs_Sim = Outputs_Sim)
if ("CemaNeige" %in% ObjectClass) {
RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip))
}
......@@ -523,9 +482,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
RunOptions <- c(RunOptions, list(Imax = Imax))
}
class(RunOptions) <- c("RunOptions", ObjectClass)
return(RunOptions)
}
R/Utils.R
+ 64
− 0
View file @ cb1e05b0
......@@ -13,6 +13,70 @@
## =================================================================================
## function to extract model features
## =================================================================================
## table of feature models
.FeatModels <- function() {
path <- system.file("modelsFeatures/FeatModelsGR.csv", package = "airGR")
read.table(path, header = TRUE, sep = ";", stringsAsFactors = FALSE)
}
## function to extract model features
.GetFeatModel <- function(FUN_MOD, DatesR = NULL) {
FeatMod <- .FeatModels()
NameFunMod <- ifelse(test = FeatMod$Pkg %in% "airGR",
yes = paste("RunModel", FeatMod$NameMod, sep = "_"),
no = FeatMod$NameMod)
FunMod <- lapply(NameFunMod, FUN = get)
IdMod <- which(sapply(FunMod, FUN = function(x) identical(FUN_MOD, x)))
if (length(IdMod) < 1) {
stop("'FUN_MOD' must be one of ", paste(NameFunMod, collapse = ", "))
} else {
res <- as.list(FeatMod[IdMod, ])
res$NameFunMod <- NameFunMod[IdMod]
if (!is.null(DatesR)) {
DiffTimeStep <- as.numeric(difftime(DatesR[length(DatesR)],
DatesR[length(DatesR)-1],
units = "secs"))
if (is.na(res$TimeUnit)) {
if (any(DiffTimeStep %in% 3600:3601)) { # 3601: leap second
res$TimeUnit <- "hourly"
} else {
res$TimeUnit <- "daily"
}
}
}
res$TimeStep <- switch(res$TimeUnit,
hourly = 1,
daily = 1 * 24,
monthly = 28:31 * 24,
yearly = 365:366 * 24)
res$TimeStepMean <- switch(res$TimeUnit,
hourly = 1,
daily = 1 * 24,
monthly = 365.25 / 12 * 24,
yearly = 365.25 * 24)
res$TimeStep <- res$TimeStep * 3600
res$TimeStepMean <- as.integer(res$TimeStepMean * 3600)
res$Class <- c(res$TimeUnit, res$Class)
if (grepl("CemaNeige", res$NameFunMod)) {
res$Class <- c(res$Class, "CemaNeige")
}
res$Class <- res$Class[!is.na(res$Class)]
if (!is.null(DatesR)) {
if (all(DiffTimeStep != res$TimeStep)) {
stop("the time step of the model inputs must be ", res$TimeUnit)
}
}
return(res)
}
}
## =================================================================================
## function to manage Fortran outputs
## =================================================================================
......
inst/modelsFeatures/FeatModelsGR.csv 0 → 100644
+ 14
− 0
View file @ cb1e05b0
CodeMod;NameMod;NbParam;TimeUnit;Id;Class;Pkg
GR1A;GR1A;1;yearly;NA;GR;airGR
GR2M;GR2M;2;monthly;NA;GR;airGR
GR4J;GR4J;4;daily;NA;GR;airGR
GR5J;GR5J;5;daily;NA;GR;airGR
GR6J;GR6J;6;daily;NA;GR;airGR
GR4H;GR4H;4;hourly;NA;GR;airGR
GR5H;GR5H;5;hourly;NA;GR;airGR
CemaNeige;CemaNeige;2;NA;NA;NA;airGR
CemaNeigeGR4J;CemaNeigeGR4J;6;daily;NA;GR;airGR
CemaNeigeGR5J;CemaNeigeGR5J;7;daily;NA;GR;airGR
CemaNeigeGR6J;CemaNeigeGR6J;8;daily;NA;GR;airGR
CemaNeigeGR4H;CemaNeigeGR4H;6;hourly;NA;GR;airGR
CemaNeigeGR5H;CemaNeigeGR5H;7;hourly;NA;GR;airGR
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