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

v1.2.11.7 CLEAN: remove == TRUE or == FALSE tests in many functions

parent 01696b82
dev 115-add-pcict-date-format-managment 118-plot-outputsmodel-remove-case-sensitivity-to-the-which-argument 136-decreased-performance-of-calibration-execution-time 60-migrate-transfoparam-functions-and-createcaliboptions-to-s3-methods 96-parallelize-the-grid-screening-step-during-calibration airGRplus cleanAirGRplus master 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 36 additions and 36 deletions
+36 -36
DESCRIPTION
+ 1
− 1
View file @ 1132f2b1
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.2.11.6
Version: 1.2.11.7
Date: 2019-03-23
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
NEWS.rmd
+ 1
− 1
View file @ 1132f2b1
......@@ -13,7 +13,7 @@ output:
### 1.2.11.6 Release Notes (2019-03-23)
### 1.2.11.7 Release Notes (2019-03-23)
......
R/Calibration_Michel.R
+ 6
− 6
View file @ 1132f2b1
......@@ -100,14 +100,14 @@ Calibration_Michel <- function(InputsModel,
if (inherits(CalibOptions, "hysteresis")) {
FUN_TRANSFO <- function(ParamIn, Direction) {
Bool <- is.matrix(ParamIn)
if (Bool == FALSE) {
if (!Bool) {
ParamIn <- rbind(ParamIn)
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
ParamOut[, 1:(NParam-4)] <- FUN1(ParamIn[, 1:(NParam-4)], Direction)
ParamOut[, (NParam-3):NParam ] <- FUN2(ParamIn[, (NParam-3):NParam ], Direction)
if (Bool == FALSE) {
if (!Bool) {
ParamOut <- ParamOut[1, ]
}
return(ParamOut)
......@@ -115,14 +115,14 @@ Calibration_Michel <- function(InputsModel,
} else {
FUN_TRANSFO <- function(ParamIn, Direction) {
Bool <- is.matrix(ParamIn)
if (Bool == FALSE) {
if (!Bool) {
ParamIn <- rbind(ParamIn)
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
ParamOut[, 1:(NParam-2)] <- FUN1(ParamIn[, 1:(NParam-2)], Direction)
ParamOut[, (NParam-1):NParam ] <- FUN2(ParamIn[, (NParam-1):NParam ], Direction)
if (Bool == FALSE) {
if (!Bool) {
ParamOut <- ParamOut[1, ]
}
return(ParamOut)
......@@ -273,7 +273,7 @@ Calibration_Michel <- function(InputsModel,
##Definition_of_the_function_creating_new_parameter_sets_through_a_step_by_step_progression_procedure
ProposeCandidatesLoc <- function(NewParamOptimT, OldParamOptimT, RangesT, OptimParam,Pace) {
ProposeCandidatesLoc <- function(NewParamOptimT, OldParamOptimT, RangesT, OptimParam, Pace) {
##Format_checking
if (nrow(NewParamOptimT) != 1 | nrow(OldParamOptimT) != 1) {
stop("each input set must be a matrix of one single line")
......@@ -286,7 +286,7 @@ Calibration_Michel <- function(InputsModel,
VECT <- NULL
for (I in 1:NParam) {
##We_check_that_the_current_parameter_should_indeed_be_optimised
if (OptimParam[I] == TRUE) {
if (OptimParam[I]) {
for (J in 1:2) {
Sign <- 2 * J - 3 #Sign can be equal to -1 or +1
##We_define_the_new_potential_candidate
......
R/CreateCalibOptions.R
+ 4
− 4
View file @ 1132f2b1
......@@ -129,14 +129,14 @@ CreateCalibOptions <- function(FUN_MOD,
if (IsHyst) {
FUN_TRANSFO <- function(ParamIn, Direction) {
Bool <- is.matrix(ParamIn)
if (Bool == FALSE) {
if (!Bool) {
ParamIn <- rbind(ParamIn)
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
ParamOut[, 1:(NParam - 4)] <- FUN1(ParamIn[, 1:(NParam - 4)], Direction)
ParamOut[, (NParam - 3):NParam] <- FUN2(ParamIn[, (NParam - 3):NParam], Direction)
if (Bool == FALSE) {
if (!Bool) {
ParamOut <- ParamOut[1, ]
}
return(ParamOut)
......@@ -144,7 +144,7 @@ CreateCalibOptions <- function(FUN_MOD,
} else {
FUN_TRANSFO <- function(ParamIn, Direction) {
Bool <- is.matrix(ParamIn)
if (Bool == FALSE) {
if (!Bool) {
ParamIn <- rbind(ParamIn)
}
ParamOut <- NA * ParamIn
......@@ -155,7 +155,7 @@ CreateCalibOptions <- function(FUN_MOD,
ParamOut[, 1:(NParam - 2)] <- FUN1(ParamIn[, 1:(NParam - 2)], Direction)
}
ParamOut[, (NParam - 1):NParam] <- FUN2(ParamIn[, (NParam - 1):NParam], Direction)
if (Bool == FALSE) {
if (!Bool) {
ParamOut <- ParamOut[1, ]
}
return(ParamOut)
......
R/CreateInputsModel.R
+ 3
− 3
View file @ 1132f2b1
......@@ -68,13 +68,13 @@ CreateInputsModel <- function(FUN_MOD,
if (is.null(DatesR)) {
stop("DatesR is missing")
}
if ("POSIXlt" %in% class(DatesR) == FALSE & "POSIXct" %in% class(DatesR) == FALSE) {
if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) {
stop("DatesR must be defined as POSIXlt or POSIXct")
}
if ("POSIXlt" %in% class(DatesR) == FALSE) {
if (!"POSIXlt" %in% class(DatesR)) {
DatesR <- as.POSIXlt(DatesR)
}
if (difftime(tail(DatesR, 1), tail(DatesR, 2), units = "secs")[[1]] %in% TimeStep == FALSE) {
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"))
}
......
R/CreateRunOptions.R
+ 7
− 7
View file @ 1132f2b1
......@@ -15,7 +15,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
FUN_MOD <- match.fun(FUN_MOD)
##check_FUN_MOD
BOOL <- FALSE;
BOOL <- FALSE
if (identical(FUN_MOD, RunModel_GR4H)) {
ObjectClass <- c(ObjectClass, "GR", "hourly")
BOOL <- TRUE
......@@ -82,7 +82,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (!is.numeric(IndPeriod_Run)) {
stop("'IndPeriod_Run' must be a vector of numeric values")
}
if (identical(as.integer(IndPeriod_Run), as.integer(seq(from = IndPeriod_Run[1], to = tail(IndPeriod_Run, 1), by = 1))) == FALSE) {
if (!identical(as.integer(IndPeriod_Run), as.integer(seq(from = IndPeriod_Run[1], to = tail(IndPeriod_Run, 1), by = 1)))) {
stop("'IndPeriod_Run' must be a continuous sequence of integers")
}
if (storage.mode(IndPeriod_Run) != "integer") {
......@@ -95,7 +95,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if (is.null(IndPeriod_WarmUp)) {
WTxt <- paste0(WTxt,"\t Model warm up period not defined -> default configuration used")
##If_the_run_period_starts_at_the_very_beginning_of_the_time_series
if (IndPeriod_Run[1] == as.integer(1)) {
if (IndPeriod_Run[1L] == 1L) {
IndPeriod_WarmUp <- as.integer(0)
WTxt <- paste0(WTxt,"\t No data were found for model warm up!")
##We_look_for_the_longest_period_preceeding_the_run_period_with_a_maximum_of_one_year
......@@ -285,7 +285,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
if ("all" %in% Outputs_Sim) {
Outputs_Sim <- c("DatesR", Outputs_all, "StateEnd")
}
Test <- which(Outputs_Sim %in% c("DatesR", Outputs_all, "StateEnd") == FALSE)
Test <- which(!Outputs_Sim %in% c("DatesR", Outputs_all, "StateEnd"))
if (length(Test) != 0) {
stop(paste0( "'Outputs_Sim' is incorrectly defined: ",
paste(Outputs_Sim[Test], collapse = ", "), " not found"))
......@@ -320,7 +320,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
Outputs_Cal <- c("DatesR", Outputs_all, "StateEnd")
}
Test <- which(Outputs_Cal %in% c("DatesR", Outputs_all, "StateEnd") == FALSE)
Test <- which(!Outputs_Cal %in% c("DatesR", Outputs_all, "StateEnd"))
if (length(Test) != 0) {
stop(paste0("'Outputs_Cal' is incorrectly defined: ",
paste(Outputs_Cal[Test], collapse = ", "), " not found"))
......@@ -380,7 +380,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
##check_PliqAndMelt
if ("GR" %in% ObjectClass & "CemaNeige" %in% ObjectClass) {
if ("PliqAndMelt" %in% Outputs_Cal == FALSE & "all" %in% Outputs_Cal == FALSE) {
if (!"PliqAndMelt" %in% Outputs_Cal & !"all" %in% Outputs_Cal) {
WTxt <- NULL
WTxt <- paste0(WTxt, "\t 'PliqAndMelt' was not defined in 'Outputs_Cal' but is needed to feed the hydrological model with the snow modele outputs \n")
WTxt <- paste0(WTxt, "\t -> it was automatically added \n")
......@@ -389,7 +389,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel, IndPeriod_WarmUp = NULL, IndP
}
Outputs_Cal <- c(Outputs_Cal, "PliqAndMelt")
}
if ("PliqAndMelt" %in% Outputs_Sim == FALSE & "all" %in% Outputs_Sim == FALSE) {
if (!"PliqAndMelt" %in% Outputs_Sim & !"all" %in% Outputs_Sim) {
WTxt <- NULL
WTxt <- paste0(WTxt, "\t 'PliqAndMelt' was not defined in 'Outputs_Sim' but is needed to feed the hydrological model with the snow modele outputs \n")
WTxt <- paste0(WTxt, "\t -> it was automatically added \n")
......
R/RunModel_CemaNeigeGR4J.R
+ 14
− 14
View file @ 1132f2b1
......@@ -9,13 +9,13 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
##Arguments_check
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(!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",sep="")) }
Param <- as.double(Param);
......@@ -50,7 +50,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
##SNOW_MODULE________________________________________________________________________________##
if(inherits(RunOptions,"CemaNeige")==TRUE){
if(inherits(RunOptions,"CemaNeige")){
if("all" %in% RunOptions$Outputs_Sim){ IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN));
} else { IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim); }
CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers";
......@@ -91,7 +91,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
} ###ENDFOR_iLayer
names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers))
} ###ENDIF_RunSnowModule
if(inherits(RunOptions,"CemaNeige")==FALSE){
if(!inherits(RunOptions,"CemaNeige")){
CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL;
CatchMeltAndPliq <- InputsModel$Precip[IndPeriod1]; }
......@@ -137,28 +137,28 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
verbose = FALSE)
}
if(inherits(RunOptions,"CemaNeige")==TRUE & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; }
if(inherits(RunOptions,"CemaNeige") & "Precip" %in% RunOptions$Outputs_Sim){ RESULTS$Outputs[,which(FortranOutputs$GR[IndOutputsMod]=="Precip")] <- InputsModel$Precip[IndPeriod1]; }
##Output_data_preparation
##OutputsModel_only
if(ExportDatesR==FALSE & ExportStateEnd==FALSE){
if(!ExportDatesR & !ExportStateEnd){
OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
list(CemaNeigeLayers) );
names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
##DatesR_and_OutputsModel_only
if(ExportDatesR==TRUE & ExportStateEnd==FALSE){
if( ExportDatesR & !ExportStateEnd){
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
list(CemaNeigeLayers) );
names(OutputsModel) <- c("DatesR",FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers); }
##OutputsModel_and_SateEnd_only
if(ExportDatesR==FALSE & ExportStateEnd==TRUE){
if(!ExportDatesR & ExportStateEnd){
OutputsModel <- c( lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
list(CemaNeigeLayers),
list(RESULTS$StateEnd) );
names(OutputsModel) <- c(FortranOutputs$GR[IndOutputsMod],NameCemaNeigeLayers,"StateEnd"); }
##DatesR_and_OutputsModel_and_SateEnd
if(ExportDatesR==TRUE & ExportStateEnd==TRUE){
if( ExportDatesR & ExportStateEnd){
OutputsModel <- c( list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2,i]),
list(CemaNeigeLayers),
......
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