Merge branch 'dev' into '122-review-the-x-axis-management-of-the-plot-outputsmodel'

# Conflicts:
#   R/plot.OutputsModel.R

.Rbuildignore

@@ -9,3 +9,5 @@
 ^\.vscode$
 ^Rplots\.pdf$
 ^ci$
+^data-raw$
+^revdep$

.gitignore

@@ -12,6 +12,8 @@ packrat/lib*/
 *.pdf
 !man/figures/*.pdf
 
+# revdep
+/revdep/
 
 ######################################################################################################
 ### Generic .gitignore for R (source: https://github.com/github/gitignore/blob/master/R.gitignore) ###

.gitlab-ci.yml

 stages:
   - check
-  - regression
+  - scheduled_tests
   - revdepcheck
 
 default:
@@ -10,13 +10,14 @@ default:
     - PATH=~/R/sources/R-${R_VERSION}/bin:$PATH
     - R -e 'remotes::install_deps(dep = TRUE)'
 
-.regression:
-  stage: regression
+.scheduled_tests:
+  stage: scheduled_tests
   script:
-    - Rscript tests/testthat/regression_tests.R stable
+    - Rscript tests/scheduled_tests/scheduled.R
+    - Rscript tests/scheduled_tests/regression.R stable
     - R CMD INSTALL .
-    - Rscript tests/testthat/regression_tests.R dev
-    - Rscript tests/testthat/regression_tests.R compare
+    - Rscript tests/scheduled_tests/regression.R dev
+    - Rscript tests/scheduled_tests/regression.R compare
 
 .check:
   stage: check
@@ -33,26 +34,31 @@ default:
     NOT_CRAN: "false"
   extends: .check
 
-regression_patched:
+scheduled_tests_patched:
+  only:
+    refs:
+      - dev
+      - master
+      - schedules
   variables:
     R_VERSION: "patched"
-  extends: .regression
+  extends: .scheduled_tests
 
-regression_devel:
+scheduled_tests_devel:
   only:
     refs:
       - schedules
   variables:
     R_VERSION: "devel"
-  extends: .regression
+  extends: .scheduled_tests
 
-regression_oldrel:
+scheduled_tests_oldrel:
   only:
     refs:
       - schedules
   variables:
     R_VERSION: "oldrel"
-  extends: .regression
+  extends: .scheduled_tests
 
 check_not_cran_patched:
   variables:

.regressionignore

@@ -4,3 +4,62 @@
 # ignored variable : [Topic]<SPACE>[Variable].
 # Example for ignoring OutputsModel variable produced by example("RunModel_GR2M"): RunModel_GR2M OutputsModel
 
+Calibration_Michel RunOptions
+Calibration RunOptions
+CreateCalibOptions RunOptions
+CreateIniStates RunOptions
+CreateInputsCrit RunOptions
+CreateInputsModel RunOptions
+CreateRunOptions RunOptions
+ErrorCrit_KGE RunOptions
+ErrorCrit_KGE2 RunOptions
+ErrorCrit_NSE RunOptions
+ErrorCrit_RMSE RunOptions
+ErrorCrit RunOptions
+Imax RunOptions
+Param_Sets_GR4J RunOptions_Cal
+Param_Sets_GR4J RunOptions_Val
+RunModel_CemaNeige RunOptions
+RunModel_CemaNeigeGR4J RunOptions
+RunModel_CemaNeigeGR5J RunOptions
+RunModel_CemaNeigeGR6J RunOptions
+RunModel_GR1A RunOptions
+RunModel_GR2M RunOptions
+RunModel_GR4H RunOptions
+RunModel_GR4J RunOptions
+RunModel_GR5H RunOptions
+RunModel_GR5J RunOptions
+RunModel_GR6J RunOptions
+RunModel_Lag RunOptions
+RunModel RunOptions
+SeriesAggreg RunOptions
+Calibration OutputsModel
+Calibration_Michel OutputsModel
+CreateCalibOptions OutputsModel
+CreateIniStates OutputsModel
+CreateInputsCrit OutputsModel
+CreateInputsModel OutputsModel
+CreateRunOptions OutputsModel
+ErrorCrit OutputsModel
+ErrorCrit_KGE OutputsModel
+ErrorCrit_KGE2 OutputsModel
+ErrorCrit_NSE OutputsModel
+ErrorCrit_RMSE OutputsModel
+Imax OutputsModel
+RunModel OutputsModel
+RunModel_CemaNeige OutputsModel
+RunModel_CemaNeigeGR4J OutputsModel
+RunModel_CemaNeigeGR5J OutputsModel
+RunModel_CemaNeigeGR6J OutputsModel
+RunModel_GR1A OutputsModel
+RunModel_GR2M OutputsModel
+RunModel_GR4H OutputsModel
+RunModel_GR4J OutputsModel
+RunModel_GR5H OutputsModel
+RunModel_GR5J OutputsModel
+RunModel_GR6J OutputsModel
+RunModel_Lag OutputsModel
+SeriesAggreg OutputsModel
+Param_Sets_GR4J OutputsModel_Val
+RunModel_Lag OutputsModelDown
+SeriesAggreg SimulatedMonthlyRegime

R/Calibration_Michel.R

@@ -17,7 +17,7 @@ Calibration_Michel <- function(InputsModel,
   # Handling 'FUN_TRANSFO' from direct argument or provided by 'CaliOptions'
   if (!is.null(FUN_TRANSFO)) {
     FUN_TRANSFO <- match.fun(FUN_TRANSFO)
-  } else if(!is.null(CalibOptions$FUN_TRANSFO)) {
+  } else if (!is.null(CalibOptions$FUN_TRANSFO)) {
     FUN_TRANSFO <- CalibOptions$FUN_TRANSFO
   } else {
     stop("'FUN_TRANSFO' is not provided neither as 'FUN_TRANSFO' argument or in 'CaliOptions' argument")

R/CreateCalibOptions.R

@@ -12,7 +12,7 @@ CreateCalibOptions <- function(FUN_MOD,
 
   FUN_MOD     <- match.fun(FUN_MOD)
   FUN_CALIB   <- match.fun(FUN_CALIB)
-  if(!is.null(FUN_TRANSFO)) {
+  if (!is.null(FUN_TRANSFO)) {
     FUN_TRANSFO <- match.fun(FUN_TRANSFO)
   }
   if (!is.logical(IsHyst) | length(IsHyst) != 1L) {

R/CreateIniStates.R

@@ -153,19 +153,19 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
     }
     UH2 <- rep(Inf, UH2n)
   }
-  if(IsIntStore & is.null(IntStore)) {
+  if (IsIntStore & is.null(IntStore)) {
       stop(sprintf("'%s' need values for 'IntStore'", nameFUN_MOD))
   }
-  if("CemaNeige" %in% ObjectClass & !IsHyst &
+  if ("CemaNeige" %in% ObjectClass & !IsHyst &
      (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers))) {
       stop(sprintf("'%s' need values for 'GCemaNeigeLayers' and 'GCemaNeigeLayers'", nameFUN_MOD))
   }
-  if("CemaNeige" %in% ObjectClass & IsHyst &
+  if ("CemaNeige" %in% ObjectClass & IsHyst &
      (is.null(GCemaNeigeLayers) | is.null(eTGCemaNeigeLayers) |
       is.null(GthrCemaNeigeLayers) | is.null(GlocmaxCemaNeigeLayers))) {
     stop(sprintf("'%s' need values for 'GCemaNeigeLayers', 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'", nameFUN_MOD))
   }
-  if("CemaNeige" %in% ObjectClass & !IsHyst &
+  if ("CemaNeige" %in% ObjectClass & !IsHyst &
      (!is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
     if (verbose) {
       warning(sprintf("'%s' does not require 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD))
@@ -173,7 +173,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
     GthrCemaNeigeLayers    <- Inf
     GlocmaxCemaNeigeLayers <- Inf
   }
-  if(!"CemaNeige" %in% ObjectClass &
+  if (!"CemaNeige" %in% ObjectClass &
      (!is.null(GCemaNeigeLayers) | !is.null(eTGCemaNeigeLayers) | !is.null(GthrCemaNeigeLayers) | !is.null(GlocmaxCemaNeigeLayers))) {
     if (verbose) {
       warning(sprintf("'%s' does not require 'GCemaNeigeLayers' 'GCemaNeigeLayers', 'GthrCemaNeigeLayers' and 'GlocmaxCemaNeigeLayers'. Values set to NA", nameFUN_MOD))
@@ -186,7 +186,7 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
 
 
   ## set states
-  if("CemaNeige" %in% ObjectClass) {
+  if ("CemaNeige" %in% ObjectClass) {
     NLayers <- length(InputsModel$LayerPrecip)
   } else {
     NLayers <- 1
@@ -284,17 +284,17 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
   }
 
   # SD model state handling
-  if(!is.null(SD)) {
-    if(!inherits(InputsModel, "SD")) {
+  if (!is.null(SD)) {
+    if (!inherits(InputsModel, "SD")) {
       stop("'SD' argument provided and 'InputsModel' is not of class 'SD'")
     }
-    if(!is.list(SD)) {
+    if (!is.list(SD)) {
       stop("'SD' argument must be a list")
     }
     lapply(SD, function(x) {
-      if(!is.numeric(x)) stop("Each item of 'SD' list argument must be numeric")
+      if (!is.numeric(x)) stop("Each item of 'SD' list argument must be numeric")
     })
-    if(length(SD) != length(InputsModel$LengthHydro)) {
+    if (length(SD) != length(InputsModel$LengthHydro)) {
       stop("Number of items of 'SD' list argument must be the same as the number of upstream connections",
            sprintf(" (%i required, found %i)", length(InputsModel$LengthHydro), length(SD)))
     }
@@ -309,15 +309,15 @@ CreateIniStates <- function(FUN_MOD, InputsModel, IsHyst = FALSE, IsIntStore = F
   IniStatesNA[is.infinite(IniStatesNA)] <- NA
   IniStatesNA <- relist(IniStatesNA, skeleton = IniStates)
 
-  if(!is.null(SD)) {
+  if (!is.null(SD)) {
     IniStatesNA$SD <- SD
   }
 
   class(IniStatesNA) <- c("IniStates", ObjectClass)
-  if(IsHyst) {
+  if (IsHyst) {
     class(IniStatesNA) <- c(class(IniStatesNA), "hysteresis")
   }
-  if(IsIntStore) {
+  if (IsIntStore) {
     class(IniStatesNA) <- c(class(IniStatesNA), "interception")
   }
 

R/CreateInputsCrit.R

@@ -293,7 +293,7 @@ CreateInputsCrit <- function(FUN_CRIT,
   listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs")
   inCnVarObs <- c("SCA", "SWE")
   if (!"ZLayers" %in% names(InputsModel)) {
-    if(any(listVarObs %in% inCnVarObs)) {
+    if (any(listVarObs %in% inCnVarObs)) {
       stop(sprintf("'VarObs' can not be equal to %i if CemaNeige is not used",
                    paste(sapply(inCnVarObs, shQuote), collapse = " or ")))
     }
@@ -348,7 +348,7 @@ CreateInputsCrit <- function(FUN_CRIT,
     combInputsCrit <- combn(x = length(InputsCrit), m = 2)
     apply(combInputsCrit, MARGIN = 2, function(i) {
       equalInputsCrit <- identical(InputsCrit[[i[1]]], InputsCrit[[i[2]]])
-      if(equalInputsCrit) {
+      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)
       }
     })

R/CreateInputsModel.R

@@ -153,10 +153,10 @@ CreateInputsModel <- function(FUN_MOD,
     if (nrow(Qupstream) != LLL) {
       stop("'Qupstream' must have same number of rows as 'DatesR' length")
     }
-    if(any(is.na(Qupstream))) {
+    if (any(is.na(Qupstream))) {
       warning("'Qupstream' contains NA values: model outputs will contain NAs")
     }
-    if(any(LengthHydro > 1000)) {
+    if (any(LengthHydro > 1000)) {
       warning("The unit of 'LengthHydro' has changed from m to km in airGR >= 1.6.12: values superior to 1000 km seem unrealistic")
     }
     QupstrUnit <- tolower(QupstrUnit)

R/CreateRunOptions.R

@@ -24,12 +24,17 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
   ObjectClass <- FeatFUN_MOD$Class
   TimeStepMean <- FeatFUN_MOD$TimeStepMean
 
+  ## Model output variable list
+  FortranOutputs <- .FortranOutputs(GR = FeatFUN_MOD$CodeModHydro,
+                                    isCN = "CemaNeige" %in% FeatFUN_MOD$Class)
+
   ## manage class
   if (IsIntStore) {
     ObjectClass <- c(ObjectClass, "interception")
   }
   if (IsHyst) {
     ObjectClass <- c(ObjectClass, "hysteresis")
+    FeatFUN_MOD$NbParam <- FeatFUN_MOD$NbParam + 2
   }
 
   if (!"CemaNeige" %in% ObjectClass & "hysteresis" %in% ObjectClass) {
@@ -290,31 +295,7 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
   ##check_Outputs_Cal_and_Sim
 
   ##Outputs_all
-  Outputs_all <- NULL
-  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)) {
-    Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5H")$GR)
-  }
-  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)) {
-    Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR5J")$GR)
-  }
-  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)) {
-    Outputs_all <- c(Outputs_all, .FortranOutputs(GR = "GR2M")$GR)
-  }
-  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)
-  }
+  Outputs_all <- c("DatesR", unlist(FortranOutputs), "WarmUpQsim", "StateEnd")
 
   ##check_Outputs_Sim
   if (!is.vector(Outputs_Sim)) {
@@ -327,9 +308,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
     stop("'Outputs_Sim' must not contain NA")
   }
   if ("all" %in% Outputs_Sim) {
-    Outputs_Sim <- c("DatesR", Outputs_all, "StateEnd")
+    Outputs_Sim <- Outputs_all
   }
-  Test <- which(!Outputs_Sim %in% c("DatesR", Outputs_all, "StateEnd"))
+  Test <- which(!Outputs_Sim %in% Outputs_all)
   if (length(Test) != 0) {
     stop(paste0( "'Outputs_Sim' is incorrectly defined: ",
                  paste(Outputs_Sim[Test], collapse = ", "), " not found"))
@@ -361,10 +342,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
     }
   }
   if ("all" %in% Outputs_Cal) {
-    Outputs_Cal <- c("DatesR", Outputs_all, "StateEnd")
-
+    Outputs_Cal <- Outputs_all
   }
-  Test <- which(!Outputs_Cal %in% c("DatesR", Outputs_all, "StateEnd"))
+  Test <- which(!Outputs_Cal %in% Outputs_all)
   if (length(Test) != 0) {
     stop(paste0("'Outputs_Cal' is incorrectly defined: ",
                 paste(Outputs_Cal[Test], collapse = ", "), " not found"))
@@ -473,7 +453,9 @@ CreateRunOptions <- function(FUN_MOD, InputsModel,
                      IniStates = IniStates,
                      IniResLevels = IniResLevels,
                      Outputs_Cal = Outputs_Cal,
-                     Outputs_Sim = Outputs_Sim)
+                     Outputs_Sim = Outputs_Sim,
+                     FortranOutputs = FortranOutputs,
+                     FeatFUN_MOD = FeatFUN_MOD)
 
   if ("CemaNeige" %in% ObjectClass) {
     RunOptions <- c(RunOptions, list(MeanAnSolidPrecip = MeanAnSolidPrecip))

R/RunModel_CemaNeige.R

@@ -148,7 +148,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
   
   ## End
   class(OutputsModel) <- c("OutputsModel", time_step, "CemaNeige")
-  if(IsHyst) {
+  if (IsHyst) {
     class(OutputsModel) <- c(class(OutputsModel), "hysteresis")
   }
   return(OutputsModel)

R/RunModel_CemaNeigeGR4H.R

@@ -3,40 +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
-  FortranOutputs <- .FortranOutputs(GR = "GR4H", isCN = TRUE)
 
 
-  ## 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)
 
 
@@ -76,9 +48,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
   ## CemaNeige________________________________________________________________________________
   if (inherits(RunOptions, "CemaNeige")) {
     if ("all" %in% RunOptions$Outputs_Sim) {
-      IndOutputsCemaNeige <- as.integer(1:length(FortranOutputs$CN))
+      IndOutputsCemaNeige <- as.integer(1:length(RunOptions$FortranOutputs$CN))
     } else {
-      IndOutputsCemaNeige <- which(FortranOutputs$CN %in% RunOptions$Outputs_Sim)
+      IndOutputsCemaNeige <- which(RunOptions$FortranOutputs$CN %in% RunOptions$Outputs_Sim)
     }
     CemaNeigeLayers <- list()
     CemaNeigeStateEnd <- NULL
@@ -116,7 +88,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
 
       ## Data storage
       CemaNeigeLayers[[iLayer]] <- lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])
-      names(CemaNeigeLayers[[iLayer]]) <- FortranOutputs$CN[IndOutputsCemaNeige]
+      names(CemaNeigeLayers[[iLayer]]) <- RunOptions$FortranOutputs$CN[IndOutputsCemaNeige]
       IndPliqAndMelt <- which(names(CemaNeigeLayers[[iLayer]]) == "PliqAndMelt")
       if (iLayer == 1) {
         CatchMeltAndPliq <- RESULTS$Outputs[, IndPliqAndMelt] / NLayers
@@ -142,9 +114,9 @@ RunModel_CemaNeigeGR4H <- function(InputsModel, RunOptions, Param) {
 
   ## GR model
   if ("all" %in% RunOptions$Outputs_Sim) {
-    IndOutputsMod <- as.integer(1:length(FortranOutputs$GR))