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

v1.2.7.3 CLEAN: remove unnecessary return(NULL) after stops

parent f53b6a57
dev 115-add-pcict-date-format-managment 118-plot-outputsmodel-remove-case-sensitivity-to-the-which-argument 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 60-migrate-transfoparam-functions-and-createcaliboptions-to-s3-methods 96-parallelize-the-grid-screening-step-during-calibration airGRplus 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 CRAN_v1.6.10.4 CRAN_v1.6.9.27 CRAN_v1.6.9.24 CRAN_v1.6.9.23 CRAN_v1.6.9.21 CRAN_v1.4.3.65 CRAN_v1.4.3.60 CRAN_v1.4.3.52 CRAN_v1.3.2.42 CRAN_v1.3.2.41 CRAN_v1.3.2.40 CRAN_v1.3.2.39 CRAN_v1.3.2.23 CRAN_v1.3.2.17 CRAN_v1.2.13.16 CRAN_v1.2.13.13
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 71 additions and 224 deletions
+71 -224
DESCRIPTION
+ 1
− 1
View file @ eec01d4f
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.2.7.2
Version: 1.2.7.3
Date: 2019-03-01
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
NEWS.rmd
+ 1
− 1
View file @ eec01d4f
......@@ -13,7 +13,7 @@ output:
### 1.2.7.2 Release Notes (2019-03-01)
### 1.2.7.3 Release Notes (2019-03-01)
......
R/Calibration_Michel.R
+ 0
− 10
View file @ eec01d4f
......@@ -5,27 +5,21 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
##_____Arguments_check_____________________________________________________________________
if (!inherits(InputsModel, "InputsModel")) {
stop("InputsModel must be of class 'InputsModel'")
return(NULL)
}
if (!inherits(RunOptions, "RunOptions")) {
stop("RunOptions must be of class 'RunOptions'")
return(NULL)
}
if (!inherits(InputsCrit, "InputsCrit")) {
stop("InputsCrit must be of class 'InputsCrit'")
return(NULL)
}
if (inherits(InputsCrit, "Multi")) {
stop("InputsCrit must be of class 'Single' or 'Compo'")
return(NULL)
}
if (!inherits(CalibOptions, "CalibOptions")) {
stop("CalibOptions must be of class 'CalibOptions'")
return(NULL)
}
if (!inherits(CalibOptions, "HBAN")) {
stop("CalibOptions must be of class 'HBAN' if Calibration_Michel is used")
return(NULL)
}
if (!missing(FUN_CRIT)) {
warning("argument 'FUN_CRIT' is deprecated. The error criterion function is now automatically get from the 'InputsCrit' object", call. = FALSE)
......@@ -92,7 +86,6 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
}
if (is.null(FUN_TRANSFO)) {
stop("FUN_TRANSFO was not found (in Calibration function)")
return(NULL)
}
}
......@@ -115,7 +108,6 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
}
if (NParam > 20) {
stop("Calibration_Michel can handle a maximum of 20 parameters")
return(NULL)
}
HistParamR <- matrix(NA, nrow = 500 * NParam, ncol = NParam)
HistParamT <- matrix(NA, nrow = 500 * NParam, ncol = NParam)
......@@ -238,11 +230,9 @@ Calibration_Michel <- function(InputsModel, RunOptions, InputsCrit, CalibOptions
##Format_checking
if (nrow(NewParamOptimT) != 1 | nrow(OldParamOptimT) != 1) {
stop("each input set must be a matrix of one single line")
return(NULL)
}
if (ncol(NewParamOptimT)!=ncol(OldParamOptimT) | ncol(NewParamOptimT) != length(OptimParam)) {
stop("each input set must have the same number of values")
return(NULL)
}
##Proposal_of_new_parameter_sets ###(local search providing 2 * NParam-1 new sets)
NParam <- ncol(NewParamOptimT)
......
R/CreateCalibOptions.R
+ 0
− 16
View file @ eec01d4f
......@@ -172,15 +172,12 @@ CreateCalibOptions <-
} else {
if (!is.vector(FixedParam)) {
stop("FixedParam must be a vector")
return(NULL)
}
if (length(FixedParam) != NParam) {
stop("Incompatibility between FixedParam length and FUN_MOD")
return(NULL)
}
if (all(!is.na(FixedParam))) {
stop("At least one parameter must be not set (NA)")
return(NULL)
}
if (all(is.na(FixedParam))) {
warning("You have not set any parameter in \"FixedParam\"")
......@@ -197,23 +194,18 @@ CreateCalibOptions <-
} else {
if (!is.matrix(SearchRanges)) {
stop("SearchRanges must be a matrix")
return(NULL)
}
if (!is.numeric(SearchRanges)) {
stop("SearchRanges must be a matrix of numeric values")
return(NULL)
}
if (sum(is.na(SearchRanges)) != 0) {
stop("SearchRanges must not include NA values")
return(NULL)
}
if (nrow(SearchRanges) != 2) {
stop("SearchRanges must have 2 rows")
return(NULL)
}
if (ncol(SearchRanges) != NParam) {
stop("Incompatibility between SearchRanges ncol and FUN_MOD")
return(NULL)
}
}
......@@ -280,37 +272,29 @@ CreateCalibOptions <-
if ("HBAN" %in% ObjectClass & !is.null(StartParamList)) {
if (!is.matrix(StartParamList)) {
stop("StartParamList must be a matrix")
return(NULL)
}
if (!is.numeric(StartParamList)) {
stop("StartParamList must be a matrix of numeric values")
return(NULL)
}
if (sum(is.na(StartParamList)) != 0) {
stop("StartParamList must not include NA values")
return(NULL)
}
if (ncol(StartParamList) != NParam) {
stop("Incompatibility between StartParamList ncol and FUN_MOD")
return(NULL)
}
}
if ("HBAN" %in% ObjectClass & !is.null(StartParamDistrib)) {
if (!is.matrix(StartParamDistrib)) {
stop("StartParamDistrib must be a matrix")
return(NULL)
}
if (!is.numeric(StartParamDistrib[1, ])) {
stop("StartParamDistrib must be a matrix of numeric values")
return(NULL)
}
if (sum(is.na(StartParamDistrib[1, ])) != 0) {
stop("StartParamDistrib must not include NA values on the first line")
return(NULL)
}
if (ncol(StartParamDistrib) != NParam) {
stop("Incompatibility between StartParamDistrib ncol and FUN_MOD")
return(NULL)
}
}
......
R/CreateIniStates.R
+ 0
− 6
View file @ eec01d4f
......@@ -43,22 +43,18 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
}
if (!BOOL) {
stop("Incorrect 'FUN_MOD' for use in 'CreateIniStates'")
return(NULL)
}
## check InputsModel
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
return(NULL)
}
if ("GR" %in% ObjectClass & !inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
return(NULL)
}
if ("CemaNeige" %in% ObjectClass &
!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
return(NULL)
}
......@@ -70,7 +66,6 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
if (is.null(ExpStore)) {
stop("'RunModel_*GR6J' need an 'ExpStore' value")
return(NULL)
}
} else if (!is.null(ExpStore)) {
if (verbose) {
......@@ -136,7 +131,6 @@ CreateIniStates <- function(FUN_MOD, InputsModel,
if("CemaNeige" %in% ObjectClass &
(is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) {
stop("'RunModel_CemaNeigeGR*' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'")
return(NULL)
}
if(!"CemaNeige" %in% ObjectClass &
(!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers))) {
......
R/CreateInputsCrit.R
+ 0
− 12
View file @ eec01d4f
......@@ -40,7 +40,6 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'InputsModel'
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
return(NULL)
}
......@@ -109,7 +108,6 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'RunOptions'
if (!inherits(RunOptions , "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
return(NULL)
}
......@@ -140,17 +138,14 @@ CreateInputsCrit <- function(FUN_CRIT,
if (!(identical(iListArgs2$FUN_CRIT, ErrorCrit_NSE ) | identical(iListArgs2$FUN_CRIT, ErrorCrit_KGE ) |
identical(iListArgs2$FUN_CRIT, ErrorCrit_KGE2) | identical(iListArgs2$FUN_CRIT, ErrorCrit_RMSE))) {
stop("incorrect 'FUN_CRIT' for use in 'CreateInputsCrit'", call. = FALSE)
return(NULL)
}
if (identical(iListArgs2$FUN_CRIT, ErrorCrit_RMSE) & length(listArgs$weights) > 1 & all(!is.null(unlist(listArgs$weights)))) {
stop("calculating a composite criterion with the RMSE is not allowed since RMSE is not an adimensional measure", call. = FALSE)
return(NULL)
}
## check 'obs'
if (!is.vector(iListArgs2$obs) | length(iListArgs2$obs) != LLL | !is.numeric(iListArgs2$obs)) {
stop(sprintf("'obs' must be a (list of) vector(s) of numeric values of length %i", LLL), call. = FALSE)
return(NULL)
}
## check 'BoolCrit'
......@@ -159,17 +154,14 @@ CreateInputsCrit <- function(FUN_CRIT,
}
if (!is.logical(iListArgs2$BoolCrit)) {
stop("'BoolCrit' must be a (list of) vector(s) of boolean", call. = FALSE)
return(NULL)
}
if (length(iListArgs2$BoolCrit) != LLL) {
stop("'BoolCrit' and 'InputsModel' series must have the same length", call. = FALSE)
return(NULL)
}
## check 'varObs'
if (!is.vector(iListArgs2$varObs) | length(iListArgs2$varObs) != 1 | !is.character(iListArgs2$varObs) | !all(iListArgs2$varObs %in% inVarObs)) {
stop(msgVarObs, call. = FALSE)
return(NULL)
}
## check 'varObs' + 'obs'
......@@ -193,14 +185,12 @@ CreateInputsCrit <- function(FUN_CRIT,
## check 'transfo'
if (is.null(iListArgs2$transfo) | !is.vector(iListArgs2$transfo) | length(iListArgs2$transfo) != 1 | !is.character(iListArgs2$transfo) | !all(iListArgs2$transfo %in% inTransfo)) {
stop(msgTransfo, call. = FALSE)
return(NULL)
}
## check 'weights'
if (!is.null(iListArgs2$weights)) {
if (!is.vector(iListArgs2$weights) | length(iListArgs2$weights) != 1 | !is.numeric(iListArgs2$weights) | any(iListArgs2$weights < 0)) {
stop("'weights' must be a single (list of) positive or equal to zero value(s)", call. = FALSE)
return(NULL)
}
}
......@@ -208,7 +198,6 @@ CreateInputsCrit <- function(FUN_CRIT,
if (!is.null(iListArgs2$epsilon)) {
if (!is.vector(iListArgs2$epsilon) | length(iListArgs2$epsilon) != 1 | !is.numeric(iListArgs2$epsilon) | any(iListArgs2$epsilon <= 0)) {
stop("'epsilon' must be a single (list of) positive value(s)", call. = FALSE)
return(NULL)
}
} else if (iListArgs2$transfo %in% c("log", "inv") & any(iListArgs2$obs %in% 0) & warnings) {
warning("zeroes detected in obs: the corresponding time-steps will be excluded by the 'ErrorCrit*' functions if the epsilon agrument = NULL", call. = FALSE)
......@@ -259,7 +248,6 @@ CreateInputsCrit <- function(FUN_CRIT,
if(equalInputsCrit) {
warning(sprintf("Elements %i and %i of the criteria list are identical. This might not be necessary", i[1], i[2]), call. = FALSE)
}
return(NULL)
})
}
......
R/CreateInputsModel.R
+ 0
− 27
View file @ eec01d4f
......@@ -59,18 +59,15 @@ CreateInputsModel <- function(FUN_MOD,
}
if (!BOOL) {
stop("Incorrect FUN_MOD for use in CreateInputsModel")
return(NULL)
}
##check_arguments
if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
if (is.null(DatesR)) {
stop("DatesR is missing")
return(NULL)
}
if ("POSIXlt" %in% class(DatesR) == FALSE & "POSIXct" %in% class(DatesR) == FALSE) {
stop("DatesR must be defined as POSIXlt or POSIXct")
return(NULL)
}
if ("POSIXlt" %in% class(DatesR) == FALSE) {
DatesR <- as.POSIXlt(DatesR)
......@@ -78,101 +75,79 @@ CreateInputsModel <- function(FUN_MOD,
if (difftime(tail(DatesR, 1), tail(DatesR, 2), units = "secs")[[1]] %in% TimeStep == FALSE) {
TimeStepName <- grep("hourly|daily|monthly|yearly", ObjectClass, value = TRUE)
stop(paste0("The time step of the model inputs must be ", TimeStepName, "\n"))
return(NULL)
}
if (any(duplicated(DatesR))) {
stop("DatesR must not include duplicated values")
return(NULL)
}
LLL <- length(DatesR)
}
if ("GR" %in% ObjectClass) {
if (is.null(Precip)) {
stop("Precip is missing")
return(NULL)
}
if (is.null(PotEvap)) {
stop("PotEvap is missing")
return(NULL)
}
if (!is.vector(Precip) | !is.vector(PotEvap)) {
stop("Precip and PotEvap must be vectors of numeric values")
return(NULL)
}
if (!is.numeric(Precip) | !is.numeric(PotEvap)) {
stop("Precip and PotEvap must be vectors of numeric values")
return(NULL)
}
if (length(Precip) != LLL | length(PotEvap) != LLL) {
stop("Precip, PotEvap and DatesR must have the same length")
return(NULL)
}
}
if ("CemaNeige" %in% ObjectClass) {
if (is.null(Precip)) {
stop("Precip is missing")
return(NULL)
}
if (is.null(TempMean)) {
stop("TempMean is missing")
return(NULL)
}
if (!is.vector(Precip) | !is.vector(TempMean)) {
stop("Precip and TempMean must be vectors of numeric values")
return(NULL)
}
if (!is.numeric(Precip) | !is.numeric(TempMean)) {
stop("Precip and TempMean must be vectors of numeric values")
return(NULL)
}
if (length(Precip) != LLL | length(TempMean) != LLL) {
stop("Precip, TempMean and DatesR must have the same length")
return(NULL)
}
if (is.null(TempMin) != is.null(TempMax)) {
stop("TempMin and TempMax must be both defined if not null")
return(NULL)
}
if (!is.null(TempMin) & !is.null(TempMax)) {
if (!is.vector(TempMin) | !is.vector(TempMax)) {
stop("TempMin and TempMax must be vectors of numeric values")
return(NULL)
}
if (!is.numeric(TempMin) | !is.numeric(TempMax)) {
stop("TempMin and TempMax must be vectors of numeric values")
return(NULL)
}
if (length(TempMin) != LLL | length(TempMax) != LLL) {
stop("TempMin, TempMax and DatesR must have the same length")
return(NULL)
}
}
if (!is.null(HypsoData)) {
if (!is.vector(HypsoData)) {
stop("HypsoData must be a vector of numeric values if not null")
return(NULL)
}
if (!is.numeric(HypsoData)) {
stop("HypsoData must be a vector of numeric values if not null")
return(NULL)
}
if (length(HypsoData) != 101) {
stop("HypsoData must be of length 101 if not null")
return(NULL)
}
if (sum(is.na(HypsoData)) != 0 & sum(is.na(HypsoData)) != 101) {
stop("HypsoData must not contain any NA if not null")
return(NULL)
}
}
if (!is.null(ZInputs)) {
if (length(ZInputs) != 1) {
stop("\t ZInputs must be a single numeric value if not null")
return(NULL)
}
if (is.na(ZInputs) | !is.numeric(ZInputs)) {
stop("\t ZInputs must be a single numeric value if not null")
return(NULL)
}
}
if (is.null(HypsoData)) {
......@@ -192,7 +167,6 @@ CreateInputsModel <- function(FUN_MOD,
}
if (NLayers <= 0) {
stop("NLayers must be a positive integer value")
return(NULL)
}
if (NLayers != as.integer(NLayers)) {
warning("Coerce NLayers to be of integer type (", NLayers, " => ", as.integer(NLayers), ")")
......@@ -260,7 +234,6 @@ CreateInputsModel <- function(FUN_MOD,
if (Select[1L] > Select[2L]) {
stop("Time series could not be trunced since missing values were detected at the list time-step")
return(NULL)
}
if ("GR" %in% ObjectClass) {
Precip <- Precip[Select]
......
R/CreateRunOptions.R
+ 0
− 39
View file @ eec01d4f
......@@ -38,60 +38,48 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
}
if (!BOOL) {
stop("incorrect 'FUN_MOD' for use in 'CreateRunOptions'")
return(NULL)
}
##check_InputsModel
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
return(NULL)
}
if ("GR" %in% ObjectClass & !inherits(InputsModel, "GR")) {
stop("'InputsModel' must be of class 'GR'")
return(NULL)
}
if ("CemaNeige" %in% ObjectClass &
!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
return(NULL)
}
if ("hourly" %in% ObjectClass &
!inherits(InputsModel, "hourly")) {
stop("'InputsModel' must be of class 'hourly'")
return(NULL)
}
if ("daily" %in% ObjectClass & !inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
return(NULL)
}
if ("monthly" %in% ObjectClass &
!inherits(InputsModel, "monthly")) {
stop("'InputsModel' must be of class 'monthly'")
return(NULL)
}
if ("yearly" %in% ObjectClass &
!inherits(InputsModel, "yearly")) {
stop("'InputsModel' must be of class 'yearly'")
return(NULL)
}
##check_IndPeriod_Run
if (!is.vector(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values")
return(NULL)
}
if (!is.numeric(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values")
return(NULL)
}
if (identical(as.integer(IndPeriod_Run), as.integer(seq(from = IndPeriod_Run[1], to = tail(IndPeriod_Run, 1), by = 1))) == FALSE) {
stop("'IndPeriod_Run' must be a continuous sequence of integers")
return(NULL)
}
if (storage.mode(IndPeriod_Run) != "integer") {
stop("'IndPeriod_Run' should be of type integer")
return(NULL)
}
......@@ -136,15 +124,12 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (!is.null(IndPeriod_WarmUp)) {
if (!is.vector(IndPeriod_WarmUp)) {
stop("'IndPeriod_WarmUp' must be a vector of numeric values")
return(NULL)
}
if (!is.numeric(IndPeriod_WarmUp)) {
stop("'IndPeriod_WarmUp' must be a vector of numeric values")
return(NULL)
}
if (storage.mode(IndPeriod_WarmUp) != "integer") {
stop("'IndPeriod_WarmUp' should be of type integer")
return(NULL)
}
if (identical(IndPeriod_WarmUp, as.integer(0)) & verbose) {
message(paste0(WTxt, "\t No warm up period is used \n"))
......@@ -163,7 +148,6 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (!is.null(IniResLevels)) {
if (!is.vector(IniResLevels) | !is.numeric(IniResLevels) | any(is.na(IniResLevels))) {
stop("'IniResLevels' must be a vector of numeric values")
return(NULL)
}
if ((identical(FUN_MOD, RunModel_GR4H) |
identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J) |
......@@ -171,12 +155,10 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
identical(FUN_MOD, RunModel_GR2M)) &
length(IniResLevels) != 2) {
stop("The length of 'IniResLevels' must be 2 for the chosen 'FUN_MOD'")
return(NULL)
}
if ((identical(FUN_MOD,RunModel_GR6J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)) &
length(IniResLevels) != 3) {
stop("The length of 'IniResLevels' must be 3 for the chosen 'FUN_MOD'")
return(NULL)
}
} else if (is.null(IniStates)) {
if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) {
......@@ -221,31 +203,24 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (!inherits(IniStates, "IniStates")) {
stop("'IniStates' must be an object of class 'IniStates'\n")
return(NULL)
}
if (sum(ObjectClass %in% class(IniStates)) < 2) {
stop(paste0("Non convenient 'IniStates' for this 'FUN_MOD'\n"))
return(NULL)
}
if (identical(FUN_MOD, RunModel_GR1A) & !is.null(IniStates)) { ## GR1A
stop(paste0("'IniStates' is not available for this 'FUN_MOD'\n"))
return(NULL)
}
if ((identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) & !all(is.na(IniStates$UH$UH1))) { ## GR5J
stop(paste0("Non convenient IniStates for this 'FUN_MOD.' In 'IniStates', UH1 has to be a vector of NA for GR5J"))
return(NULL)
}
if ((identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & is.na(IniStates$Store$Exp)) { ## GR6J
stop(paste0("Non convenient IniStates for this 'FUN_MOD.' GR6J needs an exponential store value in 'IniStates'"))
return(NULL)
}
if (!(identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) & !is.na(IniStates$Store$Exp)) { ## except GR6J
stop(paste0("Non convenient IniStates for this 'FUN_MOD.' No exponential store value needed in 'IniStates'"))
return(NULL)
}
# if (length(na.omit(unlist(IniStates))) != NState) {
# stop(paste0("The length of IniStates must be ", NState, " for the chosen FUN_MOD"))
# return(NULL)
# }
if (!"CemaNeige" %in% ObjectClass & any(is.na(IniStates$CemaNeigeLayers$G ))) {
IniStates$CemaNeigeLayers$G <- NULL
......@@ -293,15 +268,12 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
##check_Outputs_Sim
if (!is.vector(Outputs_Sim)) {
stop("Outputs_Sim must be a vector of characters")
return(NULL)
}
if (!is.character(Outputs_Sim)) {
stop("Outputs_Sim must be a vector of characters")
return(NULL)
}
if (sum(is.na(Outputs_Sim)) != 0) {
stop("Outputs_Sim must not contain NA")
return(NULL)
}
if ("all" %in% Outputs_Sim) {
Outputs_Sim <- c("DatesR", Outputs_all, "StateEnd")
......@@ -310,8 +282,6 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (length(Test) != 0) {
stop(paste0( "'Outputs_Sim' is incorrectly defined: ",
paste(Outputs_Sim[Test], collapse = ", "), " not found"))
return(NULL)
}
Outputs_Sim <- Outputs_Sim[!duplicated(Outputs_Sim)]
......@@ -331,15 +301,12 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
} else {
if (!is.vector(Outputs_Cal)) {
stop("'Outputs_Cal' must be a vector of characters")
return(NULL)
}
if (!is.character(Outputs_Cal)) {
stop("'Outputs_Cal' must be a vector of characters")
return(NULL)
}
if (sum(is.na(Outputs_Cal)) != 0) {
stop("'Outputs_Cal' must not contain NA")
return(NULL)
}
}
if ("all" %in% Outputs_Cal) {
......@@ -351,8 +318,6 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (length(Test) != 0) {
stop(paste0("'Outputs_Cal' is incorrectly defined: ",
paste(Outputs_Cal[Test], collapse = ", "), " not found"))
return(NULL)
}
Outputs_Cal <- Outputs_Cal[!duplicated(Outputs_Cal)]
Outputs_Calxxx <- unique(Outputs_Cal[!duplicated(Outputs_Cal)])
......@@ -388,7 +353,6 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
}
if (is.null(Factor)) {
stop("'InputsModel' must be of class 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
MeanAnSolidPrecip <- rep(mean(SolidPrecip) * Factor, NLayers)
### default value: same Gseuil for all layers
......@@ -401,15 +365,12 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if ("CemaNeige" %in% ObjectClass & !is.null(MeanAnSolidPrecip)) {
if (!is.vector(MeanAnSolidPrecip)) {
stop(paste0("'MeanAnSolidPrecip' must be a vector of numeric values"))
return(NULL)
}
if (!is.numeric(MeanAnSolidPrecip)) {
stop(paste0("'MeanAnSolidPrecip' must be a vector of numeric values"))
return(NULL)
}
if (length(MeanAnSolidPrecip) != NLayers) {
stop(paste0("'MeanAnSolidPrecip' must be a numeric vector of length ", NLayers, ""))
return(NULL)
}
}
......
R/ErrorCrit.R
+ 0
− 2
View file @ eec01d4f
......@@ -4,11 +4,9 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo
if (!inherits(InputsCrit, "InputsCrit")) {
stop("InputsCrit must be of class 'InputsCrit'")
return(NULL)
}
if (!inherits(OutputsModel, "OutputsModel")) {
stop("OutputsModel must be of class 'OutputsModel'")
return(NULL)
}
if (!missing(FUN_CRIT)) {
warning("argument 'FUN_CRIT' is deprecated. The error criterion function is now automatically get from the 'InputsCrit' object", call. = FALSE)
......
R/RunModel_CemaNeige.R
+ 0
− 9
View file @ eec01d4f
......@@ -4,7 +4,6 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param, IsHyst = FALSE) {
## Arguments_check
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a 'logical' of length 1")
return(NULL)
}
......@@ -17,31 +16,24 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param, IsHyst = FALSE) {
## Arguments_check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
return(NULL)
}
if (!inherits(InputsModel, "daily")) {
stop("'InputsModel' must be of class 'daily'")
return(NULL)
}
if (!inherits(InputsModel, "CemaNeige")) {
stop("'InputsModel' must be of class 'CemaNeige'")
return(NULL)
}
if (!inherits(RunOptions, "RunOptions")) {
stop("'RunOptions' must be of class 'RunOptions'")
return(NULL)
}
if (!inherits(RunOptions, "CemaNeige")) {
stop("'RunOptions' must be of class 'CemaNeige'")
return(NULL)
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
return(NULL)
}
if (sum(!is.na(Param)) != NParam) {
stop(sprintf("'Param' must be a vector of length %i and contain no NA", NParam))
return(NULL)
}
## Input_data_preparation
......@@ -63,7 +55,6 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param, IsHyst = FALSE) {
if (sum(is.na(ParamCemaNeige)) != 0) {
stop("Param contains missing values")
return(NULL)
}
if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputsCemaNeige <- 1:length(FortranOutputsCemaNeige)
......
R/RunModel_CemaNeigeGR4J.R
+ 9
− 10
View file @ eec01d4f
......@@ -4,7 +4,6 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param, IsHyst = FALSE)
## Arguments_check
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a 'logical' of length 1")
return(NULL)
}
NParam <- ifelse(IsHyst, 8L, 6L)
......@@ -13,15 +12,15 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param, IsHyst = FALSE)
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("RunOptions must be of class 'CemaNeige' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' ") }
if(inherits(RunOptions,"CemaNeige" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
Param_X1X3_threshold <- 1e-2
......
R/RunModel_CemaNeigeGR5J.R
+ 9
− 10
View file @ eec01d4f
......@@ -4,7 +4,6 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param, IsHyst = FALSE)
## Arguments_check
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a 'logical' of length 1")
return(NULL)
}
NParam <- ifelse(IsHyst, 9L, 7L)
......@@ -12,15 +11,15 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param, IsHyst = FALSE)
FortranOutputs <- .FortranOutputs(GR = "GR5J", isCN = TRUE)
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("RunOptions must be of class 'CemaNeige' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' ") }
if(inherits(RunOptions,"CemaNeige" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
Param_X1X3_threshold <- 1e-2
......
R/RunModel_CemaNeigeGR6J.R
+ 9
− 10
View file @ eec01d4f
......@@ -4,7 +4,6 @@ RunModel_CemaNeigeGR6J <- function(InputsModel,RunOptions,Param, IsHyst = FALSE)
## Arguments_check
if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
stop("'IsHyst' must be a 'logical' of length 1")
return(NULL)
}
NParam <- ifelse(IsHyst, 10L, 8L)
......@@ -12,15 +11,15 @@ RunModel_CemaNeigeGR6J <- function(InputsModel,RunOptions,Param, IsHyst = FALSE)
FortranOutputs <- .FortranOutputs(GR = "GR6J", isCN = TRUE)
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"CemaNeige" )==FALSE){ stop("RunOptions must be of class 'CemaNeige' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(InputsModel,"CemaNeige" )==FALSE){ stop("InputsModel must be of class 'CemaNeige' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' ") }
if(inherits(RunOptions,"CemaNeige" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
Param_X1X3X6_threshold <- 1e-2
......
R/RunModel_GR1A.R
+ 7
− 7
View file @ eec01d4f
......@@ -4,13 +4,13 @@ RunModel_GR1A <- function(InputsModel,RunOptions,Param){
FortranOutputs <- .FortranOutputs(GR = "GR1A")$GR
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"yearly" )==FALSE){ stop("InputsModel must be of class 'yearly' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"yearly" )==FALSE){ stop("InputsModel must be of class 'yearly' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
##Input_data_preparation
......
R/RunModel_GR2M.R
+ 7
− 7
View file @ eec01d4f
......@@ -4,13 +4,13 @@ RunModel_GR2M <- function(InputsModel,RunOptions,Param){
FortranOutputs <- .FortranOutputs(GR = "GR2M")$GR
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"monthly" )==FALSE){ stop("InputsModel must be of class 'monthly' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"monthly" )==FALSE){ stop("InputsModel must be of class 'monthly' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
Param_X1X2_threshold <- 1e-2
......
R/RunModel_GR4H.R
+ 7
− 7
View file @ eec01d4f
......@@ -4,13 +4,13 @@ RunModel_GR4H <- function(InputsModel,RunOptions,Param){
FortranOutputs <- .FortranOutputs(GR = "GR4H")$GR
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"hourly" )==FALSE){ stop("InputsModel must be of class 'hourly' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"hourly" )==FALSE){ stop("InputsModel must be of class 'hourly' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
Param_X1X3_threshold <- 1e-2
......
R/RunModel_GR4J.R
+ 7
− 7
View file @ eec01d4f
......@@ -4,13 +4,13 @@ RunModel_GR4J <- function(InputsModel,RunOptions,Param){
FortranOutputs <- .FortranOutputs(GR = "GR4J")$GR
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
Param_X1X3_threshold <- 1e-2
......
R/RunModel_GR5J.R
+ 7
− 7
View file @ eec01d4f
......@@ -4,13 +4,13 @@ RunModel_GR5J <- function(InputsModel,RunOptions,Param){
FortranOutputs <- .FortranOutputs(GR = "GR5J")$GR
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
Param_X1X3_threshold <- 1e-2
......
R/RunModel_GR6J.R
+ 7
− 7
View file @ eec01d4f
......@@ -4,13 +4,13 @@ RunModel_GR6J <- function(InputsModel,RunOptions,Param){
FortranOutputs <- .FortranOutputs(GR = "GR6J")$GR
##Arguments_check
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'"); return(NULL); }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' "); return(NULL); }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' "); return(NULL); }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' "); return(NULL); }
if(inherits(RunOptions,"GR" )==FALSE){ stop("RunOptions must be of class 'GR' "); return(NULL); }
if(!is.vector(Param) | !is.numeric(Param)){ stop("Param must be a numeric vector"); return(NULL); }
if(sum(!is.na(Param))!=NParam){ stop(paste("Param must be a vector of length ",NParam," and contain no NA",sep="")); return(NULL); }
if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel'") }
if(inherits(InputsModel,"daily" )==FALSE){ stop("InputsModel must be of class 'daily' ") }
if(inherits(InputsModel,"GR" )==FALSE){ stop("InputsModel must be of class 'GR' ") }
if(inherits(RunOptions,"RunOptions" )==FALSE){ stop("RunOptions must be of class 'RunOptions' ") }
if(inherits(RunOptions,"GR" )==FALSE){ 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",sep="")) }
Param <- as.double(Param);
Param_X1X3X6_threshold <- 1e-2
......
R/SeriesAggreg.R
+ 0
− 29
View file @ eec01d4f
......@@ -10,20 +10,16 @@ SeriesAggreg <- function(TabSeries,
##check_TabSeries
if (is.null(TabSeries) ) {
stop("TabSeries must be a dataframe containing the dates and data to be converted")
return(NULL)
}
if (!is.data.frame(TabSeries)) {
stop("TabSeries must be a dataframe containing the dates and data to be converted")
return(NULL)
}
if (ncol(TabSeries) < 2) {
stop("TabSeries must contain at least two columns (including the coulmn of dates")
return(NULL)
}
##check_TimeFormat
if (!any(class(TabSeries[, 1]) %in% "POSIXt")) {
stop("TabSeries first column must be a vector of class POSIXlt or POSIXct")
return(NULL)
}
if (any(class(TabSeries[, 1]) %in% "POSIXlt")) {
TabSeries[, 1] <- as.POSIXct(TabSeries[, 1])
......@@ -31,96 +27,73 @@ SeriesAggreg <- function(TabSeries,
for (iCol in 2:ncol(TabSeries)) {
if (!is.numeric(TabSeries[,iCol])) {
stop("TabSeries columns (other than the first one) be of numeric class")
return(NULL)
}
}
if (is.null(TimeFormat)) {
stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
if (!is.vector(TimeFormat)) {
stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
if (!is.character(TimeFormat)) {
stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
if (length(TimeFormat) != 1) {
stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
if (! TimeFormat %in% c("hourly", "daily", "monthly", "yearly")) {
stop("TimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
##check_NewTimeFormat
if (is.null(NewTimeFormat)) {
stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
if (!is.vector(NewTimeFormat)) {
stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
if (!is.character(NewTimeFormat)) {
stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
if (length(NewTimeFormat) != 1) {
stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
if (! NewTimeFormat %in% c("hourly", "daily", "monthly", "yearly")) {
stop("NewTimeFormat must be 'hourly', 'daily', 'monthly' or 'yearly'")
return(NULL)
}
##check_ConvertFun
if (is.null(ConvertFun)) {
stop("ConvertFun must be a vector of character")
return(NULL)
}
if (!is.vector(ConvertFun)) {
stop("ConvertFun must be a vector of character")
return(NULL)
}
if (!is.character(ConvertFun)) {
stop("ConvertFun must be a vector of character")
return(NULL)
}
if (length(ConvertFun) != (ncol(TabSeries) - 1)) {
stop(
paste("ConvertFun must be of length", ncol(TabSeries) - 1, "(length=ncol(TabSeries)-1)")
)
return(NULL)
}
if (sum(ConvertFun %in% c("sum", "mean") == FALSE) != 0) {
stop("ConvertFun elements must be either 'sum' or 'mean'")
return(NULL)
}
##check_YearFirstMonth
if (is.null(YearFirstMonth)) {
stop("YearFirstMonth must be an integer between 1 and 12")
return(NULL)
}
if (!is.vector(YearFirstMonth)) {
stop("YearFirstMonth must be an integer between 1 and 12")
return(NULL)
}
if (!is.numeric(YearFirstMonth)) {
stop("YearFirstMonth must be an integer between 1 and 12")
return(NULL)
}
YearFirstMonth <- as.integer(YearFirstMonth)
if (length(YearFirstMonth) != 1) {
stop("YearFirstMonth must be only one integer between 1 and 12")
return(NULL)
}
if (YearFirstMonth %in% (1:12) == FALSE) {
stop("YearFirstMonth must be only one integer between 1 and 12")
return(NULL)
}
##check_DatesR_integrity
if (TimeFormat == "hourly") {
......@@ -138,14 +111,12 @@ SeriesAggreg <- function(TabSeries,
TmpDatesR <- seq(from = TabSeries[1, 1], to = tail(TabSeries[, 1], 1), by = by)
if (!identical(TabSeries[, 1], TmpDatesR)) {
stop("Some dates might not be ordered or are missing in TabSeries")
return(NULL)
}
##check_conversion_direction
if ((TimeFormat == "daily" & NewTimeFormat %in% c("hourly") ) |
(TimeFormat == "monthly" & NewTimeFormat %in% c("hourly","daily") ) |
(TimeFormat == "yearly" & NewTimeFormat %in% c("hourly","daily","monthly"))) {
stop("Only time aggregation can be performed")
return(NULL)
}
##check_if_conversion_not_needed
if ((TimeFormat == "hourly" & NewTimeFormat == "hourly" ) |
......
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