Binary files /tmp/tmp9l77iA/RtEbT66YcP/airgr-1.6.9.27/build/partial.rdb and /tmp/tmp9l77iA/YQ9pTT1aMU/airgr-1.6.10.4/build/partial.rdb differ diff -Nru airgr-1.6.9.27/debian/changelog airgr-1.6.10.4/debian/changelog --- airgr-1.6.9.27/debian/changelog 2021-01-23 00:50:52.000000000 +0000 +++ airgr-1.6.10.4/debian/changelog 2021-01-31 00:45:52.000000000 +0000 @@ -1,16 +1,23 @@ -airgr (1.6.9.27-1cran1.2004.0) focal; urgency=medium +airgr (1.6.10.4-1cran1.2004.0) focal; urgency=medium * Compilation for Ubuntu 20.04.1 LTS * Build for c2d4u for R 4.0.0 plus * Focal only build amd64 packages for Launchpad - -- Michael Rutter Sat, 23 Jan 2021 00:50:52 +0000 + -- Michael Rutter Sun, 31 Jan 2021 00:45:52 +0000 + +airgr (1.6.10.4-1cran1) testing; urgency=low + + * cran2deb svn: 362M with DB version 1. + + -- cran2deb4ubuntu Sat, 30 Jan 2021 12:19:29 -0500 + airgr (1.6.9.27-1cran1) testing; urgency=low * cran2deb svn: 362M with DB version 1. - -- cran2deb4ubuntu Fri, 22 Jan 2021 19:14:11 -0500 + -- cran2deb4ubuntu Fri, 22 Jan 2021 19:14:22 -0500 airgr (1.4.3.65-1cran1) testing; urgency=low diff -Nru airgr-1.6.9.27/DESCRIPTION airgr-1.6.10.4/DESCRIPTION --- airgr-1.6.9.27/DESCRIPTION 2021-01-22 11:40:02.000000000 +0000 +++ airgr-1.6.10.4/DESCRIPTION 2021-01-29 09:50:06.000000000 +0000 @@ -2,8 +2,8 @@ Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.6.9.27 -Date: 2021-01-18 +Version: 1.6.10.4 +Date: 2021-01-29 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"), @@ -23,8 +23,8 @@ ) Depends: R (>= 3.1.0) Imports: graphics, grDevices, stats, utils -Suggests: knitr, rmarkdown, coda, DEoptim, dplyr, FME, ggmcmc, - hydroPSO, imputeTS, Rmalschains, testthat +Suggests: knitr, rmarkdown, caRamel, coda, DEoptim, dplyr, FME, ggmcmc, + hydroPSO, imputeTS, Rmalschains, GGally, ggplot2, testthat Description: Hydrological modelling tools developed at INRAE-Antony (HYCAR Research Unit, France). The package includes several conceptual rainfall-runoff models (GR4H, GR5H, GR4J, GR5J, GR6J, GR2M, GR1A), a snow accumulation and melt model (CemaNeige) and the associated functions for their calibration and evaluation. Use help(airGR) for package description and references. License: GPL-2 URL: https://hydrogr.github.io/airGR/ @@ -32,7 +32,7 @@ NeedsCompilation: yes Encoding: UTF-8 VignetteBuilder: knitr -Packaged: 2021-01-22 10:35:22 UTC; irstea +Packaged: 2021-01-29 07:26:52 UTC; irstea Author: Laurent Coron [aut, trl] (), Olivier Delaigue [aut, cre] (), Guillaume Thirel [aut] (), @@ -50,4 +50,4 @@ Audrey Valéry [ctb] Maintainer: Olivier Delaigue Repository: CRAN -Date/Publication: 2021-01-22 11:40:02 UTC +Date/Publication: 2021-01-29 09:50:06 UTC diff -Nru airgr-1.6.9.27/inst/doc/V01_get_started.html airgr-1.6.10.4/inst/doc/V01_get_started.html --- airgr-1.6.9.27/inst/doc/V01_get_started.html 2021-01-22 10:35:06.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V01_get_started.html 2021-01-29 07:26:36.000000000 +0000 @@ -1,356 +1,260 @@ - - + - - - +Introduction - + + + + + -Get Started with airGR - - - - - +tt, code, pre { + font-family: 'DejaVu Sans Mono', 'Droid Sans Mono', 'Lucida Console', Consolas, Monaco, monospace; +} +h1 { + font-size:2.2em; +} +h2 { + font-size:1.8em; +} +h3 { + font-size:1.4em; +} - - +

Introduction

+

airGR is a package that brings into the R software the hydrological modelling tools used and developed at the Catchment Hydrology Research Group at INRAE (France), including the GR rainfall-runoff models and a snowmelt and accumulation model, CemaNeige. Each model core is coded in Fortran to ensure low computational time. The other package functions (i.e. mainly the calibration algorithm and the efficiency criteria calculation) are coded in R.

+

The airGR package has been designed to fulfill two major requirements: to facilitate the use by non-expert users and to allow flexibility regarding the addition of external criteria, models or calibration algorithms. The names of the functions and their arguments were chosen to this end. airGR also contains basics plotting facilities.

+

Six hydrological models and one snowmelt and accumulation model are implemented in airGR. The snow model can be used alone or together with the daily hydrological models.

-

Get Started with airGR

- - +

The models can be called within airGR using the following functions:

-
-

Introduction

-

airGR is a package that brings into the R software the hydrological modelling tools used and developed at the Catchment Hydrology Research Group at INRAE (France), including the GR rainfall-runoff models and a snowmelt and accumulation model, CemaNeige. Each model core is coded in Fortran to ensure low computational time. The other package functions (i.e. mainly the calibration algorithm and the efficiency criteria calculation) are coded in R.

-

The airGR package has been designed to fulfill two major requirements: to facilitate the use by non-expert users and to allow flexibility regarding the addition of external criteria, models or calibration algorithms. The names of the functions and their arguments were chosen to this end. airGR also contains basics plotting facilities.

-

Six hydrological models and one snowmelt and accumulation model are implemented in airGR. The snow model can be used alone or together with the daily hydrological models.

-

The models can be called within airGR using the following functions:

    -
  • RunModel_GR4H(): four-parameter hourly lumped hydrological model (Mathevet 2005)
    • -
  • RunModel_GR5H(): five-parameter hourly lumped hydrological model (Ficchi 2017; Ficchì, Perrin, and Andréassian 2019)
    • -
  • RunModel_GR4J(): four-parameter daily lumped hydrological model (Perrin, Michel, and Andréassian 2003)
    • -
  • RunModel_GR5J(): five-parameter daily lumped hydrological model (Le Moine 2008)
    • -
  • RunModel_GR6J(): six-parameter daily lumped hydrological model (Pushpalatha et al. 2011)
    • -
  • RunModel_GR2M(): two-parameter monthly lumped hydrological model (Mouelhi 2003; Mouelhi et al. 2006a)
    • -
  • RunModel_GR1A(): one-parameter yearly lumped hydrological model (Mouelhi 2003; Mouelhi et al. 2006b)
    • -
  • RunModel_CemaNeige(): two-parameter degree-day snowmelt and accumulation model (Valéry, Andréassian, and Perrin 2014; Riboust et al. 2019)
    • -
  • RunModel_CemaNeigeGR4H(): combined use of GR4H and CemaNeige
    • -
  • RunModel_CemaNeigeGR5H(): combined use of GR5H and CemaNeige
    • -
  • RunModel_CemaNeigeGR4J(): combined use of GR4J and CemaNeige
    • -
  • RunModel_CemaNeigeGR5J(): combined use of GR5J and CemaNeige
    • -
  • RunModel_CemaNeigeGR6J(): combined use of GR6J and CemaNeige
    • +
  • RunModel_GR4H(): four-parameter hourly lumped hydrological model [@mathevet_quels_2005]
    • +
  • RunModel_GR5H(): five-parameter hourly lumped hydrological model [@ficchi_adaptive_2017; @ficchi_hydrological_2019]
    • +
  • RunModel_GR4J(): four-parameter daily lumped hydrological model [@perrin_improvement_2003]
    • +
  • RunModel_GR5J(): five-parameter daily lumped hydrological model [@le_moine_bassin_2008]
    • +
  • RunModel_GR6J(): six-parameter daily lumped hydrological model [@pushpalatha_downward_2011]
    • +
  • RunModel_GR2M(): two-parameter monthly lumped hydrological model [@mouelhi_vers_2003; @mouelhi_stepwise_2006]
    • +
  • RunModel_GR1A(): one-parameter yearly lumped hydrological model [@mouelhi_vers_2003; @mouelhi_linking_2006]
    • +
  • RunModel_CemaNeige(): two-parameter degree-day snowmelt and accumulation model [@valery_as_2014; @riboust_revisiting_2019]
    • +
  • RunModel_CemaNeigeGR4H(): combined use of GR4H and CemaNeige
    • +
  • RunModel_CemaNeigeGR5H(): combined use of GR5H and CemaNeige
    • +
  • RunModel_CemaNeigeGR4J(): combined use of GR4J and CemaNeige
    • +
  • RunModel_CemaNeigeGR5J(): combined use of GR5J and CemaNeige
    • +
  • RunModel_CemaNeigeGR6J(): combined use of GR6J and CemaNeige
+

The GRP forecasting model and the Otamin predictive uncertainty tool are not available in airGR.

+

In this vignette, we show how to prepare and run a calibration and a simulation with airGR hydrological models.

-
-
+

Loading data

+

In the following example, we use a data sample contained in the package. For real applications, the user has to import its data into R and to prepare it with an adequate data.frame format as described below.

+

First, it is necessary to load the airGR package:

- + +
library(airGR)
+
+

Below is presented an example of a data.frame of daily hydrometeorological observations time series for a fictional catchment included in the airGR package that contains:

+
    -
  • DatesR: dates in the POSIXt format
    • +
  • DatesR: dates in the POSIXt format
  • P: average precipitation [mm/day]
    • -
  • T: catchment average air temperature [℃]
    • +
  • T: catchment average air temperature [℃]
  • E: catchment average potential evapotranspiration [mm/day]
  • Qls: outlet discharge [l/s]
  • Qmm: outlet discharge [mm/day]
- + +
data(L0123001)
+summary(BasinObs)
+
+ 
##      DatesR                 P                T                 E        
 ##  Min.   :1984-01-01   Min.   : 0.000   Min.   :-18.700   Min.   :0.000  
 ##  1st Qu.:1991-04-02   1st Qu.: 0.000   1st Qu.:  4.100   1st Qu.:0.600  
@@ -366,60 +270,89 @@
 ##  Mean   : 6130   Mean   : 1.4732  
 ##  3rd Qu.: 7850   3rd Qu.: 1.8840  
 ##  Max.   :99500   Max.   :23.8800  
-##  NA's   :772     NA's   :802
+## NA's :772 NA's :802 + +

The usual functions (e.g. read.table()) can be used to load real-case data sets.

-
-
+

Preparation of functions inputs

-

To run a model, the functions of the airGR package (e.g. the models, calibration and criteria calculation functions) require data and options with specific formats.

+ +

To run a model, the functions of the airGR package (e.g. the models, calibration and criteria calculation functions) require data and options with specific formats.

+

To facilitate the use of the package, there are several functions dedicated to the creation of these objects:

+
  • CreateInputsModel(): prepares the inputs for the different hydrological models (times series of dates, precipitation, observed discharge, etc.)
  • CreateRunOptions(): prepares the options for the hydrological model run (warm up period, calibration period, etc.)
    • -
  • CreateInputsCrit(): prepares the options in order to compute the efficiency criterion (choice of the criterion, choice of the transformation on discharge: “log”, “sqrt”, etc.)
    • +
  • CreateInputsCrit(): prepares the options in order to compute the efficiency criterion (choice of the criterion, choice of the transformation on discharge: “log”, “sqrt”, etc.)
  • CreateCalibOptions(): prepares the options for the hydrological model calibration algorithm (choice of parameters to optimize, predefined values for uncalibrated parameters, etc.)
-
+

InputsModel object

-

To run a GR hydrological model or CemaNeige, the user has to prepare the input data with the CreateInputsModel() function. As arguments, this function needs the function name corresponding to the model the user wants to run, a vector of dates, a vector of precipitation and a vector of potential evapotranspiration.

-

In the example below, we already have the potential evapotranspiration. If the user does not have these data, it is possible to compute it with the Oudin’s formula with the PE_Oudin() function (this function only needs Julian days, daily average air temperature and latitude).

+ +

To run a GR hydrological model or CemaNeige, the user has to prepare the input data with the CreateInputsModel() function. +As arguments, this function needs the function name corresponding to the model the user wants to run, a vector of dates, a vector of precipitation and a vector of potential evapotranspiration.

+ +

In the example below, we already have the potential evapotranspiration. If the user does not have these data, it is possible to compute it with the Oudin's formula with the PE_Oudin() function (this function only needs Julian days, daily average air temperature and latitude).

+

Missing values (NA) of precipitation (or potential evapotranspiration) are not allowed.

- + +
InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+                                 Precip = BasinObs$P, PotEvap = BasinObs$E)
+str(InputsModel)
+
+ 
## List of 3
 ##  $ DatesR : POSIXlt[1:10593], format: "1984-01-01" "1984-01-02" ...
 ##  $ Precip : num [1:10593] 4.1 15.9 0.8 0 0 0 0 0 2.9 0 ...
 ##  $ PotEvap: num [1:10593] 0.2 0.2 0.3 0.3 0.1 0.3 0.4 0.4 0.5 0.5 ...
-##  - attr(*, "class")= chr [1:3] "InputsModel" "daily" "GR"
-
-
+## - attr(*, "class")= chr [1:3] "InputsModel" "daily" "GR" + +

RunOptions object

+

The CreateRunOptions() function allows to prepare the options required to the RunModel*() functions, which are the actual models functions.

+

The user must at least define the following arguments:

+
  • FUN_MOD: the name of the model function to run
  • InputsModel: the associated input data
  • IndPeriod_Run: the period on which the model is run
+

To select a period for which the user wants to run the model, select the corresponding indexes for different time periods (not the POSIXt dates), as follows:

- -
##  int [1:3652] 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 ...
-

The initialization of hydrological models is of the utmost importance. Indeed, an inaccurate initialization causes poor quality discharge simulations during the earliest stages of the running period. For example, in the GR models, by default, the production and the routing store levels store level are respectively set to 30 % and 50 % of their capacity, which may be far from their ideal value. Two solutions are offered to accurately initialize the GR models in airGR: manually predefining the initial states (e.g. from a previous run) or running the models during a warm up period before the actual running period. It is generally advised to set up this warm up period to be equal or superior to one year.

+ +
Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"), 
+               which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
+str(Ind_Run)
+
+ +
##  int [1:3652] 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 ...
+
+ +

The initialization of hydrological models is of the utmost importance. Indeed, an inaccurate initialization causes poor quality discharge simulations during the earliest stages of the running period. For example, in the GR models, by default, the production and the routing store levels store level are respectively set to 30 % and 50 % of their capacity, which may be far from their ideal value. Two solutions are offered to accurately initialize the GR models in airGR: manually predefining the initial states (e.g. from a previous run) or running the models during a warm up period before the actual running period. It is generally advised to set up this warm up period to be equal or superior to one year.

+

As a consequence, it is possible to define in CreateRunOptions() the following arguments:

+
  • IniStates: the initial states of the 2 unit hydrographs (20 + 40 = 60 units)
  • IniResLevels: the initial levels of the production and routing stores
  • IndPeriod_WarmUp: the warm up period used to run the model, to be defined in the same format as IndPeriod_Run
- + +
RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+                               InputsModel = InputsModel, IndPeriod_Run = Ind_Run,
+                               IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL)
+
+ 
## Warning in CreateRunOptions(FUN_MOD = RunModel_GR4J, InputsModel = InputsModel, : model warm up period not defined: default configuration used
-##   the year preceding the run period is used
- +## the year preceding the run period is used + + +
str(RunOptions)
+
+ 
## List of 6
 ##  $ IndPeriod_WarmUp: int [1:365] 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 ...
 ##  $ IndPeriod_Run   : int [1:3652] 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 ...
@@ -427,28 +360,37 @@
 ##  $ IniResLevels    : num [1:4] 0.3 0.5 NA NA
 ##  $ Outputs_Cal     : chr "Qsim"
 ##  $ Outputs_Sim     : chr [1:20] "DatesR" "PotEvap" "Precip" "Prod" ...
-##  - attr(*, "class")= chr [1:3] "RunOptions" "GR" "daily"
+## - attr(*, "class")= chr [1:3] "RunOptions" "GR" "daily" + +

The CreateRunOptions() function returns warnings if the default initialization options are used:

+
  • IniStates and IniResLevels are automatically set to initialize all the model states at 0, except for the production and routing stores, which are initialized at respectively 30 % and 50 % of their capacity
    • -
  • IndPeriod_WarmUp default setting ensures a one-year warm up using the time steps preceding the IndPeriod_Run, if available
    • +
  • IndPeriod_WarmUp default setting ensures a one-year warm up using the time steps preceding the IndPeriod_Run, if available
-
-
+

InputsCrit object

+

The CreateInputsCrit() function allows to prepare the input in order to calculate a criterion. It is possible to define the following arguments:

+
  • FUN_CRIT: the name of the error criterion function (the available functions are introduced later on)
  • InputsModel: the inputs of the hydrological model previously prepared by the CreateInputsModel() function
    • -
  • RunOptions: the options of the hydrological model previously prepared by the CreateRunOptions() function
    • +
  • RunOptions: the options of the hydrological model previously prepared by the CreateRunOptions() function
  • VarObs: the name of the considered variable (by default "Q" for the discharge)
    • -
  • Obs: the observed variable time serie (e.g. the discharge expressed in mm/time step)
    • +
  • Obs: the observed variable time serie (e.g. the discharge expressed in mm/time step)
+

Missing values (NA) are allowed for observed discharge.

-

It is possible to compute a composite criterion (e.g. the average between NSE computed on discharge and NSE computed on log of discharge). In this case, users have to provide lists to the following arguments (some of the are optional): FUN_CRIT, Obs, VarObs, BoolCrit, transfo, Weights.

- + +

It is possible to compute a composite criterion (e.g. the average between NSE computed on discharge and NSE computed on log of discharge). In this case, users have to provide lists to the following arguments (some of the are optional): FUN_CRIT, Obs, VarObs, BoolCrit, transfo, Weights.

+ +
InputsCrit <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel, 
+                               RunOptions = RunOptions, VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run])
+str(InputsCrit)
+
+ 
## List of 8
 ##  $ FUN_CRIT: chr "ErrorCrit_NSE"
 ##  $ Obs     : num [1:3652] 1.99 1.8 2.86 2.4 3.31 ...
@@ -458,48 +400,62 @@
 ##  $ transfo : chr ""
 ##  $ epsilon : NULL
 ##  $ Weights : NULL
-##  - attr(*, "class")= chr [1:2] "Single" "InputsCrit"
-
-
+## - attr(*, "class")= chr [1:2] "Single" "InputsCrit" + +

CalibOptions object

+

Before using the automatic calibration tool, the user needs to prepare the calibration options with the CreateCalibOptions() function. For that, it is necessary to define the following arguments:

+
  • FUN_MOD: the name of the model function
  • FUN_CALIB: the name of the calibration algorithm
- + +
CalibOptions <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel)
+str(CalibOptions)
+
+ 
## List of 4
 ##  $ FixedParam       : logi [1:4] NA NA NA NA
 ##  $ SearchRanges     : num [1:2, 1:4] 4.59e-05 2.18e+04 -1.09e+04 1.09e+04 4.59e-05 ...
 ##  $ FUN_TRANSFO      :function (ParamIn, Direction)  
 ##  $ StartParamDistrib: num [1:3, 1:4] 169.017 247.151 432.681 -2.376 -0.649 ...
-##  - attr(*, "class")= chr [1:3] "CalibOptions" "GR4J" "HBAN"
-
-
-
+## - attr(*, "class")= chr [1:3] "CalibOptions" "GR4J" "HBAN" + +

Criteria

+

The evaluation of the quality of a simulation is estimated through the calculation of criteria. These criteria can be used both as objective-functions during the calibration of the model, or as a measure for evaluating its performance on a control period.

+

The package offers the possibility to use different criteria:

+
  • ErrorCrit_RMSE(): Root mean square error (RMSE)
  • ErrorCrit_NSE(): Nash-Sutcliffe model efficiency coefficient (NSE)
  • ErrorCrit_KGE(): Kling-Gupta efficiency criterion (KGE)
    • -
  • ErrorCrit_KGE2(): modified Kling-Gupta efficiency criterion (KGE’)
    • +
  • ErrorCrit_KGE2(): modified Kling-Gupta efficiency criterion (KGE')
+

It is also possible to create user-defined criteria. For doing that, it is only necessary to define the function in R following the same syntax as the criteria functions included in airGR.

-
-
+

Calibration

+

The objective of the calibration algorithm is to identify the model parameters: by comparing the model outputs with observed data, this algorithm determines the combination of parameters that represents the best the behavior of the watershed.

-

In the airGR package, a function called Calibration_Michel() is implemented. This functions allows running a calibration with the package models. The calibration algorithm optimizes the error criterion selected as objective-function. This algorithm works in two steps:

-
    + +

    In the airGR package, a function called Calibration_Michel() is implemented. This functions allows running a calibration with the package models. +The calibration algorithm optimizes the error criterion selected as objective-function. This algorithm works in two steps:

    + +
    1. a screening of the parameters space is performed using either a rough predefined grid or a user-defined list of parameter sets
    2. a simple steepest descent local search algorithm is performed from the best set of parameters found at the first step
    - + +
    OutputsCalib <- Calibration_Michel(InputsModel = InputsModel, RunOptions = RunOptions,
+                                   InputsCrit = InputsCrit, CalibOptions = CalibOptions,
+                                   FUN_MOD = RunModel_GR4J)
+
    + 
    ## Grid-Screening in progress (0% 20% 40% 60% 80% 100%)
 ##   Screening completed (81 runs)
 ##       Param =  247.151,   -0.020,   83.096,    2.384
@@ -507,25 +463,38 @@
 ## Steepest-descent local search in progress
 ##   Calibration completed (21 iterations, 234 runs)
 ##       Param =  257.238,    1.012,   88.235,    2.208
-##       Crit. NSE[Q]       = 0.7988
    - -
    ## [1] 257.237556   1.012237  88.234673   2.207958
    +## Crit. NSE[Q] = 0.7988 + + +
    Param <- OutputsCalib$ParamFinalR
+Param
+
    + +
    ## [1] 257.237556   1.012237  88.234673   2.207958
+
    +

    The Calibration_Michel() function is the only one implemented in the airGR package to calibrate the model, but the user can implement its own calibration function. Two vignettes explain how it can be done (2.1 Plugging in new calibration and 2.2 MCMC parameter estimation).

    -

    The Calibration_Michel() function returns a vector with the parameters of the chosen model, which means that the number of values can differ depending on the model that is used. It is possible to use the Calibration_Michel() function with user-implemented hydrological models.

    -
-
+ +

The Calibration_Michel() function returns a vector with the parameters of the chosen model, which means that the number of values can differ depending on the model that is used. It is possible to use the Calibration_Michel() function with user-implemented hydrological models.

+

Control

-

This step assesses the predictive capacity of the model. Control is defined as the estimation of the accuracy of the model on data sets that are not used in its construction, and in particular its calibration. The classical way to perform a control is to keep data from a period separated from the calibration period. If possible, this control period should correspond to climatic situations that differ from those of the calibration period in order to better point out the qualities and weaknesses of the model. This exercise is necessary for assessing the robustness of the model, that is to say its ability to keep stable performances outside of the calibration conditions.

+ +

This step assesses the predictive capacity of the model. Control is defined as the estimation of the accuracy of the model on data sets that are not used in its construction, and in particular its calibration. +The classical way to perform a control is to keep data from a period separated from the calibration period. If possible, this control period should correspond to climatic situations that differ from those of the calibration period in order to better point out the qualities and weaknesses of the model. This exercise is necessary for assessing the robustness of the model, that is to say its ability to keep stable performances outside of the calibration conditions.

+

Performing a model control with airGR is similar to running a simulation (see below), followed by the computation of one or several performance criteria.

-
-
+

Simulation

-
+

Simulation run

-

To run a model, the user has to use the RunModel*() functions (InputsModel, RunOptions and parameters). All the data needed have already been prepared in the previous steps defined in this guide.

- + +

To run a model, the user has to use the RunModel*() functions (InputsModel, RunOptions and parameters). +All the data needed have already been prepared in the previous steps defined in this guide.

+ +
OutputsModel <- RunModel_GR4J(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param)
+str(OutputsModel)
+
+ 
## List of 20
 ##  $ DatesR  : POSIXlt[1:3652], format: "1990-01-01" "1990-01-02" ...
 ##  $ PotEvap : num [1:3652] 0.3 0.4 0.4 0.3 0.1 0.1 0.1 0.2 0.2 0.3 ...
@@ -561,39 +530,61 @@
 ##   .. ..$ Gthr   : num NA
 ##   .. ..$ Glocmax: num NA
 ##   ..- attr(*, "class")= chr [1:3] "IniStates" "GR" "daily"
-##  - attr(*, "class")= chr [1:3] "OutputsModel" "daily" "GR"
-
-
+## - attr(*, "class")= chr [1:3] "OutputsModel" "daily" "GR" + +

Results preview

-

Although it is possible for the user to design its own graphics from the outputs of the RunModel*() functions, the airGR package offers the possibility to make use of the plot() function. This function returns a dashboard of results including various graphs (depending on the model used):

+ +

Although it is possible for the user to design its own graphics from the outputs of the RunModel*() functions, the airGR package offers the possibility to make use of the plot() function. This function returns a dashboard of results including various graphs (depending on the model used):

+
  • time series of total precipitation and simulated discharge (and observed discharge if provided)
    • -
  • interannual average daily simulated discharge (and daily observed discharge if provided) and interannual average monthly precipitation
    • +
  • interannual average daily simulated discharge (and daily observed discharge if provided) and interannual average monthly precipitation
  • cumulative frequency plot for simulated discharge (and for observed discharge if provided)
  • correlation plot between simulated and observed discharge (if observed discharge provided)
- -

Moreover, if the CemaNeige model is used, the air temperature and the simulated snowpack water equivalent time series are plotted.

-
-
+ +
plot(OutputsModel, Qobs = BasinObs$Qmm[Ind_Run])
+
+ +

Moreover, if the CemaNeige model is used, the air temperature and the simulated snowpack water equivalent time series are plotted.

+

Efficiency criterion

+

To evaluate the efficiency of the model, it is possible to use the same criterion as defined at the calibration step or to use another criterion.

- -
## Crit. NSE[Q] = 0.7988
- + +
OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
+
+ +
## Crit. NSE[Q] = 0.7988
+
+ +
str(OutputsCrit)
+
+ 
## List of 5
 ##  $ CritValue      : num 0.799
 ##  $ CritName       : chr "NSE[Q]"
 ##  $ CritBestValue  : num 1
 ##  $ Multiplier     : num -1
 ##  $ Ind_notcomputed: int [1:57] 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 ...
-##  - attr(*, "class")= chr [1:2] "NSE" "ErrorCrit"
- -
## Crit. KGE[Q] = 0.7854
+## - attr(*, "class")= chr [1:2] "NSE" "ErrorCrit" + + +
OutputsCrit <- ErrorCrit_KGE(InputsCrit = InputsCrit, OutputsModel = OutputsModel)
+
+ +
## Crit. KGE[Q] = 0.7854
+
+ 
##  SubCrit. KGE[Q] cor(sim, obs, "pearson") = 0.8985 
 ##  SubCrit. KGE[Q] sd(sim)/sd(obs)          = 0.8161 
-##  SubCrit. KGE[Q] mean(sim)/mean(obs)      = 1.0437
- +## SubCrit. KGE[Q] mean(sim)/mean(obs) = 1.0437 + + +
str(OutputsCrit)
+
+ 
## List of 7
 ##  $ CritValue      : num 0.785
 ##  $ CritName       : chr "KGE[Q]"
@@ -602,62 +593,11 @@
 ##  $ CritBestValue  : num 1
 ##  $ Multiplier     : num -1
 ##  $ Ind_notcomputed: int [1:57] 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 ...
-##  - attr(*, "class")= chr [1:2] "KGE" "ErrorCrit"
-
-
-
-

References

-
-
-

Ficchi, Andrea. 2017. “An Adaptive Hydrological Model for Multiple Time-Steps: Diagnostics and Improvements Based on Fluxes Consistency.” PhD thesis, Université Pierre et Marie Curie, Paris 6. http://www.theses.fr/2017PA066097.

-
-
-

Ficchì, Andrea, Charles Perrin, and Vazken Andréassian. 2019. “Hydrological Modelling at Multiple Sub-Daily Time Steps: Model Improvement via Flux-Matching.” Journal of Hydrology, June. https://doi.org/10.1016/j.jhydrol.2019.05.084.

-
-
-

Le Moine, Nicolas. 2008. “Le Bassin Versant de Surface Vu Par Le Souterrain : Une Voie d’amélioration Des Performances et Du Réalisme Des Modèles Pluie-Débit ?” PhD thesis, Université Pierre et Marie Curie, Paris 6. http://webgr.irstea.fr/wp-content/uploads/2012/07/2008-LE_MOINE-THESE.pdf.

-
-
-

Mathevet, Thibault. 2005. “Quels Modèles Pluie-Débit Globaux Au Pas de Temps Horaire ? Développements Empiriques et Comparaison de Modèles Sur Un Large échantillon de Bassins Versants.” PhD thesis, Paris: ENGREF. http://webgr.irstea.fr/wp-content/uploads/2012/07/2005-MATHEVET-THESE.pdf.

-
-
-

Mouelhi, Safouane. 2003. “Vers Une Chaîne Cohérente de Modèles Pluie-Débit Conceptuels Globaux Aux Pas de Temps Pluriannuel, Annuel, Mensuel et Journalier.” PhD thesis, Paris, ENGREF. http://webgr.irstea.fr/wp-content/uploads/2012/07/2003-MOUELHI-THESE.pdf.

-
-
-

Mouelhi, Safouane, Claude Michel, Charles Perrin, and Vazken Andréassian. 2006a. “Stepwise Development of a Two-Parameter Monthly Water Balance Model.” Journal of Hydrology 318 (1-4): 200–214. https://doi.org/10.1016/j.jhydrol.2005.06.014.

-
-
-

———. 2006b. “Linking Stream Flow to Rainfall at the Annual Time Step: The Manabe Bucket Model Revisited.” Journal of Hydrology 328 (1-2): 283–96. https://doi.org/10.1016/j.jhydrol.2005.12.022.

-
-
-

Perrin, Charles, Claude Michel, and Vazken Andréassian. 2003. “Improvement of a Parsimonious Model for Streamflow Simulation.” Journal of Hydrology 279 (1-4): 275–89. https://doi.org/10.1016/S0022-1694(03)00225-7.

-
-
-

Pushpalatha, Raji, Charles Perrin, Nicolas Le Moine, Thibault Mathevet, and Vazken Andréassian. 2011. “A Downward Structural Sensitivity Analysis of Hydrological Models to Improve Low-Flow Simulation.” Journal of Hydrology 411 (1–2): 66–76. https://doi.org/10.1016/j.jhydrol.2011.09.034.

-
-
-

Riboust, Philippe, Guillaume Thirel, Nicolas Le Moine, and Pierre Ribstein. 2019. “Revisiting a Simple Degree-Day Model for Integrating Satellite Data: Implementation of Swe-Sca Hystereses.” Journal of Hydrology and Hydromechanics 67 (1): 70–81. https://doi.org/10.2478/johh-2018-0004.

-
-
-

Valéry, Audrey, Vazken Andréassian, and Charles Perrin. 2014. “’As Simple as Possible but Not Simpler’: What Is Useful in a Temperature-Based Snow-Accounting Routine? Part 2 - Sensitivity Analysis of the Cemaneige Snow Accounting Routine on 380 Catchments.” Journal of Hydrology, no. 517(0): 1176–87. https://doi.org/10.1016/j.jhydrol.2014.04.058.

-
-
-
- +## - attr(*, "class")= chr [1:2] "KGE" "ErrorCrit" + - - - - - - +

References

+ diff -Nru airgr-1.6.9.27/inst/doc/V01_get_started.Rmd airgr-1.6.10.4/inst/doc/V01_get_started.Rmd --- airgr-1.6.9.27/inst/doc/V01_get_started.Rmd 2021-01-13 16:50:44.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V01_get_started.Rmd 2021-01-28 21:14:32.000000000 +0000 @@ -1,5 +1,6 @@ --- title: "Get Started with airGR" +author: "Guillaume Thirel, Olivier Delaigue, Laurent Coron" bibliography: V00_airgr_ref.bib output: rmarkdown::html_vignette vignette: > diff -Nru airgr-1.6.9.27/inst/doc/V02.1_param_optim.html airgr-1.6.10.4/inst/doc/V02.1_param_optim.html --- airgr-1.6.9.27/inst/doc/V02.1_param_optim.html 2021-01-22 10:35:10.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V02.1_param_optim.html 2021-01-29 07:26:41.000000000 +0000 @@ -1,378 +1,299 @@ - - + - - - +Introduction - + - + + + + -Plugging in new calibration algorithms in airGR - - - - - +tt, code, pre { + font-family: 'DejaVu Sans Mono', 'Droid Sans Mono', 'Lucida Console', Consolas, Monaco, monospace; +} +h1 { + font-size:2.2em; +} +h2 { + font-size:1.8em; +} +h3 { + font-size:1.4em; +} - - +

Introduction

+

Scope

+

The Michel's calibration strategy (Calibration_Michel() function) is the calibration algorithm proposed in airGR. However, other optimization methods can be used in combination with airGR. +We show here how to use different R packages to perform parameter estimation.

+

In this vignette, we use the GR4J model to illustrate the different optimization strategies. +In particular, we assume that the R global environment contains input climate data, observed discharge and functions from the Get Started vignette, as shown below. +Please note that the calibration period is defined in the CreateRunOptions() function .

-

Plugging in new calibration algorithms in airGR

-

François Bourgin

- - - -
-

Introduction

-
-

Scope

-

The Michel’s calibration strategy (Calibration_Michel() function) is the calibration algorithm proposed in airGR. However, other optimization methods can be used in combination with airGR. We show here how to use different R packages to perform parameter estimation.

-

In this vignette, we use the GR4J model to illustrate the different optimization strategies. In particular, we assume that the R global environment contains input climate data, observed discharge and functions from the Get Started vignette, as shown below. Please note that the calibration period is defined in the CreateRunOptions() function .

+ + - + +
example("Calibration_Michel")
+
+

Regarding the different optimization strategies presented here, we refer to each package for in-depth information about the description of the methods used.

+

Please note that this vignette is only for illustration purposes and does not provide any guidance about which optimization strategies is recommended for the family of the GR models.

-
-
+

Definition of the necessary function

-

Parameter estimation can be performed by defining a function that takes a parameter set as input and returns the value of the performance criterion. There are two important steps: the transformation of parameters to real space and the computation of the value of the performance criterion. Here we choose to minimize the root mean square error.

-

The change of the repository from the “real” parameter space to a “transformed” space ensures homogeneity of displacement in the different dimensions of the parameter space during the step-by-step procedure of the calibration algorithm of the model.

- + +

Parameter estimation can be performed by defining a function that takes a parameter set as input and returns the value of the performance criterion. +There are two important steps: the transformation of parameters to real space and the computation of the value of the performance criterion. +Here we choose to minimize the root mean square error.

+ +

The change of the repository from the “real” parameter space to a “transformed” space ensures homogeneity of displacement in the different dimensions of the parameter space during the step-by-step procedure of the calibration algorithm of the model.

+ +
OptimGR4J <- function(ParamOptim) {
+  ## Transformation of the parameter set to real space
+  RawParamOptim <- airGR::TransfoParam_GR4J(ParamIn = ParamOptim,
+                                            Direction = "TR")
+  ## Simulation given a parameter set
+  OutputsModel <- airGR::RunModel_GR4J(InputsModel = InputsModel,
+                                       RunOptions = RunOptions,
+                                       Param = RawParamOptim)
+  ## Computation of the value of the performance criteria
+  OutputsCrit <- airGR::ErrorCrit_RMSE(InputsCrit = InputsCrit,
+                                       OutputsModel = OutputsModel,
+                                       verbose = FALSE)
+  return(OutputsCrit$CritValue)
+}
+
+

In addition, we need to define the lower and upper bounds of the four GR4J parameters in the transformed parameter space:

- -
-
-
+ +
lowerGR4J <- rep(-9.99, times = 4)
+upperGR4J <- rep(+9.99, times = 4)
+
+

Local optimization

+

We start with a local optimization strategy by using the PORT routines (using the nlminb() of the stats package) and by setting a starting point in the transformed parameter space:

- + +
startGR4J <- c(4.1, 3.9, -0.9, -8.7)
+optPORT <- stats::nlminb(start = startGR4J,
+                         objective = OptimGR4J,
+                         lower = lowerGR4J, upper = upperGR4J,
+                         control = list(trace = 1))
+
+

The RMSE value reaches a local minimum value after 35 iterations.

-

We can also try a multi-start approach to test the consistency of the local optimization. Here we use the same grid used for the filtering step of the Michel’s calibration strategy (Calibration_Michel() function). For each starting point, a local optimization is performed.

- + +

We can also try a multi-start approach to test the consistency of the local optimization. +Here we use the same grid used for the filtering step of the Michel's calibration strategy (Calibration_Michel() function). +For each starting point, a local optimization is performed.

+ +
startGR4J <- expand.grid(data.frame(CalibOptions$StartParamDistrib))
+optPORT_ <- function(x) {
+  opt <- stats::nlminb(start = x,
+                       objective = OptimGR4J,
+                       lower = lowerGR4J, upper = upperGR4J,
+                       control = list(trace = 1))
+}
+listOptPORT <- apply(startGR4J, MARGIN = 1, FUN = optPORT_)
+
+

We can then extract the best parameter sets and the value of the performance criteria:

- + +
parPORT <- t(sapply(listOptPORT, function(x) x$par))
+objPORT <- sapply(listOptPORT, function(x) x$objective)
+resPORT <- data.frame(parPORT, RMSE = objPORT)
+
+

As can be seen below, the optimum performance criterion values (column objective) can differ from the global optimum value in many cases, resulting in various parameter sets.

- + +
summary(resPORT)
+
+ 
##        X1              X2               X3                  X4           
 ##  Min.   :5.548   Min.   :0.1240   Min.   :-0.038062   Min.   :-8.242667  
 ##  1st Qu.:5.548   1st Qu.:0.1243   1st Qu.:-0.003741   1st Qu.:-8.242667  
@@ -386,62 +307,157 @@
 ##  Median :0.7864  
 ##  Mean   :0.9220  
 ##  3rd Qu.:1.1630  
-##  Max.   :1.2235
+## Max. :1.2235 + +

The existence of several local minima illustrates the importance of defining an appropriate starting point or of using a multi-start strategy or a global optimization strategy.

-
-
+

Global optimization

-

Global optimization is most often used when facing a complex response surface, with multiple local mimina. Here we use the following R implementation of some popular strategies:

+ +

Global optimization is most often used when facing a complex response surface, with multiple local mimina. +Here we use the following R implementation of some popular strategies:

+ - -
+ +
optDE <- DEoptim::DEoptim(fn = OptimGR4J,
+                          lower = lowerGR4J, upper = upperGR4J,
+                          control = DEoptim::DEoptim.control(NP = 40, trace = 10))
+
+

Particle Swarm

- -
-
+ +
optPSO <- hydroPSO::hydroPSO(fn = OptimGR4J,
+                             lower = lowerGR4J, upper = upperGR4J,
+                             control = list(write2disk = FALSE, verbose = FALSE))
+
+

MA-LS-Chains

- -
-
-
+ +
optMALS <- Rmalschains::malschains(fn = OptimGR4J,
+                                   lower = lowerGR4J, upper = upperGR4J,
+                                   maxEvals = 2000)
+
+

Results

+

As it can be seen in the table below, the four additional optimization strategies tested lead to very close optima.

+ 
##    Algo      X1    X2     X3    X4
 ## 1 airGR 257.238 1.012 88.235 2.208
 ## 2  PORT 256.840 1.007 88.126 2.205
 ## 3    DE 256.840 1.007 88.126 2.205
 ## 4   PSO 256.799 1.007 88.147 2.205
-## 5 MA-LS 256.820 1.007 88.116 2.205
+## 5 MA-LS 256.820 1.007 88.116 2.205 + + -
+

Multiobjective optimization

+

Multiobjective optimization is used to explore possible trade-offs between different performances criteria. +Here we use the following R implementation of an efficient strategy:

- + +

Motivated by using the rainfall-runoff model for low flow simulation, we explore the trade-offs between the KGE values obtained without any data transformation and with the inverse transformation.

- - +

First, the OptimGR4J function previously used is modified to return two values.

+ +
InputsCrit_inv <- InputsCrit
+InputsCrit_inv$transfo <- "inv"
+
+MOptimGR4J <- function(i) {
+  if (algo == "caRamel") {
+    ParamOptim <- x[i, ]
+  }
+  ## Transformation of the parameter set to real space
+  RawParamOptim <- airGR::TransfoParam_GR4J(ParamIn = ParamOptim,
+                                            Direction = "TR")
+  ## Simulation given a parameter set
+  OutputsModel <- airGR::RunModel_GR4J(InputsModel = InputsModel,
+                                       RunOptions = RunOptions,
+                                       Param = RawParamOptim)
+  ## Computation of the value of the performance criteria
+  OutputsCrit1 <- airGR::ErrorCrit_KGE(InputsCrit = InputsCrit,
+                                       OutputsModel = OutputsModel,
+                                       verbose = FALSE)
+  ## Computation of the value of the performance criteria
+  OutputsCrit2 <- airGR::ErrorCrit_KGE(InputsCrit = InputsCrit_inv,
+                                       OutputsModel = OutputsModel,
+                                       verbose = FALSE)
+  return(c(OutputsCrit1$CritValue, OutputsCrit2$CritValue))
+}
+
+ +

caRamel

+ +

caRamel is a multiobjective evolutionary algorithm combining the MEAS algorithm and the NGSA-II algorithm.

+ +
algo <- "caRamel"
+optMO <- caRamel::caRamel(nobj = 2,
+                          nvar = 4,
+                          minmax = rep(TRUE, 2),
+                          bounds = matrix(c(lowerGR4J, upperGR4J), ncol = 2),
+                          func = MOptimGR4J,
+                          popsize = 100,
+                          archsize = 100,
+                          maxrun = 15000,
+                          prec = rep(1.e-3, 2),
+                          carallel = FALSE,
+                          graph = FALSE)
+
+ +

The algorithm returns parameter sets that describe the pareto front, illustrating the trade-off between overall good performance and good performance for low flow.

+ +
ggplot() + 
+  geom_point(aes(optMO$objectives[, 1], optMO$objectives[, 2])) +
+  coord_equal(xlim = c(0.4, 0.9), ylim = c(0.4, 0.9)) + 
+  xlab("KGE") + ylab("KGE [1/Q]") +
+  theme_bw()
+
+ +

plot of chunk unnamed-chunk-16

+ +

The pameter sets can be viewed in the parameter space, illustrating different populations.

+ +
param_optMO <- apply(optMO$parameters, MARGIN = 1, FUN = function(x) {
+  airGR::TransfoParam_GR4J(x, Direction = "TR")
+  })
+GGally::ggpairs(data.frame(t(param_optMO)), diag = NULL) + theme_bw()
+
+ +

plot of chunk unnamed-chunk-17

+ +
RunOptions$Outputs_Sim <- "Qsim"
+run_optMO <- apply(optMO$parameters, MARGIN = 1, FUN = function(x) {
+  airGR::RunModel_GR4J(InputsModel = InputsModel,
+                       RunOptions = RunOptions,
+                       Param = x)
+  }$Qsim)
+run_optMO <- data.frame(run_optMO)
+
+ggplot() +
+  geom_line(aes(x = as.POSIXct(InputsModel$DatesR[Ind_Run]),
+                y = run_optMO$X1)) +
+  geom_line(aes(x = as.POSIXct(InputsModel$DatesR[Ind_Run]),
+                y = run_optMO$X54),
+            colour = "darkred") +
+  scale_x_datetime(limits = c(as.POSIXct("1998-01-01"), NA)) +
+  ylab("Discharge [mm/d]") + xlab("Date") +
+  scale_y_sqrt() +
+  theme_bw()
+
+ +

plot of chunk unnamed-chunk-18

+ diff -Nru airgr-1.6.9.27/inst/doc/V02.1_param_optim.R airgr-1.6.10.4/inst/doc/V02.1_param_optim.R --- airgr-1.6.9.27/inst/doc/V02.1_param_optim.R 2021-01-22 10:35:10.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V02.1_param_optim.R 2021-01-29 07:26:41.000000000 +0000 @@ -3,9 +3,13 @@ library(DEoptim) library(hydroPSO) # Needs R version >= 3.6 or latticeExtra <= 0.6-28 on R 3.5 library(Rmalschains) +library(caRamel) +library(ggplot2) +library(GGally) # source("airGR.R") set.seed(321) load(system.file("vignettesData/vignetteParamOptim.rda", package = "airGR")) +load(system.file("vignettesData/vignetteParamOptimCaramel.rda", package = "airGR")) ## ---- echo=TRUE, eval=FALSE--------------------------------------------------- # example("Calibration_Michel") @@ -73,7 +77,7 @@ ## ---- warning=FALSE, echo=FALSE, eval=FALSE----------------------------------- # resGLOB <- data.frame(Algo = c("airGR", "PORT", "DE", "PSO", "MA-LS"), # round(rbind( -# OutputsCalib$ParamFinalR , +# OutputsCalib$ParamFinalR, # airGR::TransfoParam_GR4J(ParamIn = optPORT$par , Direction = "TR"), # airGR::TransfoParam_GR4J(ParamIn = as.numeric(optDE$optim$bestmem), Direction = "TR"), # airGR::TransfoParam_GR4J(ParamIn = as.numeric(optPSO$par) , Direction = "TR"), @@ -83,3 +87,76 @@ ## ---- warning=FALSE, echo=FALSE----------------------------------------------- resGLOB +## ---- warning=FALSE, results='hide', eval=FALSE------------------------------- +# InputsCrit_inv <- InputsCrit +# InputsCrit_inv$transfo <- "inv" +# +# MOptimGR4J <- function(i) { +# if (algo == "caRamel") { +# ParamOptim <- x[i, ] +# } +# ## Transformation of the parameter set to real space +# RawParamOptim <- airGR::TransfoParam_GR4J(ParamIn = ParamOptim, +# Direction = "TR") +# ## Simulation given a parameter set +# OutputsModel <- airGR::RunModel_GR4J(InputsModel = InputsModel, +# RunOptions = RunOptions, +# Param = RawParamOptim) +# ## Computation of the value of the performance criteria +# OutputsCrit1 <- airGR::ErrorCrit_KGE(InputsCrit = InputsCrit, +# OutputsModel = OutputsModel, +# verbose = FALSE) +# ## Computation of the value of the performance criteria +# OutputsCrit2 <- airGR::ErrorCrit_KGE(InputsCrit = InputsCrit_inv, +# OutputsModel = OutputsModel, +# verbose = FALSE) +# return(c(OutputsCrit1$CritValue, OutputsCrit2$CritValue)) +# } + +## ---- warning=FALSE, results='hide', eval=FALSE------------------------------- +# algo <- "caRamel" +# optMO <- caRamel::caRamel(nobj = 2, +# nvar = 4, +# minmax = rep(TRUE, 2), +# bounds = matrix(c(lowerGR4J, upperGR4J), ncol = 2), +# func = MOptimGR4J, +# popsize = 100, +# archsize = 100, +# maxrun = 15000, +# prec = rep(1.e-3, 2), +# carallel = FALSE, +# graph = FALSE) + +## ---- fig.width=6, fig.height=6, warning=FALSE-------------------------------- +ggplot() + + geom_point(aes(optMO$objectives[, 1], optMO$objectives[, 2])) + + coord_equal(xlim = c(0.4, 0.9), ylim = c(0.4, 0.9)) + + xlab("KGE") + ylab("KGE [1/Q]") + + theme_bw() + +## ----fig.height=6, fig.width=6, message=FALSE, warning=FALSE------------------ +param_optMO <- apply(optMO$parameters, MARGIN = 1, FUN = function(x) { + airGR::TransfoParam_GR4J(x, Direction = "TR") + }) +GGally::ggpairs(data.frame(t(param_optMO)), diag = NULL) + theme_bw() + +## ----fig.height=6, fig.width=12, message=FALSE, warning=FALSE----------------- +RunOptions$Outputs_Sim <- "Qsim" +run_optMO <- apply(optMO$parameters, MARGIN = 1, FUN = function(x) { + airGR::RunModel_GR4J(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = x) + }$Qsim) +run_optMO <- data.frame(run_optMO) + +ggplot() + + geom_line(aes(x = as.POSIXct(InputsModel$DatesR[Ind_Run]), + y = run_optMO$X1)) + + geom_line(aes(x = as.POSIXct(InputsModel$DatesR[Ind_Run]), + y = run_optMO$X54), + colour = "darkred") + + scale_x_datetime(limits = c(as.POSIXct("1998-01-01"), NA)) + + ylab("Discharge [mm/d]") + xlab("Date") + + scale_y_sqrt() + + theme_bw() + diff -Nru airgr-1.6.9.27/inst/doc/V02.1_param_optim.Rmd airgr-1.6.10.4/inst/doc/V02.1_param_optim.Rmd --- airgr-1.6.9.27/inst/doc/V02.1_param_optim.Rmd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V02.1_param_optim.Rmd 2021-01-28 21:11:42.000000000 +0000 @@ -1,6 +1,6 @@ --- title: "Plugging in new calibration algorithms in airGR" -author: "François Bourgin" +author: "François Bourgin, Guillaume Thirel" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::rmarkdown} @@ -15,9 +15,13 @@ library(DEoptim) library(hydroPSO) # Needs R version >= 3.6 or latticeExtra <= 0.6-28 on R 3.5 library(Rmalschains) +library(caRamel) +library(ggplot2) +library(GGally) # source("airGR.R") set.seed(321) load(system.file("vignettesData/vignetteParamOptim.rda", package = "airGR")) +load(system.file("vignettesData/vignetteParamOptimCaramel.rda", package = "airGR")) ``` @@ -158,7 +162,7 @@ ```{r, warning=FALSE, echo=FALSE, eval=FALSE} resGLOB <- data.frame(Algo = c("airGR", "PORT", "DE", "PSO", "MA-LS"), round(rbind( - OutputsCalib$ParamFinalR , + OutputsCalib$ParamFinalR, airGR::TransfoParam_GR4J(ParamIn = optPORT$par , Direction = "TR"), airGR::TransfoParam_GR4J(ParamIn = as.numeric(optDE$optim$bestmem), Direction = "TR"), airGR::TransfoParam_GR4J(ParamIn = as.numeric(optPSO$par) , Direction = "TR"), @@ -172,4 +176,100 @@ +# Multiobjective optimization + +Multiobjective optimization is used to explore possible trade-offs between different performances criteria. +Here we use the following R implementation of an efficient strategy: +* [caRamel: Automatic Calibration by Evolutionary Multi Objective Algorithm](https://cran.r-project.org/package=caRamel) + +Motivated by using the rainfall-runoff model for low flow simulation, we explore the trade-offs between the KGE values obtained without any data transformation and with the inverse transformation. + +First, the OptimGR4J function previously used is modified to return two values. + +```{r, warning=FALSE, results='hide', eval=FALSE} +InputsCrit_inv <- InputsCrit +InputsCrit_inv$transfo <- "inv" + +MOptimGR4J <- function(i) { + if (algo == "caRamel") { + ParamOptim <- x[i, ] + } + ## Transformation of the parameter set to real space + RawParamOptim <- airGR::TransfoParam_GR4J(ParamIn = ParamOptim, + Direction = "TR") + ## Simulation given a parameter set + OutputsModel <- airGR::RunModel_GR4J(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = RawParamOptim) + ## Computation of the value of the performance criteria + OutputsCrit1 <- airGR::ErrorCrit_KGE(InputsCrit = InputsCrit, + OutputsModel = OutputsModel, + verbose = FALSE) + ## Computation of the value of the performance criteria + OutputsCrit2 <- airGR::ErrorCrit_KGE(InputsCrit = InputsCrit_inv, + OutputsModel = OutputsModel, + verbose = FALSE) + return(c(OutputsCrit1$CritValue, OutputsCrit2$CritValue)) +} +``` + +## caRamel +caRamel is a multiobjective evolutionary algorithm combining the MEAS algorithm and the NGSA-II algorithm. + +```{r, warning=FALSE, results='hide', eval=FALSE} +algo <- "caRamel" +optMO <- caRamel::caRamel(nobj = 2, + nvar = 4, + minmax = rep(TRUE, 2), + bounds = matrix(c(lowerGR4J, upperGR4J), ncol = 2), + func = MOptimGR4J, + popsize = 100, + archsize = 100, + maxrun = 15000, + prec = rep(1.e-3, 2), + carallel = FALSE, + graph = FALSE) +``` + +The algorithm returns parameter sets that describe the pareto front, illustrating the trade-off between overall good performance and good performance for low flow. + +```{r, fig.width=6, fig.height=6, warning=FALSE} +ggplot() + + geom_point(aes(optMO$objectives[, 1], optMO$objectives[, 2])) + + coord_equal(xlim = c(0.4, 0.9), ylim = c(0.4, 0.9)) + + xlab("KGE") + ylab("KGE [1/Q]") + + theme_bw() +``` + +The pameter sets can be viewed in the parameter space, illustrating different populations. + +```{r fig.height=6, fig.width=6, message=FALSE, warning=FALSE} +param_optMO <- apply(optMO$parameters, MARGIN = 1, FUN = function(x) { + airGR::TransfoParam_GR4J(x, Direction = "TR") + }) +GGally::ggpairs(data.frame(t(param_optMO)), diag = NULL) + theme_bw() +``` + +```{r fig.height=6, fig.width=12, message=FALSE, warning=FALSE} +RunOptions$Outputs_Sim <- "Qsim" +run_optMO <- apply(optMO$parameters, MARGIN = 1, FUN = function(x) { + airGR::RunModel_GR4J(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = x) + }$Qsim) +run_optMO <- data.frame(run_optMO) + +ggplot() + + geom_line(aes(x = as.POSIXct(InputsModel$DatesR[Ind_Run]), + y = run_optMO$X1)) + + geom_line(aes(x = as.POSIXct(InputsModel$DatesR[Ind_Run]), + y = run_optMO$X54), + colour = "darkred") + + scale_x_datetime(limits = c(as.POSIXct("1998-01-01"), NA)) + + ylab("Discharge [mm/d]") + xlab("Date") + + scale_y_sqrt() + + theme_bw() +``` + + diff -Nru airgr-1.6.9.27/inst/doc/V02.2_param_mcmc.html airgr-1.6.10.4/inst/doc/V02.2_param_mcmc.html --- airgr-1.6.9.27/inst/doc/V02.2_param_mcmc.html 2021-01-22 10:35:16.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V02.2_param_mcmc.html 2021-01-29 07:26:47.000000000 +0000 @@ -1,435 +1,356 @@ - - + - - - +Introduction - + - + + + + -Parameter estimation within a Bayesian MCMC framework - - - - - +tt, code, pre { + font-family: 'DejaVu Sans Mono', 'Droid Sans Mono', 'Lucida Console', Consolas, Monaco, monospace; +} +h1 { + font-size:2.2em; +} +h2 { + font-size:1.8em; +} +h3 { + font-size:1.4em; +} - - - - - - -

Parameter estimation within a Bayesian MCMC framework

-

François Bourgin

- - - -

Introduction

-
+

Scope

+

In this vignette, we give an example of parameter estimation within a Bayesian MCMC approach.

+

We use the GR4J model and we assume that the R global environment contains data and functions from the airGR Get Started vignette.

+ + + - + +
example("Calibration_Michel")
+
+

Please refer to the 2.1 Plugging in new calibration vignette for explanations on how to plug in a parameter estimation algorithm to airGR.

+

Please note that this vignette is only for illustration purposes and does not provide any guidance about which parameter inference strategy is recommended for the family of the GR models.

-
-
+

Standard Least Squares (SLS) Bayesian inference

-

We show how to use the DRAM algorithm for SLS Bayesian inference, with the modMCMC() function of the FME package. First, we need to define a function that returns twice the opposite of the log-likelihood for a given parameter set.

-

Nota: in the LogLikeGR4J() function, the computation of the log-likelihood is simplified in order to ensure a good computing performance. It corresponds to a translation of the two following lines.

- + +

We show how to use the DRAM algorithm for SLS Bayesian inference, with the modMCMC() function of the FME package. +First, we need to define a function that returns twice the opposite of the log-likelihood for a given parameter set.

+ +

Nota: in the LogLikeGR4J() function, the computation of the log-likelihood is simplified in order to ensure a good computing performance. It corresponds to a translation of the two following lines.

+ +
Likelihood <- sum((ObsY - ModY)^2, na.rm = TRUE)^(-sum(!is.na(ObsY)) / 2)
+LogLike <- -2 * log(Likelihood)
+
+

In our simplified setting of Gaussian likelihood with measurement error integrated out, the log of the sum of squared error is related to the log-likelihood.

+

Note that we do not use here any discharge transformation, although applying Box-Cox transformation is quite popular in hydrological modelling.

- -
-
-
+ +
LogLikeGR4J <- function(ParamOptim) {
+  ## Transformation to real space
+  RawParamOptim <- airGR::TransfoParam_GR4J(ParamIn = ParamOptim,
+                                              Direction = "TR")
+  ## Simulation given a parameter set
+  OutputsModel <- airGR::RunModel_GR4J(InputsModel = InputsModel,
+                                       RunOptions = RunOptions,
+                                       Param = RawParamOptim)
+  ## Computation of the log-likelihood: N * log(SS)
+  ObsY <- InputsCrit$Obs
+  ModY <- OutputsModel$Qsim
+  LogLike <- sum(!is.na(ObsY)) * log(sum((ObsY - ModY)^2, na.rm = TRUE))
+}
+
+

MCMC algorithm for Bayesian inference

-
+

Estimation of the best-fit parameters as a starting point

+

We start by using the PORT optimization routine to estimate the best-fit parameters.

- -
-
+ +
optPORT <- stats::nlminb(start = c(4.1, 3.9, -0.9, -8.7),
+                         objective = LogLikeGR4J,
+                         lower = rep(-9.9, times = 4), upper = rep(9.9, times = 4),
+                         control = list(trace = 1))
+iniParPORT <- optPORT$par
+
+

Running 3 chains for convergence assessment

-

We run 3 chains with different initial values to assess the convergence of the Markov chains. The number of iterations is fixed to 2000 with a burning length of 0.

+ +

We run 3 chains with different initial values to assess the convergence of the Markov chains. +The number of iterations is fixed to 2000 with a burning length of 0.

+

Nota: in this example, there are relatively few iterations (2000), in order to limit the running time of this vignette. In addition, the burning length has been set to zero in order to show the convergence process but, in a true exercise, it is better to define more iterations (5000) and to burn the first iterations.

+

With the DRAM algorithm, the covariance of the proposal is updated every 100 runs and delayed rejection is applied.

- -
-
+ +
iniParPORT <- data.frame(Chain1 = iniParPORT, Chain2 = iniParPORT, Chain3 = iniParPORT,
+                           row.names = paste0("X", 1:4))
+iniParPORT <- sweep(iniParPORT, MARGIN = 2, STATS = c(1, 0.9, 1.1), FUN = "*")
+iniParPORT[iniParPORT < -9.9] <- -9.9
+iniParPORT[iniParPORT > +9.9] <- +9.9
+
+mcmcDRAM <- apply(iniParPORT, MARGIN = 2, FUN = function(iIniParPORT) {
+  FME::modMCMC(f            = LogLikeGR4J,
+               p            = iIniParPORT,
+               lower        = rep(-9.9, times = 4), ## lower bounds for GR4J
+               upper        = rep(+9.9, times = 4), ## upper bounds for GR4J
+               niter        = 2000,
+               jump         = 0.01,
+               outputlength = 2000,
+               burninlength = 0,
+               updatecov    = 100, ## Adaptative Metropolis
+               ntrydr       = 2)   ## Delayed Rejection
+})
+
+

MCMC diagnostics and visualisation tools

-

There are several diagnostics that can be used to check the convergence of the chains. The R package coda provides several diagnostic tests.

-

Among others, the Gelman and Rubin’s convergence can be used. A value close to 1 suggests acceptable convergence. The result will be better with more iterations than 2000. As we kept the iterations during the convergence process, we have to set the autoburnin argument to TRUE in order to consider only the second half of the series.

+ +

There are several diagnostics that can be used to check the convergence of the chains. +The R package coda provides several diagnostic tests.

+ +

Among others, the Gelman and Rubin's convergence can be used. A value close to 1 suggests acceptable convergence. +The result will be better with more iterations than 2000. As we kept the iterations during the convergence process, we have to set the autoburnin argument to TRUE in order to consider only the second half of the series.

+

Note that we rescale model parameter sets of the GR4J model from the transformed space to the real space.

- - -
## [1] 1.062202
+ +
multDRAM <- coda::as.mcmc.list(lapply(mcmcDRAM, FUN = function(x) {
+  coda::as.mcmc(airGR::TransfoParam_GR4J(as.matrix(x$pars), Direction = "TR"))
+  }))
+gelRub <- coda::gelman.diag(multDRAM, autoburnin = TRUE)$mpsrf
+
+ +
gelRub
+
+ +
## [1] 1.062202
+
+

In addition, graphical tools can be used, with for example the ggmcmc package.

+

First, the evolution of the Markov chains can be seen with a traceplot:

- -

+ +
parDRAM <- ggmcmc::ggs(multDRAM) ## to convert objet for using by all ggs_* graphical functions
+ggmcmc::ggs_traceplot(parDRAM)
+
+ +

plot of chunk unnamed-chunk-9

+

The posterior density for each parameter can then be visualised:

- -

-

Finally, a paired plot can be useful to look at the correlation between parameters. Highly correlated parameters can be seen as an indication for a structural deficit of the model used.

- -

-
-
-

Exploring further possibilities

-

We only presented one MCMC algorithm and one parameter inference setting. Nonetheless, other approaches can be explored within the same framework.

-

One can for example use different data transformations to deal with the limitations of the Gaussian error model.

- -
-
+
burnParDRAM <- dplyr::filter(parDRAM, Iteration > 1000) # to keep only the second half of the series
+ggmcmc::ggs_density(burnParDRAM)
+
+

plot of chunk unnamed-chunk-10

- +

Finally, a paired plot can be useful to look at the correlation between parameters. +Highly correlated parameters can be seen as an indication for a structural deficit of the model used.

+
ggmcmc::ggs_pairs(burnParDRAM, lower = list(continuous = "density"))
+
- - +

plot of chunk unnamed-chunk-11

+ +

Exploring further possibilities

+ +

We only presented one MCMC algorithm and one parameter inference setting. +Nonetheless, other approaches can be explored within the same framework.

+ +

One can for example use different data transformations to deal with the limitations of the Gaussian error model.

+ + + diff -Nru airgr-1.6.9.27/inst/doc/V03_param_sets_GR4J.html airgr-1.6.10.4/inst/doc/V03_param_sets_GR4J.html --- airgr-1.6.9.27/inst/doc/V03_param_sets_GR4J.html 2021-01-22 10:35:17.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V03_param_sets_GR4J.html 2021-01-29 07:26:48.000000000 +0000 @@ -1,454 +1,367 @@ - - + - - - +Introduction - + + + + + -Generalist parameter sets for the GR4J model - - - - - +tt, code, pre { + font-family: 'DejaVu Sans Mono', 'Droid Sans Mono', 'Lucida Console', Consolas, Monaco, monospace; +} +h1 { + font-size:2.2em; +} +h2 { + font-size:1.8em; +} +h3 { + font-size:1.4em; +} - - +

Introduction

+

Scope

+

In the airGR package, the classical way to calibrate a model is to use the Michel's algorithm (see the Calibration_Michel() function).

+

The Michel's algorithm combines a global and a local approach. A screening is first performed either based on a rough predefined grid (considering various initial values for each parameter) or from a list of initial parameter sets. +The best set identified in this screening is then used as a starting point for the steepest descent local search algorithm.

-

Generalist parameter sets for the GR4J model

- +

In some specific situations, for example if the calibration period is too short and by consequence non representative of the catchment behaviour, a local calibration algorithm can give poor results.

+

In this vignette, we show a method using a known parameter set that can be used as an alternative for the grid-screening calibration procedure, and we well compare to two methods using the Calibration_Michel() function. The generalist parameters sets introduced here are taken from @andreassian_seeking_2014.

-
-

Introduction

-
-

Scope

-

In the airGR package, the classical way to calibrate a model is to use the Michel’s algorithm (see the Calibration_Michel() function).

-

The Michel’s algorithm combines a global and a local approach. A screening is first performed either based on a rough predefined grid (considering various initial values for each parameter) or from a list of initial parameter sets. The best set identified in this screening is then used as a starting point for the steepest descent local search algorithm.

-

In some specific situations, for example if the calibration period is too short and by consequence non representative of the catchment behaviour, a local calibration algorithm can give poor results.

-

In this vignette, we show a method using a known parameter set that can be used as an alternative for the grid-screening calibration procedure, and we well compare to two methods using the Calibration_Michel() function. The generalist parameters sets introduced here are taken from Andréassian et al. (2014).

-
-

Data preparation

+

We load an example data set from the package and the GR4J parameter sets.

- -

The given GR4J X4u variable does not correspond to the actual GR4J X4 parameter. As explained in Andréassian et al. (2014, sec. 2.1), the given GR4J X4u value has to be adjusted (rescaled) using catchment area (S) [km2] as follows: X4 = X4u / 5.995 * S^0.3 (please= note that the formula is erroneous in the publication).

+ +
## loading catchment data
+data(L0123001)
+
+## loading generalist parameter sets
+data(Param_Sets_GR4J)
+
+ +

The given GR4J X4u variable does not correspond to the actual GR4J X4 parameter. As explained in @andreassian_seeking_2014 [section 2.1], the given GR4J X4u value has to be adjusted (rescaled) using catchment area (S) [km2] as follows: X4 = X4u / 5.995 * S^0.3 (please= note that the formula is erroneous in the publication).

+

It means we need first to transform the X4 parameter.

- + +
Param_Sets_GR4J$X4 <- Param_Sets_GR4J$X4u / 5.995 * BasinInfo$BasinArea^0.3
+Param_Sets_GR4J$X4u <- NULL
+Param_Sets_GR4J <- as.matrix(Param_Sets_GR4J)
+
+

Please, find below the summary of the 27 sets of the 4 parameters.

+ 
##        X1             X2              X3            X4      
 ##  Min.   : 126   Min.   :-54.5   Min.   :  8   Min.   :1.21  
 ##  1st Qu.: 208   1st Qu.: -2.0   1st Qu.: 35   1st Qu.:1.75  
 ##  Median : 291   Median : -1.1   Median : 76   Median :2.10  
 ##  Mean   : 471   Mean   : -3.4   Mean   : 90   Mean   :2.09  
 ##  3rd Qu.: 359   3rd Qu.: -0.6   3rd Qu.:106   3rd Qu.:2.45  
-##  Max.   :4006   Max.   :  0.8   Max.   :318   Max.   :3.47
-
-
+## Max. :4006 Max. : 0.8 Max. :318 Max. :3.47 + +

Object model preparation

+

We assume that the R global environment contains data and functions from the Get Started vignette.

+

The calibration period has been defined from 1990-01-01 to 1990-02-28, and the validation period from 1990-03-01 to 1999-12-31.

+

As a consequence, in this example the calibration period is very short, less than 6 months.

- -
-
-
+ +
## preparation of the InputsModel object
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, 
+                                 Precip = BasinObs$P, PotEvap = BasinObs$E)
+
+## ---- calibration step
+
+## short calibration period selection (< 6 months)
+Ind_Cal <- seq(which(format(BasinObs$DatesR, format = "%d/%m/%Y %H:%M")=="01/01/1990 00:00"), 
+               which(format(BasinObs$DatesR, format = "%d/%m/%Y %H:%M")=="28/02/1990 00:00"))
+
+## preparation of the RunOptions object for the calibration period
+RunOptions_Cal <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+                               InputsModel = InputsModel, IndPeriod_Run = Ind_Cal)
+
+## efficiency criterion: Nash-Sutcliffe Efficiency
+InputsCrit_Cal  <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel, 
+                                    RunOptions = RunOptions_Cal, Obs = BasinObs$Qmm[Ind_Cal])
+
+
+## ---- validation step
+
+## validation period selection
+Ind_Val <- seq(which(format(BasinObs$DatesR, format = "%d/%m/%Y %H:%M")=="01/03/1990 00:00"), 
+               which(format(BasinObs$DatesR, format = "%d/%m/%Y %H:%M")=="31/12/1999 00:00"))
+
+## preparation of the RunOptions object for the validation period
+RunOptions_Val <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+                                   InputsModel = InputsModel, IndPeriod_Run = Ind_Val)
+
+## efficiency criterion (Nash-Sutcliffe Efficiency) on the validation period
+InputsCrit_Val  <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModel, 
+                                RunOptions = RunOptions_Val, Obs = BasinObs$Qmm[Ind_Val])
+
+

Calibration of the GR4J model with the generalist parameter sets

+

It is recommended to use the generalist parameter sets when the calibration period is less than 6 months.

-

As shown in Andréassian et al. (2014, fig. 4), a recommended way to use the Param_Sets_GR4J data.frame is to run the GR4J model with each parameter set and to select the best one according to an objective function (here we use the Nash-Sutcliffe Efficiency criterion).

- + +

As shown in @andreassian_seeking_2014 [figure 4], a recommended way to use the Param_Sets_GR4J data.frame is to run the GR4J model with each parameter set and to select the best one according to an objective function (here we use the Nash-Sutcliffe Efficiency criterion).

+ +
OutputsCrit_Loop <- apply(Param_Sets_GR4J, 1, function(iParam) {
+  OutputsModel_Cal <- RunModel_GR4J(InputsModel = InputsModel, RunOptions = RunOptions_Cal,
+                                    Param = iParam)
+  OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit_Cal, OutputsModel = OutputsModel_Cal)
+  return(OutputsCrit$CritValue)
+})
+
+

Find below the 27 criteria corresponding to the different parameter sets.

-

The criterion values are quite low (from -1.639 to 0.336), which can be expected as this does not represents an actual calibration.

+ +

The criterion values are quite low (from -1.639 to 0.336), which can be expected as this does not represents an actual calibration.

+ 
##  [1]  0.0573  0.1331 -0.0168  0.1613  0.0345  0.1046 -0.0458  0.3359  0.2440
 ## [10] -0.3858 -0.0830 -1.0930  0.2843  0.2792  0.1505 -0.0209 -0.0825  0.1298
-## [19]  0.2903 -0.1188 -0.3834 -0.0836  0.0279 -0.0488 -0.1675  0.1719 -1.6386
+## [19] 0.2903 -0.1188 -0.3834 -0.0836 0.0279 -0.0488 -0.1675 0.1719 -1.6386 + +

The parameter set corresponding to the best criterion is the following:

+ 
##     X1     X2     X3     X4 
-## 291.00   0.30 109.10   2.01
+## 291.00 0.30 109.10 2.01 + +

Now we can compute the Nash-Sutcliffe Efficiency criterion on the validation period. A quite good value (0.777) is found.

-
-
+

Calibration of the GR4J model with the built-in Calibration_Michel() function

-

As seen above, the Michel’s calibration algorithm is based on a local search procedure.

-

It is not recommanded to use the Calibration_Michel() function when the calibration period is less than 6 month. We will show below its application on the same short period for two configurations of the grid-screening step to demonstrate that it is less efficient than the generalist parameters sets calibration.

-
+ +

As seen above, the Michel's calibration algorithm is based on a local search procedure.

+ +

It is not recommanded to use the Calibration_Michel() function when the calibration period is less than 6 month. +We will show below its application on the same short period for two configurations of the grid-screening step to demonstrate that it is less efficient than the generalist parameters sets calibration.

+

GR4J parameter distributions quantiles used in the grid-screening step

+

By default, the predefined grid used by the Calibration_Michel() function contains parameters quantiles computed after recursive calibrations on 1200 basins (from Australia, France and USA).

- + +
CalibOptions <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel)
+
+

The parameter set corresponding to the best criterion is the following:

+ 
##     X1     X2     X3     X4 
-## 165.05   6.46 422.50   2.45
-

The Nash-Sutcliffe Efficiency criterion computed on the calibration period is better (0.495) than with the generalist parameter sets, but the one computed on the validation period is lower (0.57). This shows that the generalist parameter sets give more robust model in this case.

-
-
+## 165.05 6.46 422.50 2.45 + + +

The Nash-Sutcliffe Efficiency criterion computed on the calibration period is better (0.495) than with the generalist parameter sets, but the one computed on the validation period is lower (0.57). +This shows that the generalist parameter sets give more robust model in this case.

+

GR4J parameter sets used in the grid-screening step

-

It is also possible to give to the CreateCalibOptions() function a matrix of parameter sets used for the grid-screening calibration procedure. So, it possible is to use by this way the GR4J generalist parameter sets.

- + +

It is also possible to give to the CreateCalibOptions() function a matrix of parameter sets used for the grid-screening calibration procedure. +So, it possible is to use by this way the GR4J generalist parameter sets.

+ +
CalibOptions <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel,
+                                   StartParamList = Param_Sets_GR4J)
+
+

Here is the parameter set corresponding to the best criteria found.

+ 
##     X1     X2     X3     X4 
-## 161.62   6.53 429.00   2.45
-

The results are the same here. The Nash-Sutcliffe Efficiency criterion computed on the calibration period is better (0.495), but the one computed on the validation period is just a little bit lower (0.568) than the classical calibration.

-

Generally, the advantage of using GR4J parameter sets rather than the GR4J generalist parameter quantiles is that they make more sense than a simple exploration of combinations of quantiles of parameter distributions (each parameter set represents a consistent ensemble). In addition, for the first step, the number of iterations is smaller (27 runs instead of 81), which can save time if one wants to run a very large number of calibrations.

-
-
-
-

References

-
-
-

Andréassian, Vazken, François Bourgin, Ludovic Oudin, Thibault Mathevet, Charles Perrin, Julien Lerat, Laurent Coron, and Lionel Berthet. 2014. “Seeking Genericity in the Selection of Parameter Sets: Impact on Hydrological Model Efficiency.” Water Resources Research 50 (10): 8356–66. https://doi.org/10.1002/2013WR014761.

-
-
-
+## 161.62 6.53 429.00 2.45 + +

The results are the same here. The Nash-Sutcliffe Efficiency criterion computed on the calibration period is better (0.495), but the one computed on the validation period is just a little bit lower (0.568) than the classical calibration.

+

Generally, the advantage of using GR4J parameter sets rather than the GR4J generalist parameter quantiles is that they make more sense than a simple exploration of combinations of quantiles of parameter distributions (each parameter set represents a consistent ensemble). In addition, for the first step, the number of iterations is smaller (27 runs instead of 81), which can save time if one wants to run a very large number of calibrations.

- - - - - +

References

+ diff -Nru airgr-1.6.9.27/inst/doc/V03_param_sets_GR4J.Rmd airgr-1.6.10.4/inst/doc/V03_param_sets_GR4J.Rmd --- airgr-1.6.9.27/inst/doc/V03_param_sets_GR4J.Rmd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V03_param_sets_GR4J.Rmd 2021-01-28 21:13:47.000000000 +0000 @@ -1,5 +1,6 @@ --- title: "Generalist parameter sets for the GR4J model" +author: "Olivier Delaigue, Guillaume Thirel" bibliography: V00_airgr_ref.bib output: rmarkdown::html_vignette vignette: > diff -Nru airgr-1.6.9.27/inst/doc/V04_cemaneige_hysteresis.html airgr-1.6.10.4/inst/doc/V04_cemaneige_hysteresis.html --- airgr-1.6.9.27/inst/doc/V04_cemaneige_hysteresis.html 2021-01-22 10:35:18.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V04_cemaneige_hysteresis.html 2021-01-29 07:26:48.000000000 +0000 @@ -1,416 +1,329 @@ - - + - - - +Introduction - + + + + + -Using satellite snow cover area data for calibrating and improving CemaNeige - - - - - +tt, code, pre { + font-family: 'DejaVu Sans Mono', 'Droid Sans Mono', 'Lucida Console', Consolas, Monaco, monospace; +} +h1 { + font-size:2.2em; +} +h2 { + font-size:1.8em; +} +h3 { + font-size:1.4em; +} - - +

Introduction

+

Scope

+

Rainfall-runoff models that include a snow accumulation and melt module are still often calibrated using only discharge observations. This can result in poor snow modeling as the swnow module parameters can distorted in order to allow skilful discharge simulation.

+

After the work of @riboust_revisiting_2019, we propose now in airGR an improved version of the degree-day CemaNeige snow and accumulation module. This new version is based on a more accurate representation of the relationship that exists at the basin scale between the Snow Water Equivalent (SWE) and the Snow Cover Area (SCA). To do so, a linear SWE-SCA hysteresis, which represents the fact that snow accumulation is rather homogeneous on the basin and snow melt is more heterogeneous, was implemented.

-

Using satellite snow cover area data for calibrating and improving CemaNeige

+

This new CemaNeige version has two more parameters to calibrate. It also presents the advantage of allowing using satellite snow data to constrain the calibration in addition to discharge. +@riboust_revisiting_2019 show that while the simulated discharge is not significantly improved, the snow simulation is much improved. In addition, they show that the model is more robust (i.e. transferable in time) in terms of discharge, which has many implications for climate change impact studies.

+

The configuration that was identified as optimal by @riboust_revisiting_2019 includes a CemaNeige module run on 5 elevation bands and an objective function determine by a composite function of KGE' calculated on discharge (75 % weight) and KGE' calculated on each elevation band (5 % for each).

+

In this page, we show how to use and calibrate this new CemaNeige version.

-
-

Introduction

-
-

Scope

-

Rainfall-runoff models that include a snow accumulation and melt module are still often calibrated using only discharge observations. This can result in poor snow modeling as the swnow module parameters can distorted in order to allow skilful discharge simulation.

-

After the work of Riboust et al. (2019), we propose now in airGR an improved version of the degree-day CemaNeige snow and accumulation module. This new version is based on a more accurate representation of the relationship that exists at the basin scale between the Snow Water Equivalent (SWE) and the Snow Cover Area (SCA). To do so, a linear SWE-SCA hysteresis, which represents the fact that snow accumulation is rather homogeneous on the basin and snow melt is more heterogeneous, was implemented.

-

This new CemaNeige version has two more parameters to calibrate. It also presents the advantage of allowing using satellite snow data to constrain the calibration in addition to discharge. Riboust et al. (2019) show that while the simulated discharge is not significantly improved, the snow simulation is much improved. In addition, they show that the model is more robust (i.e. transferable in time) in terms of discharge, which has many implications for climate change impact studies.

-

The configuration that was identified as optimal by Riboust et al. (2019) includes a CemaNeige module run on 5 elevation bands and an objective function determine by a composite function of KGE’ calculated on discharge (75 % weight) and KGE’ calculated on each elevation band (5 % for each).

-

In this page, we show how to use and calibrate this new CemaNeige version.

-
-

Data preparation

-

We load an example data set from the package. Please note that this data set includes MODIS data that was pre-calculated for 5 elevation bands and for which days with few data (more than 40 % cloud coverage) were assigned as missing values.

-
-
+ +

We load an example data set from the package. Please note that this data set includes MODIS data that was pre-calculated for 5 elevation bands and for which days with few data (more than 40 % cloud coverage) were assigned as missing values.

+

loading catchment data

- -
- -
-
+ +
## preparation of the InputsModel object
+InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeigeGR4J,
+                                 DatesR = BasinObs$DatesR, Precip = BasinObs$P,
+                                 PotEvap = BasinObs$E, TempMean = BasinObs$T,
+                                 ZInputs = median(BasinInfo$HypsoData),
+                                 HypsoData = BasinInfo$HypsoData, NLayers = 5)
+
+## ---- calibration step
+
+## calibration period selection
+Ind_Cal <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "2000-09-01"), 
+               which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "2005-08-31"))
+
+
+## ---- validation step
+
+## validation period selection
+Ind_Val <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "2005-09-01"), 
+               which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "2010-07-31"))
+
+

Calibration and evaluation of the new CemaNeige module

-

In order to use the Linear Hysteresis, a new argument (IsHyst) is added in the CreateRunOptions() and CreateCalibOptions() functions and has to be set to TRUE.

- -

In order to calibrate and assess the model performance, we will follow the recommendations of Riboust et al. (2019). This is now possible in airGR with the added functionality that permits calculating composite criteria by combining different metrics.

- + +

In order to use the Linear Hysteresis, a new argument (IsHyst) is added in the CreateRunOptions() and CreateCalibOptions() functions and has to be set to TRUE.

+ +
## preparation of the RunOptions object for the calibration period
+RunOptions_Cal <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J,
+                                   InputsModel = InputsModel, IndPeriod_Run = Ind_Cal,
+                                   IsHyst = TRUE)
+
+## preparation of the RunOptions object for the validation period
+RunOptions_Val <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J,
+                                   InputsModel = InputsModel, IndPeriod_Run = Ind_Val,
+                                   IsHyst = TRUE)
+
+## preparation of the CalibOptions object
+CalibOptions <- CreateCalibOptions(FUN_MOD = RunModel_CemaNeigeGR4J,
+                                   FUN_CALIB = Calibration_Michel,
+                                   IsHyst = TRUE)
+
+ +

In order to calibrate and assess the model performance, we will follow the recommendations of @riboust_revisiting_2019. This is now possible in airGR with the added functionality that permits calculating composite criteria by combining different metrics.

+ +
## efficiency criterion: 75 % KGE'(Q) + 5 % KGE'(SCA) on each of the 5 layers
+InputsCrit_Cal  <- CreateInputsCrit(FUN_CRIT = rep("ErrorCrit_KGE2", 6),
+                                    InputsModel = InputsModel, RunOptions = RunOptions_Cal,
+                                    Obs = list(BasinObs$Qmm[Ind_Cal],
+                                               BasinObs$SCA1[Ind_Cal],
+                                               BasinObs$SCA2[Ind_Cal],
+                                               BasinObs$SCA3[Ind_Cal],
+                                               BasinObs$SCA4[Ind_Cal],
+                                               BasinObs$SCA5[Ind_Cal]),
+                                    VarObs = list("Q", "SCA", "SCA", "SCA", "SCA", "SCA"),
+                                    Weights = list(0.75, 0.05, 0.05, 0.05, 0.05, 0.05))
+
+InputsCrit_Val  <- CreateInputsCrit(FUN_CRIT = rep("ErrorCrit_KGE2", 6),
+                                    InputsModel = InputsModel, RunOptions = RunOptions_Val,
+                                    Obs = list(BasinObs$Qmm[Ind_Val],
+                                               BasinObs$SCA1[Ind_Val],
+                                               BasinObs$SCA2[Ind_Val],
+                                               BasinObs$SCA3[Ind_Val],
+                                               BasinObs$SCA4[Ind_Val],
+                                               BasinObs$SCA5[Ind_Val]),
+                                    VarObs = list("Q", "SCA", "SCA", "SCA", "SCA", "SCA"),
+                                    Weights = list(0.75, 0.05, 0.05, 0.05, 0.05, 0.05))
+
+

We can now calibrate the model.

- -

Now we can run it on the calibration period and assess it.

- -

Find below the performance of the model over the calibration period.

- + +
## calibration
+OutputsCalib <- Calibration(InputsModel = InputsModel, RunOptions = RunOptions_Cal,
+                            InputsCrit = InputsCrit_Cal, CalibOptions = CalibOptions,
+                            FUN_MOD = RunModel_CemaNeigeGR4J,
+                            FUN_CALIB = Calibration_Michel)
+
+ +

Now we can run it on the calibration period and assess it.

+ +
## run on the calibration period
+OutputsModel_Cal <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
+                                           RunOptions = RunOptions_Cal, 
+                                           Param = OutputsCalib$ParamFinalR)
+
+## evaluation 
+OutputsCrit_Cal <- ErrorCrit(InputsCrit = InputsCrit_Cal, OutputsModel = OutputsModel_Cal)
+
+ +

Find below the performance of the model over the calibration period.

+ +
str(OutputsCrit_Cal, max.level = 2)
+
+ 
## List of 7
 ##  $ CritValue      : num 0.899
 ##  $ CritName       : chr "Composite"
@@ -437,17 +350,25 @@
 ##   .. ..- attr(*, "class")= chr [1:2] "KGE2" "ErrorCrit"
 ##   ..$ IC6:List of 7
 ##   .. ..- attr(*, "class")= chr [1:2] "KGE2" "ErrorCrit"
-##  - attr(*, "class")= chr [1:2] "Compo" "ErrorCrit"
-

Now we can run the model on the validation period and assess it.

- -

Find below the performance of the model over the validation period.

- +## - attr(*, "class")= chr [1:2] "Compo" "ErrorCrit" + + +

Now we can run the model on the validation period and assess it.

+ +
## run on the validation period
+OutputsModel_Val <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
+                                           RunOptions = RunOptions_Val, 
+                                           Param = OutputsCalib$ParamFinalR)
+
+## evaluation 
+OutputsCrit_Val <- ErrorCrit(InputsCrit = InputsCrit_Val, OutputsModel = OutputsModel_Val)
+
+ +

Find below the performance of the model over the validation period.

+ +
str(OutputsCrit_Val, max.level = 2)
+
+ 
## List of 7
 ##  $ CritValue      : num 0.903
 ##  $ CritName       : chr "Composite"
@@ -474,55 +395,71 @@
 ##   .. ..- attr(*, "class")= chr [1:2] "KGE2" "ErrorCrit"
 ##   ..$ IC6:List of 7
 ##   .. ..- attr(*, "class")= chr [1:2] "KGE2" "ErrorCrit"
-##  - attr(*, "class")= chr [1:2] "Compo" "ErrorCrit"
-
-
+## - attr(*, "class")= chr [1:2] "Compo" "ErrorCrit" + +

Comparison with the performance of the initial CemaNeige version

-

Here we use the same InputsModel object and calibration and validation periods. However, we have to redefine the way we run the model (RunOptions argument), calibrate and assess it (InputsCrit argument). The objective function is only based on KGE’(Q). Note how we set the IsHyst argument to FALSE in the CreateRunOptions() and the CreateCalibOptions() functions.

- + +

Here we use the same InputsModel object and calibration and validation periods. However, we have to redefine the way we run the model (RunOptions argument), calibrate and assess it (InputsCrit argument). The objective function is only based on KGE'(Q). Note how we set the IsHyst argument to FALSE in the CreateRunOptions() and the CreateCalibOptions() functions.

+ +
## preparation of RunOptions object
+RunOptions_Cal_NoHyst <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J,
+                                          InputsModel = InputsModel,
+                                          IndPeriod_Run = Ind_Cal,
+                                          IsHyst = FALSE)
+
+RunOptions_Val_NoHyst <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J,
+                                          InputsModel = InputsModel, 
+                                          IndPeriod_Run = Ind_Val,
+                                          IsHyst = FALSE)
+
+InputsCrit_Cal_NoHyst <- CreateInputsCrit(FUN_CRIT = ErrorCrit_KGE2,
+                                          InputsModel = InputsModel,
+                                          RunOptions = RunOptions_Cal_NoHyst,
+                                          Obs = BasinObs$Qmm[Ind_Cal], VarObs = "Q")
+
+## preparation of CalibOptions object
+CalibOptions_NoHyst <- CreateCalibOptions(FUN_MOD = RunModel_CemaNeigeGR4J,
+                                          FUN_CALIB = Calibration_Michel,
+                                          IsHyst = FALSE)
+
+

We can now calibrate the model.

- -

And run it over the calibration and validation periods.

- + +
## calibration
+OutputsCalib_NoHyst <- Calibration(InputsModel = InputsModel,
+                                   InputsCrit = InputsCrit_Cal_NoHyst,
+                                   RunOptions = RunOptions_Cal_NoHyst,
+                                   CalibOptions = CalibOptions_NoHyst,
+                                   FUN_MOD = RunModel_CemaNeigeGR4J,
+                                   FUN_CALIB = Calibration_Michel)
+
+ +

And run it over the calibration and validation periods.

+ +
OutputsModel_Cal_NoHyst <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
+                                                  RunOptions = RunOptions_Cal_NoHyst,  
+                                                  Param = OutputsCalib_NoHyst$ParamFinalR)
+
+OutputsModel_Val_NoHyst <- RunModel_CemaNeigeGR4J(InputsModel = InputsModel,
+                                                  RunOptions = RunOptions_Val_NoHyst, 
+                                                  Param = OutputsCalib_NoHyst$ParamFinalR)
+
+

In order to assess the model performance over the two periods, we will use the InputsCrit objects prepared before, which allow assessing also the performance in terms of snow simulation.

- + +
OutputsCrit_Cal_NoHyst <- ErrorCrit(InputsCrit = InputsCrit_Cal,
+                                    OutputsModel = OutputsModel_Cal_NoHyst)
+
+OutputsCrit_Val_NoHyst <- ErrorCrit(InputsCrit = InputsCrit_Val,
+                                    OutputsModel = OutputsModel_Val_NoHyst)
+
+

We can check the performance over the calibration and the validation period.

- + +
str(OutputsCrit_Cal_NoHyst, max.level = 2)
+
+ 
## List of 7
 ##  $ CritValue      : num 0.836
 ##  $ CritName       : chr "Composite"
@@ -549,8 +486,12 @@
 ##   .. ..- attr(*, "class")= chr [1:2] "KGE2" "ErrorCrit"
 ##   ..$ IC6:List of 7
 ##   .. ..- attr(*, "class")= chr [1:2] "KGE2" "ErrorCrit"
-##  - attr(*, "class")= chr [1:2] "Compo" "ErrorCrit"
- +## - attr(*, "class")= chr [1:2] "Compo" "ErrorCrit" + + +
str(OutputsCrit_Val_NoHyst, max.level = 2)
+
+ 
## List of 7
 ##  $ CritValue      : num 0.773
 ##  $ CritName       : chr "Composite"
@@ -577,32 +518,14 @@
 ##   .. ..- attr(*, "class")= chr [1:2] "KGE2" "ErrorCrit"
 ##   ..$ IC6:List of 7
 ##   .. ..- attr(*, "class")= chr [1:2] "KGE2" "ErrorCrit"
-##  - attr(*, "class")= chr [1:2] "Compo" "ErrorCrit"
-

We can see above that the performance of the initial model is slightly better than the new one over the calibration period in terms of discharge, but also that the new version calibrated using SCA provides better performance in terms of snow. However, over the validation period, we see that the discharge simulated by the new version brings better performance (in addition to improved SCA also). This shows the interests of the combined use of a linear hysteresis and of SCA data for calibration in CemaNeige.

-
-
-

References

-
-
-

Riboust, Philippe, Guillaume Thirel, Nicolas Le Moine, and Pierre Ribstein. 2019. “Revisiting a Simple Degree-Day Model for Integrating Satellite Data: Implementation of Swe-Sca Hystereses.” Journal of Hydrology and Hydromechanics 67 (1): 70–81. https://doi.org/10.2478/johh-2018-0004.

-
-
-
- +## - attr(*, "class")= chr [1:2] "Compo" "ErrorCrit" + +

We can see above that the performance of the initial model is slightly better than the new one over the calibration period in terms of discharge, but also that the new version calibrated using SCA provides better performance in terms of snow. +However, over the validation period, we see that the discharge simulated by the new version brings better performance (in addition to improved SCA also). This shows the interests of the combined use of a linear hysteresis and of SCA data for calibration in CemaNeige.

- - - - - +

References

+ diff -Nru airgr-1.6.9.27/inst/doc/V04_cemaneige_hysteresis.Rmd airgr-1.6.10.4/inst/doc/V04_cemaneige_hysteresis.Rmd --- airgr-1.6.9.27/inst/doc/V04_cemaneige_hysteresis.Rmd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V04_cemaneige_hysteresis.Rmd 2021-01-28 21:14:06.000000000 +0000 @@ -1,5 +1,6 @@ --- title: "Using satellite snow cover area data for calibrating and improving CemaNeige" +author: "Guillaume Thirel, Olivier Delaigue" bibliography: V00_airgr_ref.bib output: rmarkdown::html_vignette vignette: > diff -Nru airgr-1.6.9.27/inst/doc/V05_sd_model.html airgr-1.6.10.4/inst/doc/V05_sd_model.html --- airgr-1.6.9.27/inst/doc/V05_sd_model.html 2021-01-22 10:35:22.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V05_sd_model.html 2021-01-29 07:26:52.000000000 +0000 @@ -1,345 +1,246 @@ - - + - - - +Introduction - + - + + + + -Simulating a reservoir with semi-distributed GR4J model - - - - - +tt, code, pre { + font-family: 'DejaVu Sans Mono', 'Droid Sans Mono', 'Lucida Console', Consolas, Monaco, monospace; +} +h1 { + font-size:2.2em; +} +h2 { + font-size:1.8em; +} +h3 { + font-size:1.4em; +} - - - - - - -

Simulating a reservoir with semi-distributed GR4J model

-

David Dorchies

- - - -

Introduction

-
+

Scope

+

The airGR package implements semi-distributed model capabilities using a lag model between subcatchments. It allows to chain together several lumped models as well as integrating anthropogenic influence such as reservoirs or withdrawals.

+

RunModel_Lag documentation gives an example of simulating the influence of a reservoir in a lumped model. Try example(RunModel_Lag) to get it.

+

In this vignette, we show how to calibrate 2 sub-catchments in series with a semi-distributed model consisting of 2 GR4J models. For doing this we compare two strategies for calibrating the downstream subcatchment:

+
  • using upstream observed flows
  • using upstream simulated flows
+

We finally compare these calibrations with a theoretical set of parameters.

-
-
+

Model description

+

We use an example data set from the package that unfortunately contains data for only one catchment.

- -

Let’s imagine that this catchment of 360 km² is divided into 2 subcatchments:

+ +
## loading catchment data
+data(L0123001)
+
+ +

Let's imagine that this catchment of 360 km² is divided into 2 subcatchments:

+
  • An upstream subcatchment of 180 km²
  • 100 km downstream another subcatchment of 180 km²
+

We consider that meteorological data are homogeneous on the whole catchment, so we use the same pluviometry BasinObs$P and the same evapotranspiration BasinObs$E for the 2 subcatchments.

+

For the observed flow at the downstream outlet, we generate it with the assumption that the upstream flow arrives at downstream with a constant delay of 2 days.

- + +
QObsDown <- (BasinObs$Qmm + c(0, 0, BasinObs$Qmm[1:(length(BasinObs$Qmm)-2)])) / 2
+summary(cbind(QObsUp = BasinObs$Qmm, QObsDown))
+
+ 
##      QObsUp       QObsDown  
 ##  Min.   : 0    Min.   : 0   
 ##  1st Qu.: 0    1st Qu.: 0   
@@ -347,27 +248,36 @@
 ##  Mean   : 1    Mean   : 1   
 ##  3rd Qu.: 2    3rd Qu.: 2   
 ##  Max.   :24    Max.   :20   
-##  NA's   :802   NA's   :820
-
-
-
+## NA's :802 NA's :820 + +

Calibration of the upstream subcatchment

+

The operations are exactly the same as the ones for a GR4J lumped model. So we do exactly the same operations as in the Get Started vignette.

- + +
InputsModelUp <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+                                   Precip = BasinObs$P, PotEvap = BasinObs$E)
+Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"),
+               which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31"))
+RunOptionsUp <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+                                 InputsModel = InputsModelUp
+                                 , IndPeriod_WarmUp = NULL, IndPeriod_Run = Ind_Run,
+                                 IniStates = NULL, IniResLevels = NULL)
+
+ 
## Warning in CreateRunOptions(FUN_MOD = RunModel_GR4J, InputsModel = InputsModelUp, : model warm up period not defined: default configuration used
-##   the year preceding the run period is used
- +## the year preceding the run period is used + + +
InputsCritUp <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelUp,
+                                 RunOptions = RunOptionsUp,
+                                 VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run])
+CalibOptionsUp <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel)
+OutputsCalibUp <- Calibration_Michel(InputsModel = InputsModelUp, RunOptions = RunOptionsUp,
+                                     InputsCrit = InputsCritUp, CalibOptions = CalibOptionsUp,
+                                     FUN_MOD = RunModel_GR4J)
+
+ 
## Grid-Screening in progress (0% 20% 40% 60% 80% 100%)
 ##   Screening completed (81 runs)
 ##       Param =  247.151,   -0.020,   83.096,    2.384
@@ -375,37 +285,58 @@
 ## Steepest-descent local search in progress
 ##   Calibration completed (21 iterations, 234 runs)
 ##       Param =  257.238,    1.012,   88.235,    2.208
-##       Crit. NSE[Q]       = 0.7988
+## Crit. NSE[Q] = 0.7988 + +

And see the result of the simulation:

- -
-
+ +
OutputsModelUp <- RunModel_GR4J(InputsModel = InputsModelUp, RunOptions = RunOptionsUp,
+                                Param = OutputsCalibUp$ParamFinalR)
+
+

Calibration of the downstream subcatchment with upstream flow observations

+

Observed flow data contain NA values and a complete time series is mandatory for running the Lag model. We propose to complete the observed upstream flow with linear interpolation:

- + +
QObsUp <- imputeTS::na_interpolation(BasinObs$Qmm)
+
+

we need to create the InputsModel object completed with upstream information:

- + +
InputsModelDown1 <- CreateInputsModel(
+  FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
+  Precip = BasinObs$P, PotEvap = BasinObs$E,
+  Qupstream = matrix(QObsUp, ncol = 1), # upstream observed flow
+  LengthHydro = 1e2 * 1e3, # distance between upstream catchment outlet & the downstream one [m]
+  BasinAreas = c(180, 180) # upstream and downstream areas [km²]
+)
+
+

And then calibrate the combination of Lag model for upstream flow transfer and GR4J model for the runoff of the downstream subcatchment:

- + +
RunOptionsDown <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
+                                   InputsModel = InputsModelDown1,
+                                   IndPeriod_WarmUp = NULL, IndPeriod_Run = Ind_Run,
+                                   IniStates = NULL, IniResLevels = NULL)
+
+ 
## Warning in CreateRunOptions(FUN_MOD = RunModel_GR4J, InputsModel = InputsModelDown1, : model warm up period not defined: default configuration used
-##   the year preceding the run period is used
- +## the year preceding the run period is used + + +
InputsCritDown <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelDown1,
+                                   RunOptions = RunOptionsDown,
+                                   VarObs = "Q", Obs = QObsDown[Ind_Run])
+CalibOptionsDown <- CreateCalibOptions(FUN_MOD = RunModel_GR4J,
+                                       FUN_CALIB = Calibration_Michel,
+                                       IsSD = TRUE) # specify that it's a SD model
+OutputsCalibDown1 <- Calibration_Michel(InputsModel = InputsModelDown1,
+                                        RunOptions = RunOptionsDown,
+                                        InputsCrit = InputsCritDown,
+                                        CalibOptions = CalibOptionsDown,
+                                        FUN_MOD = RunModel_GR4J)
+
+ 
## Grid-Screening in progress (0% 20% 40% 60% 80% 100%)
 ##   Screening completed (243 runs)
 ##       Param =   11.250,  247.151,   -0.020,   83.096,    2.384
@@ -413,25 +344,42 @@
 ## Steepest-descent local search in progress
 ##   Calibration completed (45 iterations, 675 runs)
 ##       Param =    2.560,  265.072,    0.970,   83.931,    4.648
-##       Crit. NSE[Q]       = 0.9489
+## Crit. NSE[Q] = 0.9489 + +

To run the complete model, we should substitute the observed upstream flow by the simulated one:

- + +
InputsModelDown2 <- InputsModelDown1
+InputsModelDown2$Qupstream[Ind_Run] <- OutputsModelUp$Qsim
+
+

RunModel is run in order to automatically combine GR4J and Lag models.

- + +
OutputsModelDown1 <- RunModel(InputsModel = InputsModelDown2,
+                              RunOptions = RunOptionsDown,
+                              Param = OutputsCalibDown1$ParamFinalR,
+                              FUN_MOD = RunModel_GR4J)
+
+

Performance of the model validation is then:

- -
## Crit. NSE[Q] = 0.8170
-
-
+ +
CritDown1 <- ErrorCrit_NSE(InputsCritDown, OutputsModelDown1)
+
+ +
## Crit. NSE[Q] = 0.8170
+
+

Calibration of the downstream subcatchment with upstream simulated flow

+

We calibrate the model with the InputsModel object previously created for substituting the observed upstream flow with the simulated one:

- + +
OutputsCalibDown2 <- Calibration_Michel(InputsModel = InputsModelDown2,
+                                        RunOptions = RunOptionsDown,
+                                        InputsCrit = InputsCritDown,
+                                        CalibOptions = CalibOptionsDown,
+                                        FUN_MOD = RunModel_GR4J)
+
+ 
## Grid-Screening in progress (0% 20% 40% 60% 80% 100%)
 ##   Screening completed (243 runs)
 ##       Param =   11.250,  247.151,   -0.020,   83.096,    2.384
@@ -439,84 +387,106 @@
 ## Steepest-descent local search in progress
 ##   Calibration completed (39 iterations, 616 runs)
 ##       Param =    1.970,  270.426,    0.822,   68.717,    5.214
-##       Crit. NSE[Q]       = 0.8185
- -
-
+## Crit. NSE[Q] = 0.8185 + + +
ParamDown2 <- OutputsCalibDown2$ParamFinalR
+
+

Discussion

-
+

Identification of Lag parameter

-

The theoretical LAG parameter should be equal to:

- -
## [1] "0.579 m/s"
+ +

The theoretical Lag parameter should be equal to:

+ +
Lag <- InputsModelDown1$LengthHydro / (2 * 86400)
+paste(format(Lag), "m/s")
+
+ +
## [1] "0.579 m/s"
+
+

Both calibrations overestimate this parameter:

- - - - + +
mLag <- matrix(c(Lag,
+                 OutputsCalibDown1$ParamFinalR[1],
+                 OutputsCalibDown2$ParamFinalR[1]),
+               ncol = 1,
+               dimnames = list(c("theoretical",
+                                 "calibrated with observed upstream flow",
+                                 "calibrated with simulated  upstream flow"),
+                               c("Lag parameter")))
+knitr::kable(mLag)
+
+ +
+ - - - + + - + - - + + - -
Lag parameter
theoretical 0.579
calibrated with observed upstream flow 2.560
calibrated with simulated upstream flow
calibrated with simulated upstream flow 1.970
-
-
+ +

Value of the performance criteria with theoretical calibration

+

Theoretically, the parameters of the downstream GR4J model should be the same as the upstream one and we know the lag time. So this set of parameter should give a better performance criteria:

- -
## Crit. NSE[Q] = 0.8159
-
-
+ +
ParamDownTheo <- c(Lag, OutputsCalibUp$ParamFinalR)
+OutputsModelDownTheo <- RunModel(InputsModel = InputsModelDown2,
+                              RunOptions = RunOptionsDown,
+                              Param = ParamDownTheo,
+                              FUN_MOD = RunModel_GR4J)
+CritDownTheo <- ErrorCrit_NSE(InputsCritDown, OutputsModelDownTheo)
+
+ +
## Crit. NSE[Q] = 0.8159
+
+

Parameters and performance of each subcatchment for all calibrations

- - - - + +
comp <- matrix(c(0, OutputsCalibUp$ParamFinalR,
+                 rep(OutputsCalibDown1$ParamFinalR, 2),
+                 OutputsCalibDown2$ParamFinalR,
+                 ParamDownTheo),
+               ncol = 5, byrow = TRUE)
+comp <- cbind(comp, c(OutputsCalibUp$CritFinal,
+                      OutputsCalibDown1$CritFinal,
+                      CritDown1$CritValue,
+                      OutputsCalibDown2$CritFinal,
+                      CritDownTheo$CritValue))
+colnames(comp) <- c("Lag", paste0("X", 1:4), "NSE")
+rownames(comp) <- c("Calibration of the upstream subcatchment",
+                    "Calibration 1 with observed upstream flow",
+                    "Validation 1 with simulated upstream flow",
+                    "Calibration 2 with simulated upstream flow",
+                    "Validation theoretical set of parameters")
+knitr::kable(comp)
+
+ +
+ - - - - + + + + - - - + + @@ -525,7 +495,7 @@ - + @@ -534,7 +504,7 @@ - + @@ -543,7 +513,7 @@ - + @@ -552,7 +522,7 @@ - + @@ -561,26 +531,10 @@ - -
Lagx1x2x3x4X1X2X3X4 NSE
Calibration of the upstream subcatchment 0.000 2572.21 0.799
Calibration 1 with observed upstream flow 2.560 2654.65 0.949
Validation 1 with simulated upstream flow 2.560 2654.65 0.817
Calibration 2 with simulated upstream flow 1.970 2705.21 0.818
Validation theoretical set of parameters 0.579 2572.21 0.816
-

Even if calibration with observed upstream flows gives an improved performance criteria, in validation using simulated upstream flows the result is quite similar as the performance obtained with the calibration with upstream simulated flows. The theoretical set of parameters give also an equivalent performance but still underperforming the calibration 2 one.

-
-
+ - - - - - - - +

Even if calibration with observed upstream flows gives an improved performance criteria, in validation using simulated upstream flows the result is quite similar as the performance obtained with the calibration with upstream simulated flows. The theoretical set of parameters give also an equivalent performance but still underperforming the calibration 2 one.

+ diff -Nru airgr-1.6.9.27/inst/doc/V05_sd_model.R airgr-1.6.10.4/inst/doc/V05_sd_model.R --- airgr-1.6.9.27/inst/doc/V05_sd_model.R 2021-01-22 10:35:22.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V05_sd_model.R 2021-01-29 07:26:52.000000000 +0000 @@ -21,10 +21,12 @@ Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"), which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31")) RunOptionsUp <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModelUp, IndPeriod_Run = Ind_Run, - IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL) + InputsModel = InputsModelUp + , IndPeriod_WarmUp = NULL, IndPeriod_Run = Ind_Run, + IniStates = NULL, IniResLevels = NULL) InputsCritUp <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelUp, - RunOptions = RunOptionsUp, VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run]) + RunOptions = RunOptionsUp, + VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run]) CalibOptionsUp <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel) OutputsCalibUp <- Calibration_Michel(InputsModel = InputsModelUp, RunOptions = RunOptionsUp, InputsCrit = InputsCritUp, CalibOptions = CalibOptionsUp, @@ -41,22 +43,26 @@ InputsModelDown1 <- CreateInputsModel( FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, Precip = BasinObs$P, PotEvap = BasinObs$E, - Qupstream = matrix(QObsUp, ncol = 1), # Upstream observed flow - LengthHydro = 100 * 1000, # Distance between upstream catchment outlet and the downstream one in m - BasinAreas = c(180, 180) # Upstream and downstream areas in km² + Qupstream = matrix(QObsUp, ncol = 1), # upstream observed flow + LengthHydro = 1e2 * 1e3, # distance between upstream catchment outlet & the downstream one [m] + BasinAreas = c(180, 180) # upstream and downstream areas [km²] ) ## ----------------------------------------------------------------------------- RunOptionsDown <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModelDown1, IndPeriod_Run = Ind_Run, - IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL) + InputsModel = InputsModelDown1, + IndPeriod_WarmUp = NULL, IndPeriod_Run = Ind_Run, + IniStates = NULL, IniResLevels = NULL) InputsCritDown <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelDown1, - RunOptions = RunOptionsDown, VarObs = "Q", Obs = QObsDown[Ind_Run]) + RunOptions = RunOptionsDown, + VarObs = "Q", Obs = QObsDown[Ind_Run]) CalibOptionsDown <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel, - IsSD = TRUE) # Don't forget to specify that it's an SD model here -OutputsCalibDown1 <- Calibration_Michel(InputsModel = InputsModelDown1, RunOptions = RunOptionsDown, - InputsCrit = InputsCritDown, CalibOptions = CalibOptionsDown, + IsSD = TRUE) # specify that it's a SD model +OutputsCalibDown1 <- Calibration_Michel(InputsModel = InputsModelDown1, + RunOptions = RunOptionsDown, + InputsCrit = InputsCritDown, + CalibOptions = CalibOptionsDown, FUN_MOD = RunModel_GR4J) ## ----------------------------------------------------------------------------- @@ -73,8 +79,10 @@ CritDown1 <- ErrorCrit_NSE(InputsCritDown, OutputsModelDown1) ## ----------------------------------------------------------------------------- -OutputsCalibDown2 <- Calibration_Michel(InputsModel = InputsModelDown2, RunOptions = RunOptionsDown, - InputsCrit = InputsCritDown, CalibOptions = CalibOptionsDown, +OutputsCalibDown2 <- Calibration_Michel(InputsModel = InputsModelDown2, + RunOptions = RunOptionsDown, + InputsCrit = InputsCritDown, + CalibOptions = CalibOptionsDown, FUN_MOD = RunModel_GR4J) ParamDown2 <- OutputsCalibDown2$ParamFinalR @@ -83,10 +91,14 @@ paste(format(Lag), "m/s") ## ----------------------------------------------------------------------------- -mLag <- matrix(c(Lag, OutputsCalibDown1$ParamFinalR[1], OutputsCalibDown2$ParamFinalR[1]), ncol = 1) -rownames(mLag) = c("theoretical", "calibrated with observed upstream flow", - "calibrated with simulated upstream flow") -colnames(mLag) = c("Lag parameter") +mLag <- matrix(c(Lag, + OutputsCalibDown1$ParamFinalR[1], + OutputsCalibDown2$ParamFinalR[1]), + ncol = 1, + dimnames = list(c("theoretical", + "calibrated with observed upstream flow", + "calibrated with simulated upstream flow"), + c("Lag parameter"))) knitr::kable(mLag) ## ----------------------------------------------------------------------------- @@ -98,11 +110,17 @@ CritDownTheo <- ErrorCrit_NSE(InputsCritDown, OutputsModelDownTheo) ## ----------------------------------------------------------------------------- -comp <- matrix(c(0, OutputsCalibUp$ParamFinalR, rep(OutputsCalibDown1$ParamFinalR, 2), - OutputsCalibDown2$ParamFinalR, ParamDownTheo), ncol = 5, byrow = TRUE) -comp <- cbind(comp, c(OutputsCalibUp$CritFinal, OutputsCalibDown1$CritFinal, - CritDown1$CritValue, OutputsCalibDown2$CritFinal, CritDownTheo$CritValue)) -colnames(comp) <- c("Lag", paste0("x", 1:4), "NSE") +comp <- matrix(c(0, OutputsCalibUp$ParamFinalR, + rep(OutputsCalibDown1$ParamFinalR, 2), + OutputsCalibDown2$ParamFinalR, + ParamDownTheo), + ncol = 5, byrow = TRUE) +comp <- cbind(comp, c(OutputsCalibUp$CritFinal, + OutputsCalibDown1$CritFinal, + CritDown1$CritValue, + OutputsCalibDown2$CritFinal, + CritDownTheo$CritValue)) +colnames(comp) <- c("Lag", paste0("X", 1:4), "NSE") rownames(comp) <- c("Calibration of the upstream subcatchment", "Calibration 1 with observed upstream flow", "Validation 1 with simulated upstream flow", diff -Nru airgr-1.6.9.27/inst/doc/V05_sd_model.Rmd airgr-1.6.10.4/inst/doc/V05_sd_model.Rmd --- airgr-1.6.9.27/inst/doc/V05_sd_model.Rmd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/inst/doc/V05_sd_model.Rmd 2021-01-29 05:03:09.000000000 +0000 @@ -69,10 +69,12 @@ Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"), which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31")) RunOptionsUp <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModelUp, IndPeriod_Run = Ind_Run, - IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL) + InputsModel = InputsModelUp + , IndPeriod_WarmUp = NULL, IndPeriod_Run = Ind_Run, + IniStates = NULL, IniResLevels = NULL) InputsCritUp <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelUp, - RunOptions = RunOptionsUp, VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run]) + RunOptions = RunOptionsUp, + VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run]) CalibOptionsUp <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel) OutputsCalibUp <- Calibration_Michel(InputsModel = InputsModelUp, RunOptions = RunOptionsUp, InputsCrit = InputsCritUp, CalibOptions = CalibOptionsUp, @@ -101,9 +103,9 @@ InputsModelDown1 <- CreateInputsModel( FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, Precip = BasinObs$P, PotEvap = BasinObs$E, - Qupstream = matrix(QObsUp, ncol = 1), # Upstream observed flow - LengthHydro = 100 * 1000, # Distance between upstream catchment outlet and the downstream one in m - BasinAreas = c(180, 180) # Upstream and downstream areas in km² + Qupstream = matrix(QObsUp, ncol = 1), # upstream observed flow + LengthHydro = 1e2 * 1e3, # distance between upstream catchment outlet & the downstream one [m] + BasinAreas = c(180, 180) # upstream and downstream areas [km²] ) ``` @@ -111,15 +113,19 @@ ```{r} RunOptionsDown <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModelDown1, IndPeriod_Run = Ind_Run, - IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL) + InputsModel = InputsModelDown1, + IndPeriod_WarmUp = NULL, IndPeriod_Run = Ind_Run, + IniStates = NULL, IniResLevels = NULL) InputsCritDown <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelDown1, - RunOptions = RunOptionsDown, VarObs = "Q", Obs = QObsDown[Ind_Run]) + RunOptions = RunOptionsDown, + VarObs = "Q", Obs = QObsDown[Ind_Run]) CalibOptionsDown <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel, - IsSD = TRUE) # Don't forget to specify that it's an SD model here -OutputsCalibDown1 <- Calibration_Michel(InputsModel = InputsModelDown1, RunOptions = RunOptionsDown, - InputsCrit = InputsCritDown, CalibOptions = CalibOptionsDown, + IsSD = TRUE) # specify that it's a SD model +OutputsCalibDown1 <- Calibration_Michel(InputsModel = InputsModelDown1, + RunOptions = RunOptionsDown, + InputsCrit = InputsCritDown, + CalibOptions = CalibOptionsDown, FUN_MOD = RunModel_GR4J) ``` @@ -151,8 +157,10 @@ We calibrate the model with the `InputsModel` object previously created for substituting the observed upstream flow with the simulated one: ```{r} -OutputsCalibDown2 <- Calibration_Michel(InputsModel = InputsModelDown2, RunOptions = RunOptionsDown, - InputsCrit = InputsCritDown, CalibOptions = CalibOptionsDown, +OutputsCalibDown2 <- Calibration_Michel(InputsModel = InputsModelDown2, + RunOptions = RunOptionsDown, + InputsCrit = InputsCritDown, + CalibOptions = CalibOptionsDown, FUN_MOD = RunModel_GR4J) ParamDown2 <- OutputsCalibDown2$ParamFinalR ``` @@ -162,7 +170,7 @@ ## Identification of Lag parameter -The theoretical LAG parameter should be equal to: +The theoretical Lag parameter should be equal to: ```{r} Lag <- InputsModelDown1$LengthHydro / (2 * 86400) @@ -172,10 +180,14 @@ Both calibrations overestimate this parameter: ```{r} -mLag <- matrix(c(Lag, OutputsCalibDown1$ParamFinalR[1], OutputsCalibDown2$ParamFinalR[1]), ncol = 1) -rownames(mLag) = c("theoretical", "calibrated with observed upstream flow", - "calibrated with simulated upstream flow") -colnames(mLag) = c("Lag parameter") +mLag <- matrix(c(Lag, + OutputsCalibDown1$ParamFinalR[1], + OutputsCalibDown2$ParamFinalR[1]), + ncol = 1, + dimnames = list(c("theoretical", + "calibrated with observed upstream flow", + "calibrated with simulated upstream flow"), + c("Lag parameter"))) knitr::kable(mLag) ``` @@ -197,11 +209,17 @@ ## Parameters and performance of each subcatchment for all calibrations ```{r} -comp <- matrix(c(0, OutputsCalibUp$ParamFinalR, rep(OutputsCalibDown1$ParamFinalR, 2), - OutputsCalibDown2$ParamFinalR, ParamDownTheo), ncol = 5, byrow = TRUE) -comp <- cbind(comp, c(OutputsCalibUp$CritFinal, OutputsCalibDown1$CritFinal, - CritDown1$CritValue, OutputsCalibDown2$CritFinal, CritDownTheo$CritValue)) -colnames(comp) <- c("Lag", paste0("x", 1:4), "NSE") +comp <- matrix(c(0, OutputsCalibUp$ParamFinalR, + rep(OutputsCalibDown1$ParamFinalR, 2), + OutputsCalibDown2$ParamFinalR, + ParamDownTheo), + ncol = 5, byrow = TRUE) +comp <- cbind(comp, c(OutputsCalibUp$CritFinal, + OutputsCalibDown1$CritFinal, + CritDown1$CritValue, + OutputsCalibDown2$CritFinal, + CritDownTheo$CritValue)) +colnames(comp) <- c("Lag", paste0("X", 1:4), "NSE") rownames(comp) <- c("Calibration of the upstream subcatchment", "Calibration 1 with observed upstream flow", "Validation 1 with simulated upstream flow", Binary files /tmp/tmp9l77iA/RtEbT66YcP/airgr-1.6.9.27/inst/vignettesData/vignetteParamOptimCaramel.rda and /tmp/tmp9l77iA/YQ9pTT1aMU/airgr-1.6.10.4/inst/vignettesData/vignetteParamOptimCaramel.rda differ diff -Nru airgr-1.6.9.27/man/CreateCalibOptions.Rd airgr-1.6.10.4/man/CreateCalibOptions.Rd --- airgr-1.6.9.27/man/CreateCalibOptions.Rd 2021-01-06 13:22:40.000000000 +0000 +++ airgr-1.6.10.4/man/CreateCalibOptions.Rd 2021-01-28 12:56:23.000000000 +0000 @@ -80,7 +80,7 @@ Users wanting to use \code{FUN_MOD}, \code{FUN_CALIB} or \code{FUN_TRANSFO} functions that are not included in the package must create their own \code{CalibOptions} object accordingly. \cr -## ---- CemaNeige version +## --- CemaNeige version If \code{IsHyst = FALSE}, the original CemaNeige version from Valéry et al. (2014) is used. \cr If \code{IsHyst = TRUE}, the CemaNeige version from Riboust et al. (2019) is used. Compared to the original version, this version of CemaNeige needs two more parameters and it includes a representation of the hysteretic relationship between the Snow Cover Area (SCA) and the Snow Water Equivalent (SWE) in the catchment. The hysteresis included in airGR is the Modified Linear hysteresis (LH*); it is represented on panel b) of Fig. 3 in Riboust et al. (2019). Riboust et al. (2019) advise to use the LH* version of CemaNeige with parameters calibrated using an objective function combining 75 \% of KGE calculated on discharge simulated from a rainfall-runoff model compared to observed discharge and 5 \% of KGE calculated on SCA on 5 CemaNeige elevation bands compared to satellite (e.g. MODIS) SCA (see Eq. (18), Table 3 and Fig. 6). Riboust et al. (2019)'s tests were realized with GR4J as the chosen rainfall-runoff model. \cr diff -Nru airgr-1.6.9.27/man/CreateInputsCrit.Rd airgr-1.6.10.4/man/CreateInputsCrit.Rd --- airgr-1.6.9.27/man/CreateInputsCrit.Rd 2021-01-12 13:57:22.000000000 +0000 +++ airgr-1.6.10.4/man/CreateInputsCrit.Rd 2021-01-28 12:56:23.000000000 +0000 @@ -73,11 +73,11 @@ \details{ Users wanting to use \code{FUN_CRIT} functions that are not included in the package must create their own InputsCrit object accordingly. \cr \cr -## ---- Period of calculation +## --- Period of calculation Criteria can be calculated over discontinuous periods (i.e. only over winter periods, or when observed discharge is below a certain threshold). To do so, please indicate in \code{Bool_Crit} which indices must be used for calcullation. Discontinuous periods are allowed in the \code{Bool_Crit} argument. -## ---- Transformations +## --- Transformations Transformations are simple functions applied to the observed and simulated variables used in order to change their distribution. Transformations are often used in hydrology for modifying the weight put on errors made for high flows or low flows. The following transformations are available: \cr \cr \itemize{ @@ -93,11 +93,11 @@ In order to make sure that KGE and KGE2 remain dimensionless and are not impacted by zero values, the Box-Cox transformation (\code{transfo = "boxcox"}) uses the formulation given in Equation 10 of Santos et al. (2018). Lambda is set to 0.25 accordingly. \cr \cr The syntax of the power transformation allows a numeric or a string of characters. For example for a squared transformation, the following can be used: \code{transfo = 2}, \code{transfo = "2"} or \code{transfo = "^2"}. Negative values are allowed. Fraction values are not allowed (e.g., \code{"-1/2"} must instead be written \code{"-0.5"}).\cr \cr -## ---- The epsilon value +## --- The epsilon value The epsilon value is useful when \code{"log"} or \code{"inv"} transformations are used (to avoid calculation of the inverse or of the logarithm of zero). If an epsilon value is provided, then it is added to the observed and simulated variable time series at each time step and before the application of a transformation. The epsilon value has no effect when the \code{"boxcox"} transformation is used. The impact of this value and a recommendation about the epsilon value to use (usually one hundredth of average observation) are discussed in Pushpalatha et al. (2012) for NSE and in Santos et al. (2018) for KGE and KGE'. \cr \cr -## ---- Single, multiple or composite criteria calculation +## --- Single, multiple or composite criteria calculation Users can set the following arguments as atomic or list: \code{FUN_CRIT}, \code{Obs}, \code{VarObs}, \code{BoolCrit}, \code{transfo}, \code{Weights}. If the list format is chosen, all the lists must have the same length. \cr Calculation of a single criterion (e.g. NSE computed on discharge) is prepared by providing to \code{CreateInputsCrit} arguments atomics only. \cr diff -Nru airgr-1.6.9.27/man/CreateRunOptions.Rd airgr-1.6.10.4/man/CreateRunOptions.Rd --- airgr-1.6.9.27/man/CreateRunOptions.Rd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/man/CreateRunOptions.Rd 2021-01-28 12:56:23.000000000 +0000 @@ -72,11 +72,11 @@ Users wanting to use \code{FUN_MOD} functions that are not included in the package must create their own \code{RunOptions} object accordingly. -## ---- IndPeriod_WarmUp and IndPeriod_Run +## --- IndPeriod_WarmUp and IndPeriod_Run Since the hydrological models included in airGR are continuous models, meaning that internal states of the models are propagated to the next time step, \code{IndPeriod_WarmUp} and \code{IndPeriod_Run} must be continuous periods, represented by continuous indices values; no gaps are allowed. To calculate criteria or to calibrate a model over discontinuous periods, please see the \code{Bool_Crit} argument of the \code{\link{CreateInputsCrit}} function. -## ---- Initialisation options +## --- Initialisation options The model initialisation options can either be set to a default configuration or be defined by the user. @@ -111,7 +111,7 @@ } } -## ---- CemaNeige version +## --- CemaNeige version If \code{IsHyst = FALSE}, the original CemaNeige version from Valéry et al. (2014) is used. \cr If \code{IsHyst = TRUE}, the CemaNeige version from Riboust et al. (2019) is used. Compared to the original version, this version of CemaNeige needs two more parameters and it includes a representation of the hysteretic relationship between the Snow Cover Area (SCA) and the Snow Water Equivalent (SWE) in the catchment. The hysteresis included in airGR is the Modified Linear hysteresis (LH*); it is represented on panel b) of Fig. 3 in Riboust et al. (2019). Riboust et al. (2019) advise to use the LH* version of CemaNeige with parameters calibrated using an objective function combining 75 \% of KGE calculated on discharge simulated from a rainfall-runoff model compared to observed discharge and 5 \% of KGE calculated on SCA on 5 CemaNeige elevation bands compared to satellite (e.g. MODIS) SCA (see Eq. (18), Table 3 and Fig. 6). Riboust et al. (2019)'s tests were realized with GR4J as the chosen rainfall-runoff model. \cr diff -Nru airgr-1.6.9.27/man/Param_Sets_GR4J.Rd airgr-1.6.10.4/man/Param_Sets_GR4J.Rd --- airgr-1.6.9.27/man/Param_Sets_GR4J.Rd 2021-01-12 13:39:35.000000000 +0000 +++ airgr-1.6.10.4/man/Param_Sets_GR4J.Rd 2021-01-28 12:56:23.000000000 +0000 @@ -56,7 +56,7 @@ InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, Precip = BasinObs$P, PotEvap = BasinObs$E) -## ---- calibration step +## --- calibration step ## short calibration period selection (< 6 months) Ind_Cal <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-01-01"), @@ -82,7 +82,7 @@ Param_Best <- unlist(Param_Sets_GR4J[which.max(OutputsCrit_Loop), ]) -## ---- validation step +## --- validation step ## validation period selection Ind_Val <- seq(which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1990-03-01"), diff -Nru airgr-1.6.9.27/man/RunModel_CemaNeigeGR4H.Rd airgr-1.6.10.4/man/RunModel_CemaNeigeGR4H.Rd --- airgr-1.6.9.27/man/RunModel_CemaNeigeGR4H.Rd 2021-01-12 17:47:41.000000000 +0000 +++ airgr-1.6.10.4/man/RunModel_CemaNeigeGR4H.Rd 2021-01-29 05:00:38.000000000 +0000 @@ -108,7 +108,7 @@ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2008-12-31 23:00")) -## ---- original version of CemaNeige +## --- original version of CemaNeige ## preparation of the RunOptions object RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4H, InputsModel = InputsModel, diff -Nru airgr-1.6.9.27/man/RunModel_CemaNeigeGR4J.Rd airgr-1.6.10.4/man/RunModel_CemaNeigeGR4J.Rd --- airgr-1.6.9.27/man/RunModel_CemaNeigeGR4J.Rd 2021-01-20 16:07:08.000000000 +0000 +++ airgr-1.6.10.4/man/RunModel_CemaNeigeGR4J.Rd 2021-01-29 05:00:38.000000000 +0000 @@ -104,7 +104,7 @@ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31")) -## ---- original version of CemaNeige +## --- original version of CemaNeige ## preparation of the RunOptions object RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel, @@ -125,7 +125,7 @@ OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel) -## ---- version of CemaNeige with the Linear Hysteresis +## --- version of CemaNeige with the Linear Hysteresis ## preparation of the RunOptions object RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR4J, InputsModel = InputsModel, diff -Nru airgr-1.6.9.27/man/RunModel_CemaNeigeGR5H.Rd airgr-1.6.10.4/man/RunModel_CemaNeigeGR5H.Rd --- airgr-1.6.9.27/man/RunModel_CemaNeigeGR5H.Rd 2021-01-13 15:39:10.000000000 +0000 +++ airgr-1.6.10.4/man/RunModel_CemaNeigeGR5H.Rd 2021-01-29 05:00:38.000000000 +0000 @@ -109,7 +109,7 @@ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d \%H:\%M")=="2008-12-31 23:00")) -## ---- original version of CemaNeige +## --- original version of CemaNeige ## Imax computation Imax <- Imax(InputsModel = InputsModel, IndPeriod_Run = Ind_Run, diff -Nru airgr-1.6.9.27/man/RunModel_CemaNeigeGR6J.Rd airgr-1.6.10.4/man/RunModel_CemaNeigeGR6J.Rd --- airgr-1.6.9.27/man/RunModel_CemaNeigeGR6J.Rd 2021-01-12 17:46:41.000000000 +0000 +++ airgr-1.6.10.4/man/RunModel_CemaNeigeGR6J.Rd 2021-01-29 05:00:38.000000000 +0000 @@ -108,7 +108,7 @@ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31")) -## ---- original version of CemaNeige +## --- original version of CemaNeige ## preparation of the RunOptions object RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR6J, InputsModel = InputsModel, @@ -129,7 +129,7 @@ OutputsCrit <- ErrorCrit_NSE(InputsCrit = InputsCrit, OutputsModel = OutputsModel) -## ---- version of CemaNeige with the Linear Hysteresis +## --- version of CemaNeige with the Linear Hysteresis ## preparation of the RunOptions object RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeigeGR6J, InputsModel = InputsModel, diff -Nru airgr-1.6.9.27/man/RunModel_CemaNeige.Rd airgr-1.6.10.4/man/RunModel_CemaNeige.Rd --- airgr-1.6.9.27/man/RunModel_CemaNeige.Rd 2021-01-12 17:48:07.000000000 +0000 +++ airgr-1.6.10.4/man/RunModel_CemaNeige.Rd 2021-01-29 05:00:38.000000000 +0000 @@ -79,7 +79,7 @@ which(format(BasinObs$DatesR, format = "\%Y-\%m-\%d")=="1999-12-31")) -## ---- original version of CemaNeige +## --- original version of CemaNeige ## preparation of the RunOptions object RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeige, InputsModel = InputsModel, @@ -94,7 +94,7 @@ plot(OutputsModel) -## ---- version of CemaNeige with the Linear Hysteresis +## --- version of CemaNeige with the Linear Hysteresis ## preparation of the RunOptions object RunOptions <- CreateRunOptions(FUN_MOD = RunModel_CemaNeige, InputsModel = InputsModel, diff -Nru airgr-1.6.9.27/man/RunModel_GR1A.Rd airgr-1.6.10.4/man/RunModel_GR1A.Rd --- airgr-1.6.9.27/man/RunModel_GR1A.Rd 2021-01-12 17:46:17.000000000 +0000 +++ airgr-1.6.10.4/man/RunModel_GR1A.Rd 2021-01-29 05:00:38.000000000 +0000 @@ -60,7 +60,7 @@ P = BasinObs$P, E = BasinObs$E, Qmm = BasinObs$Qmm) -TabSeries <- TabSeries[TabSeries$DatesR < "2012-09-01", ] +TabSeries <- TabSeries[TabSeries$DatesR < as.POSIXct("2012-09-01", tz = "UTC"), ] BasinObs <- SeriesAggreg(TabSeries, Format = "\%Y", YearFirstMonth = 09, ConvertFun = c("sum", "sum", "sum")) diff -Nru airgr-1.6.9.27/man/TransfoParam.Rd airgr-1.6.10.4/man/TransfoParam.Rd --- airgr-1.6.9.27/man/TransfoParam.Rd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/man/TransfoParam.Rd 2021-01-28 12:56:23.000000000 +0000 @@ -55,7 +55,7 @@ \examples{ library(airGR) -## ---- generic function +## --- generic function ## transformation Raw -> Transformed for the GR4J model Xraw <- matrix(c(+221.41, -3.63, +30.00, +1.37, @@ -72,7 +72,7 @@ Xraw <- TransfoParam(ParamIn = Xtran, Direction = "TR", FUN_TRANSFO = TransfoParam_GR4J) -## ---- specific function +## --- specific function ## transformation Raw -> Transformed for the GR4J model Xraw <- matrix(c(+221.41, -3.63, +30.00, +1.37, diff -Nru airgr-1.6.9.27/MD5 airgr-1.6.10.4/MD5 --- airgr-1.6.9.27/MD5 2021-01-22 11:40:02.000000000 +0000 +++ airgr-1.6.10.4/MD5 2021-01-29 09:50:06.000000000 +0000 @@ -1,23 +1,23 @@ -8a7842fb17d9c9bc8b9b1523e1ab9f10 *DESCRIPTION +b7e1ef54e0372ab40749560fc497485e *DESCRIPTION 8c1e9def08465242033d72f0861dbdfa *NAMESPACE -f51dbb9590add5c123731949b0e2fdf9 *NEWS.md +a85905309da7a07c98b1b1b77090c929 *NEWS.md 56025f3ffeae9bab534e0678447f6e37 *R/Calibration.R -5790ee507d6cb0e9b9914698304b028f *R/Calibration_Michel.R -d683be75b2090db4f83b2b04ee78e93f *R/CreateCalibOptions.R +9275fdfbba5dc860fa7c1df5029febd5 *R/Calibration_Michel.R +fb8ac1f08be50731a83abf14d50dd45e *R/CreateCalibOptions.R 038a9ac801787241361f4866438c8c42 *R/CreateIniStates.R e1f8913c3466f15927fe4b73760385de *R/CreateInputsCrit.R -81c4fe9b37f8a564f4e5d3fd889ab46b *R/CreateInputsModel.R +aa0fa97059a6e7d2083475113b2e24c2 *R/CreateInputsModel.R 650d4dade2457741a8e64ba565e04852 *R/CreateRunOptions.R -5fbecbb28603a8c588d1eb44f73a051e *R/DataAltiExtrapolation_Valery.R +3b4defc6b1c7c2a8c5bbe104c43d0b73 *R/DataAltiExtrapolation_Valery.R f585007d7a30761bdeef8d4bda674eb1 *R/ErrorCrit.R b6d58d031ec9e970aec7501f2ef12cde *R/ErrorCrit_KGE.R d01b49c886641cbcf4a1be87053ccaa9 *R/ErrorCrit_KGE2.R e6cd052ae98b5fc52d4731b87a4f699c *R/ErrorCrit_NSE.R 4bf4b63e72d8ffaf3758ef6432a4f35b *R/ErrorCrit_RMSE.R -55e3a16dd1f5513e33302ab5aad6a464 *R/Imax.R -0e2b816d0d19b122aad78358ac5fad5b *R/PE_Oudin.R -aa20a68afb6d050d90ebc90c15c4230c *R/PEdaily_Oudin.R -574d893587052c06b83af33732159f30 *R/RunModel.R +cfa9610d7b81e2f865abce5bbae05ef3 *R/Imax.R +d431056cb8f0b422fe7e7e8659a98ec6 *R/PE_Oudin.R +88d318e6130d105f746858057c909e16 *R/PEdaily_Oudin.R +6bc9ca2b5a5a5536b4fc6539341590bc *R/RunModel.R 891ca9369b253d7cc810e7cf2850b2ab *R/RunModel_CemaNeige.R e97eaa8195339434d78ecdae7e77482c *R/RunModel_CemaNeigeGR4H.R 405c4bfe7831b6f2d876f257e50da2ad *R/RunModel_CemaNeigeGR4J.R @@ -25,35 +25,36 @@ e939a8c936d7e4b2b804d5401323bacc *R/RunModel_CemaNeigeGR5J.R 87cfe427174ec54dab0e4246e495eef3 *R/RunModel_CemaNeigeGR6J.R 9e03fb7552508b99f3cae3387001cf86 *R/RunModel_GR1A.R -e0e38f8a5495ded7bc929e300fc426c5 *R/RunModel_GR2M.R -d0eb161cfff2a04cb1857c0132b71a9d *R/RunModel_GR4H.R -ed161e070bfe474ee53f7bf9d2286a6e *R/RunModel_GR4J.R -685a39e15f161bc1c2e8d7fd3c07495d *R/RunModel_GR5H.R -55f996c419f3ac552dd8b0ecac2716b3 *R/RunModel_GR5J.R -a95cae9139a9b77b6d2c6d32b30b25bc *R/RunModel_GR6J.R -62f4066cb557a286539fdfcce3e55ec8 *R/RunModel_Lag.R +ecd411501324eea1edf979a4f2c1f168 *R/RunModel_GR2M.R +ee2748bbb81f1f8c9cb08ed9c81fc515 *R/RunModel_GR4H.R +5a20568b122ff5b64012d512d97a3337 *R/RunModel_GR4J.R +3085bdbf0bb2baa2be22ef3d18dd5f37 *R/RunModel_GR5H.R +a03c3a7f5a2a01b9d68728846b36a633 *R/RunModel_GR5J.R +3f7bbead026363c291acfd0980c79926 *R/RunModel_GR6J.R +5b4f566f4f50ff8b8bd0297447cfb590 *R/RunModel_Lag.R de4a48f03d0677bd534efdca2495e444 *R/SeriesAggreg.InputsModel.R edc603028c526ebaf0b3c755b340c39a *R/SeriesAggreg.OutputsModel.R dfbea3692f678acb44837635b3cbe7fc *R/SeriesAggreg.R e73fa4f2345eefda1b2ef5bbf8ab79b1 *R/SeriesAggreg.data.frame.R 0391216ab263d47adc65e57bb6a4ea85 *R/SeriesAggreg.list.R 41b24f7478062dd5d18c12ff4c7f6106 *R/TransfoParam.R -50e89d7a01e99fb5ebfbf2537915a707 *R/TransfoParam_CemaNeige.R -d16f6de39d6822278061f83b78883015 *R/TransfoParam_CemaNeigeHyst.R -ad8cb2776e246b9cb5a7a7b9c899da44 *R/TransfoParam_GR1A.R +65656aa193c0398d80e5136ff550525c *R/TransfoParam_CemaNeige.R +8a220a40318838f6817981aac71b9fd1 *R/TransfoParam_CemaNeigeHyst.R +3f498fe67ef3c559763fc77b21e3232a *R/TransfoParam_GR1A.R cdeb9ffa82f689d9ae9b26c14248979a *R/TransfoParam_GR2M.R 1d6691b8f56217047694176b8523e223 *R/TransfoParam_GR4H.R ad4a08e756946d5865d948454920cef6 *R/TransfoParam_GR4J.R a5d0ea0a529450dffd39b9e5e4407a39 *R/TransfoParam_GR5H.R 767536df4c751240b5d0431cc8df204d *R/TransfoParam_GR5J.R 35daee31da83f847a7865c969139d3a3 *R/TransfoParam_GR6J.R -27a340cc16fced3657528bc14705bc55 *R/TransfoParam_Lag.R +7a76e4e03b202981aa46434f37f018ac *R/TransfoParam_Lag.R a449404587bfd384d3962bcdfc195669 *R/Utils.R -70b93360a59abfa636627b055b7327f1 *R/UtilsErrorCrit.R +7a5271d15b7efcb89a7d67e8438e358a *R/UtilsCemaNeige.R +3165e07356b78600f9ff0309a6a5d257 *R/UtilsErrorCrit.R ffe52793472368f06da1b0c456bad499 *R/UtilsSeriesAggreg.R 39f7c3c9f2ec8b2180edf1601abee801 *R/plot.OutputsModel.R efcf303c5fc80c2de2cb0676569c9d99 *README.md -e3e1a4dc2a1ba6444615d9aeb866a906 *build/partial.rdb +17ec2037fbe8a75021724605d86bb2ec *build/partial.rdb 41eeb47e6436e0dcf7e5f3291ee88d99 *build/vignette.rds 85b138e18498b7c5cf0106065cb47d6e *data/L0123001.rda 1940776e833cda1019508134b87c65f0 *data/L0123002.rda @@ -64,35 +65,36 @@ 376ca9db9dda6484654968f9dd8dcc71 *data/exampleSimPlot.rda 6a2c3cba4f7c6f31418d757880dd51ab *inst/CITATION 5b687dfb42551229e3a5777917afd4b1 *inst/doc/V01_get_started.R -13fe3eb3d06bda6d2b239995e2e8f733 *inst/doc/V01_get_started.Rmd -42ab6f3d89a64957834aa310e6d89f3a *inst/doc/V01_get_started.html -003813cc5317d1ab21a741434f199a09 *inst/doc/V02.1_param_optim.R -047e9fc909ad42c8fd7376c1e1b9cf6c *inst/doc/V02.1_param_optim.Rmd -cbff344d639230557ebd20fdf6ef9bfb *inst/doc/V02.1_param_optim.html +e6936672a53806c484efc2fddfb78043 *inst/doc/V01_get_started.Rmd +539c17f0f52140489b59dfa305aa1ac2 *inst/doc/V01_get_started.html +2e62852fb33ca54c267d3d1fbe5f7ba6 *inst/doc/V02.1_param_optim.R +a72f2a78dbe11f150e33a1489c438d62 *inst/doc/V02.1_param_optim.Rmd +09299292d6a3d415f5ccccc7f7e5aa2d *inst/doc/V02.1_param_optim.html e8e9deea2d067180f44e5eed3b60675f *inst/doc/V02.2_param_mcmc.R 86a5724d79fad6711afafe0ac0f55dd1 *inst/doc/V02.2_param_mcmc.Rmd -1eba167ff5c08a842cb9ee28fc710b72 *inst/doc/V02.2_param_mcmc.html +fd63df8b0567049346057bd228804961 *inst/doc/V02.2_param_mcmc.html f6e981b2780309287120cb59d8ce8c76 *inst/doc/V03_param_sets_GR4J.R -e168ef231e31e1675e4acdb608c034c7 *inst/doc/V03_param_sets_GR4J.Rmd -6017b2a7dcae2b41042ef9abbab2ccdc *inst/doc/V03_param_sets_GR4J.html +405b6f7f76efab3a9d7525a55ba4e1e7 *inst/doc/V03_param_sets_GR4J.Rmd +dddf14b299b1d5279fc11bfc1da0b9cd *inst/doc/V03_param_sets_GR4J.html ddc0d72b57be1654fc5e4303440c50f2 *inst/doc/V04_cemaneige_hysteresis.R -96f1dee5a49564d0264017e8929f4308 *inst/doc/V04_cemaneige_hysteresis.Rmd -9e95b4e935602c8f7b4ce40408da984b *inst/doc/V04_cemaneige_hysteresis.html -367125158f016c54ab134b4202d034b6 *inst/doc/V05_sd_model.R -690ec886384f608765ebb7c5e3226571 *inst/doc/V05_sd_model.Rmd -eb662f54ec3b9892156b3ebbf0f394d0 *inst/doc/V05_sd_model.html +c813440c86d262b87f5e6c1ce32dbab5 *inst/doc/V04_cemaneige_hysteresis.Rmd +6e749eb1893b6c925108aed137230411 *inst/doc/V04_cemaneige_hysteresis.html +4ec7f65c72494c78ae2d9a94caf2c458 *inst/doc/V05_sd_model.R +173d59f08867d4df5391552095cf2d48 *inst/doc/V05_sd_model.Rmd +73fdb1a1e0245a448140c50caed71440 *inst/doc/V05_sd_model.html 9352752c1016c4ed887cda13ff0b72e4 *inst/vignettesData/vignetteCNHysteresis.rda a6359c861493d97b3ac0f383992462d3 *inst/vignettesData/vignetteParamMCMC.rda 17a60c15ffcc8514df126ba867f0d69d *inst/vignettesData/vignetteParamOptim.rda +91c37333d7dec48c79a635078d4f5eaf *inst/vignettesData/vignetteParamOptimCaramel.rda a80fc57ccb10822667d33db695eb2931 *man/BasinInfo.Rd ebc248bda647d1a050b1359dafcf2844 *man/BasinObs.Rd 60041c62cb72d71fde0427d5d3b5219c *man/Calibration.Rd 94fb62b9768d59b61e11d2591a6242c4 *man/Calibration_Michel.Rd -bba10afddf762b0d63a2c93b4890d09f *man/CreateCalibOptions.Rd +cb5d65d5daebfa2ab8c58a77467ca82c *man/CreateCalibOptions.Rd eb8a873d22e97a7d8bc8ddcf730ea026 *man/CreateIniStates.Rd -d444e99e2f6f85b429d5df7a38bca79f *man/CreateInputsCrit.Rd +3587bab60d6f37b71ffb8c107345ec89 *man/CreateInputsCrit.Rd 67a6b3bbb551528bc5c971409effb385 *man/CreateInputsModel.Rd -a05a87fc87e51384a7668fd464fc8b91 *man/CreateRunOptions.Rd +8530f27b711dba4e812e8bd76ed29585 *man/CreateRunOptions.Rd 813348ce71f976efa5195d2e693d8eff *man/DataAltiExtrapolation_Valery.Rd 738a3a18a30c0729d9a7530717ed8296 *man/ErrorCrit.Rd 00d3f3fd8e0d984c6bdce12a513c2641 *man/ErrorCrit_KGE.Rd @@ -101,15 +103,15 @@ c66b9cf12e26494e9faf8ca736e15354 *man/ErrorCrit_RMSE.Rd 2a644c45308fceacca0566c74d3baf6f *man/Imax.Rd bb034f26db0a05a313be63036a98152d *man/PE_Oudin.Rd -a7ea38444a7cf9390e730a683645c10c *man/Param_Sets_GR4J.Rd +616c9da00a0b3a55fcc326f7524cc505 *man/Param_Sets_GR4J.Rd be8eb4a73d49bdbdeb69e457cf85e179 *man/RunModel.Rd -358376def4dabec099a0786c070253a9 *man/RunModel_CemaNeige.Rd -7c6ef3f833e4076946db194e9304c2b5 *man/RunModel_CemaNeigeGR4H.Rd -679824cd6c6e8aa4a731a43cff8f1ea2 *man/RunModel_CemaNeigeGR4J.Rd -8eae12a9bc795f4f515b55df53865a3c *man/RunModel_CemaNeigeGR5H.Rd +f40f2102d843ad3ef741f867c38e7c5b *man/RunModel_CemaNeige.Rd +42ca577eeb641f9a4ddfa3d4d3d02526 *man/RunModel_CemaNeigeGR4H.Rd +c9977b1ad84099761f62ec28414bf363 *man/RunModel_CemaNeigeGR4J.Rd +22979bdf5e7974f4088ca35ab597e89b *man/RunModel_CemaNeigeGR5H.Rd b8c40b57fb026e798eec05a747845dda *man/RunModel_CemaNeigeGR5J.Rd -22f78c44ac2e1a09d57f4c5a17e90158 *man/RunModel_CemaNeigeGR6J.Rd -95f8c8d9d8c6e8996b620016e282cd3f *man/RunModel_GR1A.Rd +d36fd54692ca11b0636632a426cc3071 *man/RunModel_CemaNeigeGR6J.Rd +a9eb7850c5be674e0a83dafd193bc605 *man/RunModel_GR1A.Rd 370b663b10d8c1bc3c586b46aa5473d1 *man/RunModel_GR2M.Rd bc2961a6a07e960dc51c44c60f7e00c1 *man/RunModel_GR4H.Rd dcc533e03ce69470fb935aa94686a6f2 *man/RunModel_GR4J.Rd @@ -118,7 +120,7 @@ 1c25cf4b488880426268f867f717a382 *man/RunModel_GR6J.Rd 8735caa08386895810aab6c728815902 *man/RunModel_Lag.Rd ac2b0c02d03ec82fd7f990357e34ef50 *man/SeriesAggreg.Rd -c8fa5c131d01f87f7dba2c7b29fc2de6 *man/TransfoParam.Rd +9a03a593e3e913dcb74c4b67fb66edc2 *man/TransfoParam.Rd d7168a77340ea49772cdc6d0863a38cf *man/airGR.Rd 3230cd1e50bff45e93b61f646be938af *man/figures/diagramGR2M-EN.pdf 3a8b4c2cbddb45ab5fbf37d717c35484 *man/figures/diagramGR2M-EN.png @@ -131,33 +133,33 @@ 3c798917c252466e43ebb6d3aff2168f *man/figures/diagramGR6J-EN.pdf 201fc5ab920c6daedf79d7335fd6bdb3 *man/figures/diagramGR6J-EN.png 76a90056d8e14fd36de4ecad66843f09 *man/plot.OutputsModel.Rd -8609b7fd9808ed28082ddc4f7bbde8d8 *src/airGR.c +53dd28e0e5ced8b72fc7e454676c5c75 *src/airGR.c 6851f77b33964dd8cbcae3c4c5c59a7d *src/frun_CEMANEIGE.f90 65fe8ffdd7aa5188415dd198436af670 *src/frun_GR1A.f90 aef55a82fa4aa5a6cda76c6ade56a853 *src/frun_GR2M.f90 beb6ddb16a2c6b3de27798d9cced33c5 *src/frun_GR4H.f90 988cd1046895e60f38bdb2503dcc6869 *src/frun_GR4J.f90 -8daa620ca521471a5c98bd4bba351861 *src/frun_GR5H.f90 +b993f623a19c8e5149587f56ac64ae44 *src/frun_GR5H.f90 2790d0a938369279e43ced19f5eaf5a1 *src/frun_GR5J.f90 de5dad47e7ac6607a20ec0fa55f6160c *src/frun_GR6J.f90 e79edbd2c1a15bc36f75248052cc8d64 *src/frun_PE.f90 f216f3c8636b5e70b72e5240c7e8f30b *src/utils_D.f90 df9c89dd226f9b3c27583d67d231d19c *src/utils_H.f90 1acaa21f83ea3a26710bf158c0d42c33 *tests/testthat.R -e9c570a340633cc69bd4404edd951c67 *tests/testthat/helper_regression.R -d85e496911497fb657122daac46a02d7 *tests/testthat/helper_vignettes.R -2874d5abae11aa00a775321507eb0615 *tests/testthat/regression.R -98fedfe62e9e35419b7d6f11790dfeb9 *tests/testthat/regression_tests.R -db93ebb7cfe32b43321fd072938b9df9 *tests/testthat/test-CreateRunOptions.R -fe8c48c0001fb27a9c66e59b2082a163 *tests/testthat/test-CreateiniStates.R -1f419a50f578d477b345cd697f119eae *tests/testthat/test-RunModel_LAG.R -b7cf5ade2681a4b6191a118742acd406 *tests/testthat/test-SeriesAggreg.R -e2531274b0130d9633dfb7602df3ed76 *tests/testthat/test-evap.R -b3759a306ef7113e08b028fdc50735ed *tests/testthat/test-vignettes.R +3e6506bfa13e7d1b0a18fff61ded0ab7 *tests/testthat/helper_regression.R +a7f71d727df0f95186313ebd14359894 *tests/testthat/helper_vignettes.R +b32332093fd5034f520c483bf4bd85ce *tests/testthat/regression.R +cf5d7272b7de2078a9c02d9b8a2ea658 *tests/testthat/regression_tests.R +a7d4079abe1fb1f0bc434c5b6ffcc371 *tests/testthat/test-CreateRunOptions.R +f4225134152363f6c7aa0343501ed111 *tests/testthat/test-CreateiniStates.R +8d1a6a7c35153294514fbe96a6affe8a *tests/testthat/test-RunModel_Lag.R +852fb5e53661a7a59ff25a6591d6e552 *tests/testthat/test-SeriesAggreg.R +3a7c9950a3b1ca4510dccb43af21acaf *tests/testthat/test-evap.R +aa8cd63df494214635e36120f04f0514 *tests/testthat/test-vignettes.R 8d6d6928486cca88e59c1523955b5ca6 *vignettes/V00_airgr_ref.bib -13fe3eb3d06bda6d2b239995e2e8f733 *vignettes/V01_get_started.Rmd -047e9fc909ad42c8fd7376c1e1b9cf6c *vignettes/V02.1_param_optim.Rmd +e6936672a53806c484efc2fddfb78043 *vignettes/V01_get_started.Rmd +a72f2a78dbe11f150e33a1489c438d62 *vignettes/V02.1_param_optim.Rmd 86a5724d79fad6711afafe0ac0f55dd1 *vignettes/V02.2_param_mcmc.Rmd -e168ef231e31e1675e4acdb608c034c7 *vignettes/V03_param_sets_GR4J.Rmd -96f1dee5a49564d0264017e8929f4308 *vignettes/V04_cemaneige_hysteresis.Rmd -690ec886384f608765ebb7c5e3226571 *vignettes/V05_sd_model.Rmd +405b6f7f76efab3a9d7525a55ba4e1e7 *vignettes/V03_param_sets_GR4J.Rmd +c813440c86d262b87f5e6c1ce32dbab5 *vignettes/V04_cemaneige_hysteresis.Rmd +173d59f08867d4df5391552095cf2d48 *vignettes/V05_sd_model.Rmd diff -Nru airgr-1.6.9.27/NEWS.md airgr-1.6.10.4/NEWS.md --- airgr-1.6.9.27/NEWS.md 2021-01-18 13:51:17.000000000 +0000 +++ airgr-1.6.10.4/NEWS.md 2021-01-29 05:04:32.000000000 +0000 @@ -2,6 +2,30 @@ +### 1.6.10.4 Release Notes (2021-01-29) + +#### New features + +- Added a section 'param_optim' vignette to explain how to manage with multiobjective optimization using the 'CaRamel' package. ([#61](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/61)) + + +#### Major user-visible changes + +- `Imax()` now returns an error message when `IndPeriod_Run` doesn't select 24 hours by day, instead of `numeric(0)`. ([#92](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/92)) + + +#### Minor user-visible changes + +- Fixed warning returned by GCC Fortran when compiling `frun_GR5H.f90`. ([#93](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/93)) + + +#### CRAN-compatibility updates + +- Coerce `POSIXlt` dates into character in `RunModel_GR1A()` example and in `SeriesAggreg()` tests in order to avoid bad subsetting on time series due to mixing UTC and local time on macOS flavors. ([#94](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/94)) + +____________________________________________________________________________________ + + ### 1.6.9.27 Release Notes (2021-01-18) #### New features diff -Nru airgr-1.6.9.27/R/Calibration_Michel.R airgr-1.6.10.4/R/Calibration_Michel.R --- airgr-1.6.9.27/R/Calibration_Michel.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/Calibration_Michel.R 2021-01-28 12:56:23.000000000 +0000 @@ -219,10 +219,10 @@ PotentialCandidateT[1, I] <- NewParamOptimT[I] + Sign * Pace ##If_we_exit_the_range_of_possible_values_we_go_back_on_the_boundary if (PotentialCandidateT[1, I] < RangesT[1, I] ) { - PotentialCandidateT[1,I] <- RangesT[1, I] + PotentialCandidateT[1, I] <- RangesT[1, I] } if (PotentialCandidateT[1, I] > RangesT[2, I]) { - PotentialCandidateT[1,I] <- RangesT[2,I] + PotentialCandidateT[1, I] <- RangesT[2, I] } ##We_check_the_set_is_not_outside_the_range_of_possible_values if (NewParamOptimT[I] == RangesT[1, I] & Sign < 0) { diff -Nru airgr-1.6.9.27/R/CreateCalibOptions.R airgr-1.6.10.4/R/CreateCalibOptions.R --- airgr-1.6.9.27/R/CreateCalibOptions.R 2021-01-06 10:52:39.000000000 +0000 +++ airgr-1.6.10.4/R/CreateCalibOptions.R 2021-01-29 05:18:13.000000000 +0000 @@ -21,7 +21,7 @@ if (!is.logical(IsSD) | length(IsSD) != 1L) { stop("'IsSD' must be a logical of length 1") } - ##check_FUN_MOD + ## check FUN_MOD BOOL <- FALSE if (identical(FUN_MOD, RunModel_GR4H)) { @@ -87,7 +87,7 @@ return(NULL) } - ##check_FUN_CALIB + ## check FUN_CALIB BOOL <- FALSE if (identical(FUN_CALIB, Calibration_Michel)) { @@ -100,9 +100,9 @@ } - ##check_FUN_TRANSFO + ## check FUN_TRANSFO if (is.null(FUN_TRANSFO)) { - ##_set_FUN1 + ## set FUN1 if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H)) { FUN_GR <- TransfoParam_GR4H @@ -140,17 +140,17 @@ stop("'FUN_GR' was not found") return(NULL) } - ##_set_FUN2 + ## set FUN2 if (IsHyst) { FUN_SNOW <- TransfoParam_CemaNeigeHyst } else { FUN_SNOW <- TransfoParam_CemaNeige } - ##_set_FUN_LAG + ## set FUN_LAG if (IsSD) { FUN_LAG <- TransfoParam_Lag } - ##_set_FUN_TRANSFO + ## set FUN_TRANSFO if (sum(ObjectClass %in% c("GR4H", "GR5H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige")) > 0) { if (!IsSD) { FUN_TRANSFO <- FUN_GR @@ -179,7 +179,7 @@ } ParamOut <- NA * ParamIn NParam <- ncol(ParamIn) - ParamOut[, 1:(NParam - 4) ] <- FUN_GR(ParamIn[, 1:(NParam - 4) ], Direction) + ParamOut[, 1:(NParam - 4) ] <- FUN_GR(ParamIn[, 1:(NParam - 4)], Direction) ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction) if (!Bool) { ParamOut <- ParamOut[1, ] @@ -198,7 +198,7 @@ if (NParam <= 3) { ParamOut[, 1:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 1:(NParam - 2)]), Direction) } else { - ParamOut[, 1:(NParam - 2)] <- FUN_GR( ParamIn[, 1:(NParam - 2)], Direction) + ParamOut[, 1:(NParam - 2)] <- FUN_GR(ParamIn[, 1:(NParam - 2)], Direction) } ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction) if (!Bool) { @@ -215,9 +215,9 @@ } ParamOut <- NA * ParamIn NParam <- ncol(ParamIn) - ParamOut[, 2:(NParam - 4) ] <- FUN_GR( ParamIn[, 2:(NParam - 4) ], Direction) - ParamOut[, (NParam - 3):NParam] <- FUN_SNOW( ParamIn[, (NParam - 3):NParam], Direction) - ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1 ]), Direction) + ParamOut[, 2:(NParam - 4) ] <- FUN_GR(ParamIn[, 2:(NParam - 4)], Direction) + ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction) + ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction) if (!Bool) { ParamOut <- ParamOut[1, ] } @@ -235,9 +235,9 @@ if (NParam <= 3) { ParamOut[, 2:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 2:(NParam - 2)]), Direction) } else { - ParamOut[, 2:(NParam - 2)] <- FUN_GR( ParamIn[, 2:(NParam - 2)], Direction) + ParamOut[, 2:(NParam - 2)] <- FUN_GR(ParamIn[, 2:(NParam - 2)], Direction) } - ParamOut[, (NParam - 1):NParam] <- FUN_SNOW( ParamIn[, (NParam - 1):NParam], Direction) + ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction) ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction) if (!Bool) { ParamOut <- ParamOut[1, ] @@ -252,7 +252,7 @@ return(NULL) } - ##NParam + ## NParam if ("GR4H" %in% ObjectClass) { NParam <- 4 } @@ -299,7 +299,7 @@ NParam <- NParam + 1 } - ##check_FixedParam + ## check FixedParam if (is.null(FixedParam)) { FixedParam <- rep(NA, NParam) } else { @@ -317,10 +317,10 @@ } } - ##check_SearchRanges + ## check SearchRanges if (is.null(SearchRanges)) { - ParamT <- matrix(c(rep(-9.99, NParam), rep(+9.99, NParam)), - ncol = NParam, byrow = TRUE) + ParamT <- matrix(c(rep(-9.99, NParam), rep(+9.99, NParam)), + ncol = NParam, byrow = TRUE) SearchRanges <- TransfoParam(ParamIn = ParamT, Direction = "TR", FUN_TRANSFO = FUN_TRANSFO) } else { @@ -341,7 +341,7 @@ } } - ##check_StartParamList_and_StartParamDistrib__default_values + ## check StartParamList and StartParamDistrib default values if (("HBAN" %in% ObjectClass & is.null(StartParamList) & is.null(StartParamDistrib))) { if ("GR4H" %in% ObjectClass) { ParamT <- matrix(c(+5.12, -1.18, +4.34, -9.69, @@ -351,12 +351,12 @@ if (("GR5H" %in% ObjectClass) & ("interception" %in% ObjectClass)) { ParamT <- matrix(c(+3.46, -1.25, +4.04, -9.53, -9.34, +3.74, -0.41, +4.78, -8.94, -3.33, - +4.29, +0.16, +5.39, -7.39, +3.33), ncol=5, byrow = TRUE); + +4.29, +0.16, +5.39, -7.39, +3.33), ncol = 5, byrow = TRUE) } if (("GR5H" %in% ObjectClass) & !("interception" %in% ObjectClass)) { ParamT <- matrix(c(+3.28, -0.39, +4.14, -9.54, -7.49, +3.62, -0.19, +4.80, -9.00, -6.31, - +4.01, -0.04, +5.43, -7.53, -5.33), ncol=5, byrow = TRUE); + +4.01, -0.04, +5.43, -7.53, -5.33), ncol = 5, byrow = TRUE) } if ("GR4J" %in% ObjectClass) { ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, @@ -399,12 +399,12 @@ if (("CemaNeigeGR5H" %in% ObjectClass) & ("interception" %in% ObjectClass)) { ParamT <- matrix(c(+3.46, -1.25, +4.04, -9.53, -9.34, -9.96, +6.63, +3.74, -0.41, +4.78, -8.94, -3.33, -9.14, +6.90, - +4.29, +0.16, +5.39, -7.39, +3.33, +4.10, +7.21), ncol = 7, byrow = TRUE); + +4.29, +0.16, +5.39, -7.39, +3.33, +4.10, +7.21), ncol = 7, byrow = TRUE) } if (("CemaNeigeGR5H" %in% ObjectClass) & !("interception" %in% ObjectClass)) { ParamT <- matrix(c(+3.28, -0.39, +4.14, -9.54, -7.49, -9.96, +6.63, +3.62, -0.19, +4.80, -9.00, -6.31, -9.14, +6.90, - +4.01, -0.04, +5.43, -7.53, -5.33, +4.10, +7.21), ncol = 7, byrow = TRUE); + +4.01, -0.04, +5.43, -7.53, -5.33, +4.10, +7.21), ncol = 7, byrow = TRUE) } if ("CemaNeigeGR4J" %in% ObjectClass) { ParamT <- matrix(c(+5.13, -1.60, +3.03, -9.05, -9.96, +6.63, @@ -440,7 +440,7 @@ } - ##check_StartParamList_and_StartParamDistrib__format + ## check StartParamList and StartParamDistrib format if ("HBAN" %in% ObjectClass & !is.null(StartParamList)) { if (!is.matrix(StartParamList)) { stop("'StartParamList' must be a matrix") diff -Nru airgr-1.6.9.27/R/CreateInputsModel.R airgr-1.6.10.4/R/CreateInputsModel.R --- airgr-1.6.9.27/R/CreateInputsModel.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/CreateInputsModel.R 2021-01-29 05:00:38.000000000 +0000 @@ -8,333 +8,333 @@ verbose = TRUE) { - ObjectClass <- NULL + ObjectClass <- NULL - FUN_MOD <- match.fun(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, "hourly", "GR") + ##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) + TimeStep <- as.integer(60 * 60) - BOOL <- TRUE - } - if (identical(FUN_MOD, RunModel_GR4J) | - identical(FUN_MOD, RunModel_GR5J) | - identical(FUN_MOD, RunModel_GR6J)) { - ObjectClass <- c(ObjectClass, "daily", "GR") + BOOL <- TRUE + } + 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) + TimeStep <- as.integer(24 * 60 * 60) - BOOL <- TRUE - } - if (identical(FUN_MOD, RunModel_GR2M)) { - ObjectClass <- c(ObjectClass, "GR", "monthly") + BOOL <- TRUE + } + if (identical(FUN_MOD, RunModel_GR2M)) { + ObjectClass <- c(ObjectClass, "GR", "monthly") - TimeStep <- as.integer(c(28, 29, 30, 31) * 24 * 60 * 60) + TimeStep <- as.integer(c(28, 29, 30, 31) * 24 * 60 * 60) - BOOL <- TRUE - } - if (identical(FUN_MOD, RunModel_GR1A)) { - ObjectClass <- c(ObjectClass, "GR", "yearly") + BOOL <- TRUE + } + if (identical(FUN_MOD, RunModel_GR1A)) { + ObjectClass <- c(ObjectClass, "GR", "yearly") - TimeStep <- as.integer(c(365, 366) * 24 * 60 * 60) + TimeStep <- as.integer(c(365, 366) * 24 * 60 * 60) - BOOL <- TRUE - } - if (identical(FUN_MOD, RunModel_CemaNeige)) { - ObjectClass <- c(ObjectClass, "daily", "CemaNeige") + BOOL <- TRUE + } + if (identical(FUN_MOD, RunModel_CemaNeige)) { + ObjectClass <- c(ObjectClass, "daily", "CemaNeige") - TimeStep <- as.integer(24 * 60 * 60) + TimeStep <- as.integer(24 * 60 * 60) - BOOL <- TRUE - } - if (identical(FUN_MOD, RunModel_CemaNeigeGR4J) | - identical(FUN_MOD, RunModel_CemaNeigeGR5J) | - identical(FUN_MOD, RunModel_CemaNeigeGR6J)) { - ObjectClass <- c(ObjectClass, "daily", "GR", "CemaNeige") + BOOL <- TRUE + } + 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) + TimeStep <- as.integer(24 * 60 * 60) - BOOL <- TRUE - } - if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) { - ObjectClass <- c(ObjectClass, "hourly", "GR", "CemaNeige") + BOOL <- TRUE + } + if (identical(FUN_MOD, RunModel_CemaNeigeGR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) { + ObjectClass <- c(ObjectClass, "hourly", "GR", "CemaNeige") + + TimeStep <- as.integer(60 * 60) - TimeStep <- as.integer(60 * 60) + BOOL <- TRUE + } + if (!BOOL) { + stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'") + } - BOOL <- TRUE + ##check_arguments + if ("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) { + if (is.null(DatesR)) { + stop("'DatesR' is missing") } - if (!BOOL) { - stop("incorrect 'FUN_MOD' for use in 'CreateInputsModel'") + if (!"POSIXlt" %in% class(DatesR) & !"POSIXct" %in% class(DatesR)) { + stop("'DatesR' must be defined as 'POSIXlt' or 'POSIXct'") } - - ##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 (!"POSIXlt" %in% class(DatesR)) { + DatesR <- as.POSIXlt(DatesR) } - if ("GR" %in% ObjectClass) { - if (is.null(Precip)) { - stop("Precip is missing") - } - if (is.null(PotEvap)) { - stop("'PotEvap' is missing") - } - if (!is.vector(Precip) | !is.vector(PotEvap)) { - stop("'Precip' and 'PotEvap' must be vectors of numeric values") + 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") + } + if (is.null(PotEvap)) { + stop("'PotEvap' is missing") + } + if (!is.vector(Precip) | !is.vector(PotEvap)) { + stop("'Precip' and 'PotEvap' must be vectors of numeric values") + } + if (!is.numeric(Precip) | !is.numeric(PotEvap)) { + stop("'Precip' and 'PotEvap' must be vectors of numeric values") + } + if (length(Precip) != LLL | length(PotEvap) != LLL) { + stop("'Precip', 'PotEvap' and 'DatesR' must have the same length") + } + } + if ("CemaNeige" %in% ObjectClass) { + if (is.null(Precip)) { + stop("'Precip' is missing") + } + if (is.null(TempMean)) { + stop("'TempMean' is missing") + } + if (!is.vector(Precip) | !is.vector(TempMean)) { + stop("'Precip' and 'TempMean' must be vectors of numeric values") + } + if (!is.numeric(Precip) | !is.numeric(TempMean)) { + stop("'Precip' and 'TempMean' must be vectors of numeric values") + } + if (length(Precip) != LLL | length(TempMean) != LLL) { + stop("'Precip', 'TempMean' and 'DatesR' must have the same length") + } + if (is.null(TempMin) != is.null(TempMax)) { + stop("'TempMin' and 'TempMax' must be both defined if not 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") } - if (!is.numeric(Precip) | !is.numeric(PotEvap)) { - stop("'Precip' and 'PotEvap' must be vectors of numeric values") + if (!is.numeric(TempMin) | !is.numeric(TempMax)) { + stop("'TempMin' and 'TempMax' must be vectors of numeric values") } - if (length(Precip) != LLL | length(PotEvap) != LLL) { - stop("'Precip', 'PotEvap' and 'DatesR' must have the same length") + if (length(TempMin) != LLL | length(TempMax) != LLL) { + stop("'TempMin', 'TempMax' and 'DatesR' must have the same length") } } - if ("CemaNeige" %in% ObjectClass) { - if (is.null(Precip)) { - stop("'Precip' is missing") + if (!is.null(HypsoData)) { + if (!is.vector(HypsoData)) { + stop("'HypsoData' must be a vector of numeric values if not null") } - if (is.null(TempMean)) { - stop("'TempMean' is missing") + if (!is.numeric(HypsoData)) { + stop("'HypsoData' must be a vector of numeric values if not null") } - if (!is.vector(Precip) | !is.vector(TempMean)) { - stop("'Precip' and 'TempMean' must be vectors of numeric values") + if (length(HypsoData) != 101) { + stop("'HypsoData' must be of length 101 if not null") } - if (!is.numeric(Precip) | !is.numeric(TempMean)) { - stop("'Precip' and 'TempMean' must be vectors of numeric values") + if (sum(is.na(HypsoData)) != 0 & sum(is.na(HypsoData)) != 101) { + stop("'HypsoData' must not contain any NA if not null") } - if (length(Precip) != LLL | length(TempMean) != LLL) { - stop("'Precip', 'TempMean' and 'DatesR' must have the same length") - } - if (is.null(TempMin) != is.null(TempMax)) { - stop("'TempMin' and 'TempMax' must be both defined if not 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") - } - if (!is.numeric(TempMin) | !is.numeric(TempMax)) { - stop("'TempMin' and 'TempMax' must be vectors of numeric values") - } - if (length(TempMin) != LLL | length(TempMax) != LLL) { - stop("'TempMin', 'TempMax' and 'DatesR' must have the same length") - } + } + if (!is.null(ZInputs)) { + if (length(ZInputs) != 1) { + stop("'ZInputs' must be a single numeric value if not null") } - if (!is.null(HypsoData)) { - if (!is.vector(HypsoData)) { - stop("'HypsoData' must be a vector of numeric values if not null") - } - if (!is.numeric(HypsoData)) { - stop("'HypsoData' must be a vector of numeric values if not null") - } - if (length(HypsoData) != 101) { - stop("'HypsoData' must be of length 101 if not null") - } - if (sum(is.na(HypsoData)) != 0 & sum(is.na(HypsoData)) != 101) { - stop("'HypsoData' must not contain any NA if not null") - } + if (is.na(ZInputs) | !is.numeric(ZInputs)) { + stop("'ZInputs' must be a single numeric value if not null") } - if (!is.null(ZInputs)) { - if (length(ZInputs) != 1) { - stop("'ZInputs' must be a single numeric value if not null") - } - if (is.na(ZInputs) | !is.numeric(ZInputs)) { - stop("'ZInputs' must be a single numeric value if not null") - } + } + if (is.null(HypsoData)) { + if (verbose) { + warning("'HypsoData' is missing: a single layer is used and no extrapolation is made") } - if (is.null(HypsoData)) { - if (verbose) { - warning("'HypsoData' is missing: a single layer is used and no extrapolation is made") - } - HypsoData <- as.numeric(rep(NA, 101)) - ZInputs <- as.numeric(NA) - NLayers <- as.integer(1) + HypsoData <- as.numeric(rep(NA, 101)) + ZInputs <- as.numeric(NA) + NLayers <- as.integer(1) + } + if (is.null(ZInputs)) { + if (verbose & !identical(HypsoData, as.numeric(rep(NA, 101)))) { + warning("'ZInputs' is missing: HypsoData[51] is used") } - if (is.null(ZInputs)) { - if (verbose & !identical(HypsoData, as.numeric(rep(NA, 101)))) { - warning("'ZInputs' is missing: HypsoData[51] is used") - } - ZInputs <- HypsoData[51L] - } - if (NLayers <= 0) { - stop("'NLayers' must be a positive integer value") - } - if (NLayers != as.integer(NLayers)) { - warning("Coerce 'NLayers' to be of integer type (", NLayers, ": ", as.integer(NLayers), ")") - NLayers <- as.integer(NLayers) - } + ZInputs <- HypsoData[51L] } + if (NLayers <= 0) { + stop("'NLayers' must be a positive integer value") + } + if (NLayers != as.integer(NLayers)) { + warning("Coerce 'NLayers' to be of integer type (", NLayers, ": ", as.integer(NLayers), ")") + NLayers <- as.integer(NLayers) + } + } - ## check semi-distributed mode - if (!is.null(Qupstream) & !is.null(LengthHydro) & !is.null(BasinAreas)) { - ObjectClass <- c(ObjectClass, "SD") - } else if (verbose & !all(c(is.null(Qupstream), is.null(LengthHydro), is.null(BasinAreas)))) { - warning("Missing argument: 'Qupstream', 'LengthHydro' and 'BasinAreas' must all be set to run in a semi-distributed mode. The lumped mode will be used") + ## check semi-distributed mode + if (!is.null(Qupstream) & !is.null(LengthHydro) & !is.null(BasinAreas)) { + ObjectClass <- c(ObjectClass, "SD") + } else if (verbose & !all(c(is.null(Qupstream), is.null(LengthHydro), is.null(BasinAreas)))) { + warning("Missing argument: 'Qupstream', 'LengthHydro' and 'BasinAreas' must all be set to run in a semi-distributed mode. The lumped mode will be used") + } + if ("SD" %in% ObjectClass) { + if (!("daily" %in% ObjectClass) & !("hourly" %in% ObjectClass)) { + stop("Only daily and hourly time steps can be used in a semi-distributed mode") } - if ("SD" %in% ObjectClass) { - if (!("daily" %in% ObjectClass) & !("hourly" %in% ObjectClass)) { - stop("Only daily and hourly time steps can be used in a semi-distributed mode") - } - if (!is.matrix(Qupstream) | !is.numeric(Qupstream)) { - stop("'Qupstream' must be a matrice of numeric values") - } - if (!is.vector(LengthHydro) | !is.vector(BasinAreas) | !is.numeric(LengthHydro) | !is.numeric(BasinAreas)) { - stop("'LengthHydro' and 'BasinAreas' must be vectors of numeric values") - } - if (ncol(Qupstream) != length(LengthHydro)) { - stop("'Qupstream' number of columns and 'LengthHydro' length must be equal") - } - if (length(LengthHydro) + 1 != length(BasinAreas)) { - stop("'BasinAreas' must have one more element than 'LengthHydro'") - } - if (nrow(Qupstream) != LLL) { - stop("'Qupstream' must have same number of rows as 'DatesR' length") - } - if(any(is.na(Qupstream))) { - stop("'Qupstream' cannot contain any NA value") - } + if (!is.matrix(Qupstream) | !is.numeric(Qupstream)) { + stop("'Qupstream' must be a matrice of numeric values") + } + if (!is.vector(LengthHydro) | !is.vector(BasinAreas) | !is.numeric(LengthHydro) | !is.numeric(BasinAreas)) { + stop("'LengthHydro' and 'BasinAreas' must be vectors of numeric values") + } + if (ncol(Qupstream) != length(LengthHydro)) { + stop("'Qupstream' number of columns and 'LengthHydro' length must be equal") + } + if (length(LengthHydro) + 1 != length(BasinAreas)) { + stop("'BasinAreas' must have one more element than 'LengthHydro'") + } + if (nrow(Qupstream) != LLL) { + stop("'Qupstream' must have same number of rows as 'DatesR' length") } + if(any(is.na(Qupstream))) { + stop("'Qupstream' cannot contain any NA value") + } + } - ##check_NA_values - BOOL_NA <- rep(FALSE, length(DatesR)) + ##check_NA_values + BOOL_NA <- rep(FALSE, length(DatesR)) - if ("GR" %in% ObjectClass) { - BOOL_NA_TMP <- (Precip < 0) | is.na(Precip) - if (sum(BOOL_NA_TMP) != 0) { - BOOL_NA <- BOOL_NA | BOOL_NA_TMP - if (verbose) { - warning("Values < 0 or NA values detected in 'Precip' series") - } + if ("GR" %in% ObjectClass) { + BOOL_NA_TMP <- (Precip < 0) | is.na(Precip) + if (sum(BOOL_NA_TMP) != 0) { + BOOL_NA <- BOOL_NA | BOOL_NA_TMP + if (verbose) { + warning("Values < 0 or NA values detected in 'Precip' series") } - BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap) - if (sum(BOOL_NA_TMP) != 0) { - BOOL_NA <- BOOL_NA | BOOL_NA_TMP - if (verbose) { - warning("Values < 0 or NA values detected in 'PotEvap' series") - } + } + BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap) + if (sum(BOOL_NA_TMP) != 0) { + BOOL_NA <- BOOL_NA | BOOL_NA_TMP + if (verbose) { + warning("Values < 0 or NA values detected in 'PotEvap' series") } } - if ("CemaNeige" %in% ObjectClass) { - BOOL_NA_TMP <- (Precip < 0) | is.na(Precip) + } + if ("CemaNeige" %in% ObjectClass) { + BOOL_NA_TMP <- (Precip < 0) | is.na(Precip) + if (sum(BOOL_NA_TMP) != 0) { + BOOL_NA <- BOOL_NA | BOOL_NA_TMP + if (verbose) { + warning("Values < 0 or NA values detected in 'Precip' series") + } + } + BOOL_NA_TMP <- (TempMean < (-150)) | is.na(TempMean) + if (sum(BOOL_NA_TMP) != 0) { + BOOL_NA <- BOOL_NA | BOOL_NA_TMP + if (verbose) { + warning("Values < -150 or NA values detected in 'TempMean' series") + } + } + if (!is.null(TempMin) & !is.null(TempMax)) { + BOOL_NA_TMP <- (TempMin < (-150)) | is.na(TempMin) if (sum(BOOL_NA_TMP) != 0) { BOOL_NA <- BOOL_NA | BOOL_NA_TMP if (verbose) { - warning("Values < 0 or NA values detected in 'Precip' series") + warning("Values < -150 or NA values detected in 'TempMin' series") } } - BOOL_NA_TMP <- (TempMean < (-150)) | is.na(TempMean) + BOOL_NA_TMP <- (TempMax < (-150)) | is.na(TempMax) if (sum(BOOL_NA_TMP) != 0) { BOOL_NA <- BOOL_NA | BOOL_NA_TMP if (verbose) { - warning("Values < -150 or NA values detected in 'TempMean' series") + warning("Values < -150 or NA values detected in 'TempMax' series") } } + } + } + if (sum(BOOL_NA) != 0) { + WTxt <- NULL + WTxt <- paste(WTxt, "\t Missing values are not allowed in 'InputsModel'", sep = "") + + Select <- (max(which(BOOL_NA)) + 1):length(BOOL_NA) + + if (Select[1L] > Select[2L]) { + stop("time series could not be trunced since missing values were detected at the last time-step") + } + if ("GR" %in% ObjectClass) { + Precip <- Precip[Select] + PotEvap <- PotEvap[Select] + } + if ("CemaNeige" %in% ObjectClass) { + Precip <- Precip[Select] + TempMean <- TempMean[Select] if (!is.null(TempMin) & !is.null(TempMax)) { - BOOL_NA_TMP <- (TempMin < (-150)) | is.na(TempMin) - if (sum(BOOL_NA_TMP) != 0) { - BOOL_NA <- BOOL_NA | BOOL_NA_TMP - if (verbose) { - warning("Values < -150 or NA values detected in 'TempMin' series") - } - } - BOOL_NA_TMP <- (TempMax < (-150)) | is.na(TempMax) - if (sum(BOOL_NA_TMP) != 0) { - BOOL_NA <- BOOL_NA | BOOL_NA_TMP - if (verbose) { - warning("Values < -150 or NA values detected in 'TempMax' series") - } - } + TempMin <- TempMin[Select] + TempMax <- TempMax[Select] } } - if (sum(BOOL_NA) != 0) { - WTxt <- NULL - WTxt <- paste(WTxt, "\t Missing values are not allowed in 'InputsModel'", sep = "") - - Select <- (max(which(BOOL_NA)) + 1):length(BOOL_NA) - - if (Select[1L] > Select[2L]) { - stop("time series could not be trunced since missing values were detected at the last time-step") - } - if ("GR" %in% ObjectClass) { - Precip <- Precip[Select] - PotEvap <- PotEvap[Select] - } - if ("CemaNeige" %in% ObjectClass) { - Precip <- Precip[Select] - TempMean <- TempMean[Select] - if (!is.null(TempMin) & !is.null(TempMax)) { - TempMin <- TempMin[Select] - TempMax <- TempMax[Select] - } - } - DatesR <- DatesR[Select] + DatesR <- DatesR[Select] - WTxt <- paste0(WTxt, "\t -> data were trunced to keep the most recent available time-steps") - WTxt <- paste0(WTxt, "\t -> ", length(Select), " time-steps were kept") + WTxt <- paste0(WTxt, "\t -> data were trunced to keep the most recent available time-steps") + WTxt <- paste0(WTxt, "\t -> ", length(Select), " time-steps were kept") - if (!is.null(WTxt) & verbose) { - warning(WTxt) - } + if (!is.null(WTxt) & verbose) { + warning(WTxt) } + } - ##DataAltiExtrapolation_Valery - if ("CemaNeige" %in% ObjectClass) { - RESULT <- DataAltiExtrapolation_Valery(DatesR = DatesR, - Precip = Precip, PrecipScale = PrecipScale, - TempMean = TempMean, TempMin = TempMin, TempMax = TempMax, - ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers, - verbose = verbose) - if (verbose) { - if (NLayers == 1) { - message("input series were successfully created on 1 elevation layer for use by CemaNeige") - } else { - message( "input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige") - } + ##DataAltiExtrapolation_Valery + if ("CemaNeige" %in% ObjectClass) { + RESULT <- DataAltiExtrapolation_Valery(DatesR = DatesR, + Precip = Precip, PrecipScale = PrecipScale, + TempMean = TempMean, TempMin = TempMin, TempMax = TempMax, + ZInputs = ZInputs, HypsoData = HypsoData, NLayers = NLayers, + verbose = verbose) + if (verbose) { + if (NLayers == 1) { + message("input series were successfully created on 1 elevation layer for use by CemaNeige") + } else { + message( "input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige") } } + } - ##Create_InputsModel - InputsModel <- list(DatesR = DatesR) - if ("GR" %in% ObjectClass) { - InputsModel <- c(InputsModel, list(Precip = as.double(Precip), PotEvap = as.double(PotEvap))) - } - if ("CemaNeige" %in% ObjectClass) { - InputsModel <- c(InputsModel, list(LayerPrecip = RESULT$LayerPrecip, - LayerTempMean = RESULT$LayerTempMean, - LayerFracSolidPrecip = RESULT$LayerFracSolidPrecip, - ZLayers = RESULT$ZLayers)) - } - if ("SD" %in% ObjectClass) { - InputsModel <- c(InputsModel, list(Qupstream = Qupstream, - LengthHydro = LengthHydro, - BasinAreas = BasinAreas)) - } + ##Create_InputsModel + InputsModel <- list(DatesR = DatesR) + if ("GR" %in% ObjectClass) { + InputsModel <- c(InputsModel, list(Precip = as.double(Precip), PotEvap = as.double(PotEvap))) + } + if ("CemaNeige" %in% ObjectClass) { + InputsModel <- c(InputsModel, list(LayerPrecip = RESULT$LayerPrecip, + LayerTempMean = RESULT$LayerTempMean, + LayerFracSolidPrecip = RESULT$LayerFracSolidPrecip, + ZLayers = RESULT$ZLayers)) + } + if ("SD" %in% ObjectClass) { + InputsModel <- c(InputsModel, list(Qupstream = Qupstream, + LengthHydro = LengthHydro, + BasinAreas = BasinAreas)) + } - class(InputsModel) <- c("InputsModel", ObjectClass) + class(InputsModel) <- c("InputsModel", ObjectClass) - return(InputsModel) + return(InputsModel) diff -Nru airgr-1.6.9.27/R/DataAltiExtrapolation_Valery.R airgr-1.6.10.4/R/DataAltiExtrapolation_Valery.R --- airgr-1.6.9.27/R/DataAltiExtrapolation_Valery.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/DataAltiExtrapolation_Valery.R 2021-01-28 12:56:23.000000000 +0000 @@ -3,549 +3,171 @@ TempMean, TempMin = NULL, TempMax = NULL, ZInputs, HypsoData, NLayers, verbose = TRUE) { - - ##Altitudinal_gradient_functions_______________________________________________________________ - ##unique_gradient_for_precipitation - GradP_Valery2010 <- function() { - return(0.00041) ### value from Valery PhD thesis page 126 - } - ##daily_gradients_for_mean_min_and_max_air_temperature - GradT_Valery2010 <- function() { - RESULT <- matrix(c( - 01, 01, 0.434, 0.366, 0.498, - 02, 01, 0.434, 0.366, 0.500, - 03, 01, 0.435, 0.367, 0.501, - 04, 01, 0.436, 0.367, 0.503, - 05, 01, 0.437, 0.367, 0.504, - 06, 01, 0.439, 0.367, 0.506, - 07, 01, 0.440, 0.367, 0.508, - 08, 01, 0.441, 0.368, 0.510, - 09, 01, 0.442, 0.368, 0.512, - 10, 01, 0.444, 0.368, 0.514, - 11, 01, 0.445, 0.368, 0.517, - 12, 01, 0.446, 0.368, 0.519, - 13, 01, 0.448, 0.369, 0.522, - 14, 01, 0.450, 0.369, 0.525, - 15, 01, 0.451, 0.369, 0.527, - 16, 01, 0.453, 0.370, 0.530, - 17, 01, 0.455, 0.370, 0.533, - 18, 01, 0.456, 0.370, 0.537, - 19, 01, 0.458, 0.371, 0.540, - 20, 01, 0.460, 0.371, 0.543, - 21, 01, 0.462, 0.371, 0.547, - 22, 01, 0.464, 0.372, 0.550, - 23, 01, 0.466, 0.372, 0.554, - 24, 01, 0.468, 0.373, 0.558, - 25, 01, 0.470, 0.373, 0.561, - 26, 01, 0.472, 0.374, 0.565, - 27, 01, 0.474, 0.374, 0.569, - 28, 01, 0.476, 0.375, 0.573, - 29, 01, 0.478, 0.375, 0.577, - 30, 01, 0.480, 0.376, 0.582, - 31, 01, 0.483, 0.376, 0.586, - 01, 02, 0.485, 0.377, 0.590, - 02, 02, 0.487, 0.377, 0.594, - 03, 02, 0.489, 0.378, 0.599, - 04, 02, 0.492, 0.379, 0.603, - 05, 02, 0.494, 0.379, 0.607, - 06, 02, 0.496, 0.380, 0.612, - 07, 02, 0.498, 0.381, 0.616, - 08, 02, 0.501, 0.381, 0.621, - 09, 02, 0.503, 0.382, 0.625, - 10, 02, 0.505, 0.383, 0.630, - 11, 02, 0.508, 0.384, 0.634, - 12, 02, 0.510, 0.384, 0.639, - 13, 02, 0.512, 0.385, 0.643, - 14, 02, 0.515, 0.386, 0.648, - 15, 02, 0.517, 0.387, 0.652, - 16, 02, 0.519, 0.387, 0.657, - 17, 02, 0.522, 0.388, 0.661, - 18, 02, 0.524, 0.389, 0.666, - 19, 02, 0.526, 0.390, 0.670, - 20, 02, 0.528, 0.391, 0.674, - 21, 02, 0.530, 0.392, 0.679, - 22, 02, 0.533, 0.393, 0.683, - 23, 02, 0.535, 0.393, 0.687, - 24, 02, 0.537, 0.394, 0.691, - 25, 02, 0.539, 0.395, 0.695, - 26, 02, 0.541, 0.396, 0.699, - 27, 02, 0.543, 0.397, 0.703, - 28, 02, 0.545, 0.398, 0.707, - 29, 02, 0.546, 0.399, 0.709, - 01, 03, 0.547, 0.399, 0.711, - 02, 03, 0.549, 0.400, 0.715, - 03, 03, 0.551, 0.401, 0.718, - 04, 03, 0.553, 0.402, 0.722, - 05, 03, 0.555, 0.403, 0.726, - 06, 03, 0.557, 0.404, 0.729, - 07, 03, 0.559, 0.405, 0.732, - 08, 03, 0.560, 0.406, 0.736, - 09, 03, 0.562, 0.406, 0.739, - 10, 03, 0.564, 0.407, 0.742, - 11, 03, 0.566, 0.408, 0.745, - 12, 03, 0.567, 0.409, 0.748, - 13, 03, 0.569, 0.410, 0.750, - 14, 03, 0.570, 0.411, 0.753, - 15, 03, 0.572, 0.412, 0.756, - 16, 03, 0.573, 0.413, 0.758, - 17, 03, 0.575, 0.414, 0.761, - 18, 03, 0.576, 0.415, 0.763, - 19, 03, 0.577, 0.416, 0.765, - 20, 03, 0.579, 0.417, 0.767, - 21, 03, 0.580, 0.417, 0.769, - 22, 03, 0.581, 0.418, 0.771, - 23, 03, 0.582, 0.419, 0.773, - 24, 03, 0.583, 0.420, 0.774, - 25, 03, 0.584, 0.421, 0.776, - 26, 03, 0.585, 0.422, 0.777, - 27, 03, 0.586, 0.422, 0.779, - 28, 03, 0.587, 0.423, 0.780, - 29, 03, 0.588, 0.424, 0.781, - 30, 03, 0.589, 0.425, 0.782, - 31, 03, 0.590, 0.425, 0.783, - 01, 04, 0.591, 0.426, 0.784, - 02, 04, 0.591, 0.427, 0.785, - 03, 04, 0.592, 0.427, 0.785, - 04, 04, 0.593, 0.428, 0.786, - 05, 04, 0.593, 0.429, 0.787, - 06, 04, 0.594, 0.429, 0.787, - 07, 04, 0.595, 0.430, 0.787, - 08, 04, 0.595, 0.431, 0.788, - 09, 04, 0.596, 0.431, 0.788, - 10, 04, 0.596, 0.432, 0.788, - 11, 04, 0.597, 0.432, 0.788, - 12, 04, 0.597, 0.433, 0.788, - 13, 04, 0.597, 0.433, 0.788, - 14, 04, 0.598, 0.434, 0.788, - 15, 04, 0.598, 0.434, 0.788, - 16, 04, 0.598, 0.435, 0.787, - 17, 04, 0.599, 0.435, 0.787, - 18, 04, 0.599, 0.436, 0.787, - 19, 04, 0.599, 0.436, 0.786, - 20, 04, 0.599, 0.436, 0.786, - 21, 04, 0.600, 0.437, 0.785, - 22, 04, 0.600, 0.437, 0.785, - 23, 04, 0.600, 0.437, 0.784, - 24, 04, 0.600, 0.438, 0.784, - 25, 04, 0.600, 0.438, 0.783, - 26, 04, 0.601, 0.438, 0.783, - 27, 04, 0.601, 0.438, 0.782, - 28, 04, 0.601, 0.439, 0.781, - 29, 04, 0.601, 0.439, 0.781, - 30, 04, 0.601, 0.439, 0.780, - 01, 05, 0.601, 0.439, 0.779, - 02, 05, 0.601, 0.439, 0.778, - 03, 05, 0.601, 0.439, 0.778, - 04, 05, 0.601, 0.440, 0.777, - 05, 05, 0.601, 0.440, 0.776, - 06, 05, 0.601, 0.440, 0.775, - 07, 05, 0.601, 0.440, 0.775, - 08, 05, 0.601, 0.440, 0.774, - 09, 05, 0.601, 0.440, 0.773, - 10, 05, 0.602, 0.440, 0.772, - 11, 05, 0.602, 0.440, 0.772, - 12, 05, 0.602, 0.440, 0.771, - 13, 05, 0.602, 0.440, 0.770, - 14, 05, 0.602, 0.440, 0.770, - 15, 05, 0.602, 0.440, 0.769, - 16, 05, 0.602, 0.440, 0.768, - 17, 05, 0.602, 0.440, 0.768, - 18, 05, 0.602, 0.440, 0.767, - 19, 05, 0.602, 0.440, 0.767, - 20, 05, 0.602, 0.440, 0.766, - 21, 05, 0.602, 0.440, 0.766, - 22, 05, 0.602, 0.440, 0.765, - 23, 05, 0.602, 0.440, 0.765, - 24, 05, 0.602, 0.440, 0.764, - 25, 05, 0.602, 0.440, 0.764, - 26, 05, 0.602, 0.440, 0.764, - 27, 05, 0.602, 0.439, 0.763, - 28, 05, 0.602, 0.439, 0.763, - 29, 05, 0.602, 0.439, 0.763, - 30, 05, 0.602, 0.439, 0.762, - 31, 05, 0.602, 0.439, 0.762, - 01, 06, 0.602, 0.439, 0.762, - 02, 06, 0.602, 0.439, 0.762, - 03, 06, 0.602, 0.439, 0.762, - 04, 06, 0.602, 0.439, 0.762, - 05, 06, 0.602, 0.439, 0.762, - 06, 06, 0.602, 0.438, 0.761, - 07, 06, 0.602, 0.438, 0.761, - 08, 06, 0.602, 0.438, 0.761, - 09, 06, 0.602, 0.438, 0.761, - 10, 06, 0.602, 0.438, 0.761, - 11, 06, 0.602, 0.438, 0.762, - 12, 06, 0.602, 0.438, 0.762, - 13, 06, 0.602, 0.438, 0.762, - 14, 06, 0.602, 0.438, 0.762, - 15, 06, 0.602, 0.437, 0.762, - 16, 06, 0.602, 0.437, 0.762, - 17, 06, 0.602, 0.437, 0.762, - 18, 06, 0.602, 0.437, 0.762, - 19, 06, 0.602, 0.437, 0.763, - 20, 06, 0.602, 0.437, 0.763, - 21, 06, 0.602, 0.437, 0.763, - 22, 06, 0.602, 0.436, 0.763, - 23, 06, 0.602, 0.436, 0.763, - 24, 06, 0.602, 0.436, 0.764, - 25, 06, 0.602, 0.436, 0.764, - 26, 06, 0.601, 0.436, 0.764, - 27, 06, 0.601, 0.436, 0.764, - 28, 06, 0.601, 0.436, 0.764, - 29, 06, 0.601, 0.435, 0.765, - 30, 06, 0.601, 0.435, 0.765, - 01, 07, 0.601, 0.435, 0.765, - 02, 07, 0.600, 0.435, 0.765, - 03, 07, 0.600, 0.435, 0.765, - 04, 07, 0.600, 0.434, 0.766, - 05, 07, 0.600, 0.434, 0.766, - 06, 07, 0.599, 0.434, 0.766, - 07, 07, 0.599, 0.434, 0.766, - 08, 07, 0.599, 0.434, 0.766, - 09, 07, 0.598, 0.433, 0.766, - 10, 07, 0.598, 0.433, 0.766, - 11, 07, 0.598, 0.433, 0.766, - 12, 07, 0.597, 0.433, 0.766, - 13, 07, 0.597, 0.432, 0.767, - 14, 07, 0.597, 0.432, 0.767, - 15, 07, 0.596, 0.432, 0.767, - 16, 07, 0.596, 0.432, 0.766, - 17, 07, 0.595, 0.431, 0.766, - 18, 07, 0.595, 0.431, 0.766, - 19, 07, 0.594, 0.431, 0.766, - 20, 07, 0.594, 0.430, 0.766, - 21, 07, 0.593, 0.430, 0.766, - 22, 07, 0.593, 0.430, 0.766, - 23, 07, 0.592, 0.429, 0.765, - 24, 07, 0.592, 0.429, 0.765, - 25, 07, 0.591, 0.428, 0.765, - 26, 07, 0.590, 0.428, 0.765, - 27, 07, 0.590, 0.428, 0.764, - 28, 07, 0.589, 0.427, 0.764, - 29, 07, 0.588, 0.427, 0.764, - 30, 07, 0.588, 0.426, 0.763, - 31, 07, 0.587, 0.426, 0.763, - 01, 08, 0.586, 0.425, 0.762, - 02, 08, 0.586, 0.425, 0.762, - 03, 08, 0.585, 0.424, 0.761, - 04, 08, 0.584, 0.424, 0.761, - 05, 08, 0.583, 0.423, 0.760, - 06, 08, 0.583, 0.423, 0.760, - 07, 08, 0.582, 0.422, 0.759, - 08, 08, 0.581, 0.421, 0.758, - 09, 08, 0.580, 0.421, 0.758, - 10, 08, 0.579, 0.420, 0.757, - 11, 08, 0.578, 0.420, 0.756, - 12, 08, 0.578, 0.419, 0.755, - 13, 08, 0.577, 0.418, 0.754, - 14, 08, 0.576, 0.418, 0.754, - 15, 08, 0.575, 0.417, 0.753, - 16, 08, 0.574, 0.416, 0.752, - 17, 08, 0.573, 0.415, 0.751, - 18, 08, 0.572, 0.415, 0.750, - 19, 08, 0.571, 0.414, 0.749, - 20, 08, 0.570, 0.413, 0.748, - 21, 08, 0.569, 0.413, 0.747, - 22, 08, 0.569, 0.412, 0.746, - 23, 08, 0.568, 0.411, 0.745, - 24, 08, 0.567, 0.410, 0.744, - 25, 08, 0.566, 0.409, 0.743, - 26, 08, 0.565, 0.409, 0.742, - 27, 08, 0.564, 0.408, 0.741, - 28, 08, 0.563, 0.407, 0.740, - 29, 08, 0.562, 0.406, 0.738, - 30, 08, 0.561, 0.405, 0.737, - 31, 08, 0.560, 0.405, 0.736, - 01, 09, 0.558, 0.404, 0.735, - 02, 09, 0.557, 0.403, 0.734, - 03, 09, 0.556, 0.402, 0.732, - 04, 09, 0.555, 0.401, 0.731, - 05, 09, 0.554, 0.401, 0.730, - 06, 09, 0.553, 0.400, 0.728, - 07, 09, 0.552, 0.399, 0.727, - 08, 09, 0.551, 0.398, 0.725, - 09, 09, 0.550, 0.397, 0.724, - 10, 09, 0.549, 0.396, 0.723, - 11, 09, 0.548, 0.396, 0.721, - 12, 09, 0.546, 0.395, 0.720, - 13, 09, 0.545, 0.394, 0.718, - 14, 09, 0.544, 0.393, 0.717, - 15, 09, 0.543, 0.392, 0.715, - 16, 09, 0.542, 0.391, 0.713, - 17, 09, 0.541, 0.391, 0.712, - 18, 09, 0.540, 0.390, 0.710, - 19, 09, 0.538, 0.389, 0.709, - 20, 09, 0.537, 0.388, 0.707, - 21, 09, 0.536, 0.388, 0.705, - 22, 09, 0.535, 0.387, 0.703, - 23, 09, 0.533, 0.386, 0.702, - 24, 09, 0.532, 0.385, 0.700, - 25, 09, 0.531, 0.385, 0.698, - 26, 09, 0.530, 0.384, 0.696, - 27, 09, 0.528, 0.383, 0.694, - 28, 09, 0.527, 0.383, 0.692, - 29, 09, 0.526, 0.382, 0.690, - 30, 09, 0.525, 0.381, 0.688, - 01, 10, 0.523, 0.381, 0.686, - 02, 10, 0.522, 0.380, 0.684, - 03, 10, 0.521, 0.379, 0.682, - 04, 10, 0.519, 0.379, 0.680, - 05, 10, 0.518, 0.378, 0.678, - 06, 10, 0.517, 0.377, 0.676, - 07, 10, 0.515, 0.377, 0.674, - 08, 10, 0.514, 0.376, 0.671, - 09, 10, 0.512, 0.376, 0.669, - 10, 10, 0.511, 0.375, 0.667, - 11, 10, 0.510, 0.375, 0.664, - 12, 10, 0.508, 0.374, 0.662, - 13, 10, 0.507, 0.374, 0.659, - 14, 10, 0.505, 0.373, 0.657, - 15, 10, 0.504, 0.373, 0.654, - 16, 10, 0.502, 0.372, 0.652, - 17, 10, 0.501, 0.372, 0.649, - 18, 10, 0.499, 0.372, 0.647, - 19, 10, 0.498, 0.371, 0.644, - 20, 10, 0.496, 0.371, 0.641, - 21, 10, 0.495, 0.371, 0.639, - 22, 10, 0.493, 0.370, 0.636, - 23, 10, 0.492, 0.370, 0.633, - 24, 10, 0.490, 0.370, 0.630, - 25, 10, 0.489, 0.369, 0.628, - 26, 10, 0.487, 0.369, 0.625, - 27, 10, 0.485, 0.369, 0.622, - 28, 10, 0.484, 0.368, 0.619, - 29, 10, 0.482, 0.368, 0.616, - 30, 10, 0.481, 0.368, 0.613, - 31, 10, 0.479, 0.368, 0.610, - 01, 11, 0.478, 0.368, 0.607, - 02, 11, 0.476, 0.367, 0.604, - 03, 11, 0.475, 0.367, 0.601, - 04, 11, 0.473, 0.367, 0.598, - 05, 11, 0.471, 0.367, 0.595, - 06, 11, 0.470, 0.367, 0.592, - 07, 11, 0.468, 0.367, 0.589, - 08, 11, 0.467, 0.366, 0.586, - 09, 11, 0.465, 0.366, 0.583, - 10, 11, 0.464, 0.366, 0.580, - 11, 11, 0.462, 0.366, 0.577, - 12, 11, 0.461, 0.366, 0.574, - 13, 11, 0.459, 0.366, 0.571, - 14, 11, 0.458, 0.366, 0.568, - 15, 11, 0.456, 0.366, 0.565, - 16, 11, 0.455, 0.366, 0.562, - 17, 11, 0.454, 0.366, 0.559, - 18, 11, 0.452, 0.365, 0.556, - 19, 11, 0.451, 0.365, 0.553, - 20, 11, 0.450, 0.365, 0.550, - 21, 11, 0.448, 0.365, 0.547, - 22, 11, 0.447, 0.365, 0.544, - 23, 11, 0.446, 0.365, 0.542, - 24, 11, 0.445, 0.365, 0.539, - 25, 11, 0.443, 0.365, 0.536, - 26, 11, 0.442, 0.365, 0.533, - 27, 11, 0.441, 0.365, 0.531, - 28, 11, 0.440, 0.365, 0.528, - 29, 11, 0.439, 0.365, 0.526, - 30, 11, 0.438, 0.365, 0.523, - 01, 12, 0.437, 0.365, 0.521, - 02, 12, 0.436, 0.365, 0.519, - 03, 12, 0.435, 0.365, 0.517, - 04, 12, 0.434, 0.365, 0.515, - 05, 12, 0.434, 0.365, 0.513, - 06, 12, 0.433, 0.365, 0.511, - 07, 12, 0.432, 0.365, 0.509, - 08, 12, 0.431, 0.365, 0.507, - 09, 12, 0.431, 0.365, 0.505, - 10, 12, 0.430, 0.365, 0.504, - 11, 12, 0.430, 0.365, 0.502, - 12, 12, 0.429, 0.365, 0.501, - 13, 12, 0.429, 0.365, 0.500, - 14, 12, 0.429, 0.365, 0.498, - 15, 12, 0.428, 0.365, 0.497, - 16, 12, 0.428, 0.365, 0.496, - 17, 12, 0.428, 0.365, 0.496, - 18, 12, 0.428, 0.365, 0.495, - 19, 12, 0.428, 0.365, 0.494, - 20, 12, 0.428, 0.365, 0.494, - 21, 12, 0.428, 0.365, 0.494, - 22, 12, 0.428, 0.365, 0.493, - 23, 12, 0.429, 0.365, 0.493, - 24, 12, 0.429, 0.366, 0.493, - 25, 12, 0.429, 0.366, 0.493, - 26, 12, 0.430, 0.366, 0.494, - 27, 12, 0.430, 0.366, 0.494, - 28, 12, 0.431, 0.366, 0.495, - 29, 12, 0.431, 0.366, 0.495, - 30, 12, 0.432, 0.366, 0.496, - 31, 12, 0.433, 0.366, 0.497), ncol = 5, byrow = TRUE) - - dimnames(RESULT) <- list(1:366, c("day", "month", "grad_Tmean", "grad_Tmin", "grad_Tmax")) - - return(RESULT) - - } - - - + + ##Altitudinal_gradient_functions_______________________________________________________________ + ##unique_gradient_for_precipitation + GradP_Valery2010 <- 0.00041 ### value from Valery PhD thesis page 126 + + + ##Format_______________________________________________________________________________________ - HypsoData <- as.double(HypsoData) - ZInputs <- as.double(ZInputs) - - - + HypsoData <- as.double(HypsoData) + ZInputs <- as.double(ZInputs) + + + ##ElevationLayers_Creation_____________________________________________________________________ - ZLayers <- as.double(rep(NA, NLayers)) - - if (!identical(HypsoData, as.double(rep(NA, 101)))) { - nmoy <- 100 %/% NLayers - nreste <- 100 %% NLayers - ncont <- 0 - - for (iLayer in 1:NLayers) { - if (nreste > 0) { - nn <- nmoy + 1 - nreste <- nreste - 1 - } else { - nn <- nmoy - } - if (nn == 1) { - ZLayers[iLayer] <- HypsoData[ncont + 1] - } - if (nn == 2) { - ZLayers[iLayer] <- 0.5 * (HypsoData[ncont + 1] + HypsoData[ncont + 2]) - } - if (nn > 2) { - ZLayers[iLayer] <- HypsoData[ncont + nn / 2] - } - ncont <- ncont + nn + ZLayers <- as.double(rep(NA, NLayers)) + + if (!identical(HypsoData, as.double(rep(NA, 101)))) { + nmoy <- 100 %/% NLayers + nreste <- 100 %% NLayers + ncont <- 0 + + for (iLayer in 1:NLayers) { + if (nreste > 0) { + nn <- nmoy + 1 + nreste <- nreste - 1 + } else { + nn <- nmoy + } + if (nn == 1) { + ZLayers[iLayer] <- HypsoData[ncont + 1] + } + if (nn == 2) { + ZLayers[iLayer] <- 0.5 * (HypsoData[ncont + 1] + HypsoData[ncont + 2]) } + if (nn > 2) { + ZLayers[iLayer] <- HypsoData[ncont + nn / 2] + } + ncont <- ncont + nn } - - + } + + ##Precipitation_extrapolation__________________________________________________________________ ##Initialisation - if (identical(ZInputs, HypsoData[51]) & NLayers == 1) { - LayerPrecip <- list(as.double(Precip)) - } else { - ##Elevation_gradients_for_daily_mean_precipitation - GradP <- GradP_Valery2010() ### single value - TabGradP <- rep(GradP, length(Precip)) - ##Extrapolation - ##Thresold_of_inputs_median_elevation - Zthreshold <- 4000 - LayerPrecip_mat <- sapply(1:NLayers, function(iLayer) { - ##If_layer_elevation_smaller_than_Zthreshold - if (ZLayers[iLayer] <= Zthreshold) { - prcp <- as.double(Precip * exp(TabGradP * (ZLayers[iLayer] - ZInputs))) - ##If_layer_elevation_greater_than_Zthreshold + if (identical(ZInputs, HypsoData[51]) & NLayers == 1) { + LayerPrecip <- list(as.double(Precip)) + } else { + ##Elevation_gradients_for_daily_mean_precipitation + GradP <- GradP_Valery2010 ### single value + TabGradP <- rep(GradP, length(Precip)) + ##Extrapolation + ##Thresold_of_inputs_median_elevation + Zthreshold <- 4000 + LayerPrecip_mat <- sapply(1:NLayers, function(iLayer) { + ##If_layer_elevation_smaller_than_Zthreshold + if (ZLayers[iLayer] <= Zthreshold) { + prcp <- as.double(Precip * exp(TabGradP * (ZLayers[iLayer] - ZInputs))) + ##If_layer_elevation_greater_than_Zthreshold + } else { + ##If_inputs_median_elevation_smaller_than_Zthreshold + if (ZInputs <= Zthreshold) { + prcp <- as.double(Precip * exp(TabGradP * (Zthreshold - ZInputs))) + ##If_inputs_median_elevation_greater_then_Zthreshold } else { - ##If_inputs_median_elevation_smaller_than_Zthreshold - if (ZInputs <= Zthreshold) { - prcp <- as.double(Precip * exp(TabGradP * (Zthreshold - ZInputs))) - ##If_inputs_median_elevation_greater_then_Zthreshold - } else { - prcp <- as.double(Precip) - } + prcp <- as.double(Precip) } - return(prcp) - }) - if (PrecipScale) { - LayerPrecip_mat <- LayerPrecip_mat / rowMeans(LayerPrecip_mat) * Precip - LayerPrecip_mat[is.nan(LayerPrecip_mat)] <- 0 } - LayerPrecip <- as.list(as.data.frame(LayerPrecip_mat)) + return(prcp) + }) + if (PrecipScale) { + LayerPrecip_mat <- LayerPrecip_mat / rowMeans(LayerPrecip_mat) * Precip + LayerPrecip_mat[is.nan(LayerPrecip_mat)] <- 0 } - - - + LayerPrecip <- as.list(as.data.frame(LayerPrecip_mat)) + } + + + ##Temperature_extrapolation____________________________________________________________________ ##Initialisation - LayerTempMean <- list() - LayerTempMin <- list() - LayerTempMax <- list() - - if (identical(ZInputs, HypsoData[51]) & NLayers == 1) { - LayerTempMean[[1]] <- as.double(TempMean) - + LayerTempMean <- list() + LayerTempMin <- list() + LayerTempMax <- list() + + if (identical(ZInputs, HypsoData[51]) & NLayers == 1) { + LayerTempMean[[1]] <- as.double(TempMean) + + if (!is.null(TempMin) & !is.null(TempMax)) { + LayerTempMin[[1]] <- as.double(TempMin) + LayerTempMax[[1]] <- as.double(TempMax) + } + } else { + ##Elevation_gradients_for_daily_mean_min_and_max_temperature + GradT <- .GradT_Valery2010 + iday <- match(format(DatesR, format = "%d%m"), + sprintf("%02i%02i", GradT[, "day"], GradT[, "month"])) + TabGradT <- GradT[iday, c("grad_Tmean", "grad_Tmin", "grad_Tmax")] + ##Extrapolation + ##On_each_elevation_layer... + for (iLayer in 1:NLayers) { + LayerTempMean[[iLayer]] <- as.double(TempMean + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmean"]) / 100) if (!is.null(TempMin) & !is.null(TempMax)) { - LayerTempMin[[1]] <- as.double(TempMin) - LayerTempMax[[1]] <- as.double(TempMax) - } - } else { - ##Elevation_gradients_for_daily_mean_min_and_max_temperature - GradT <- as.data.frame(GradT_Valery2010()) - iday <- match(format(DatesR, format = "%d%m"), - sprintf("%02i%02i", GradT[, "day"], GradT[, "month"])) - TabGradT <- - GradT[iday, c("grad_Tmean", "grad_Tmin", "grad_Tmax")] - ##Extrapolation - ##On_each_elevation_layer... - for (iLayer in 1:NLayers) { - LayerTempMean[[iLayer]] <- as.double(TempMean + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmean"]) / 100) - if (!is.null(TempMin) & !is.null(TempMax)) { - LayerTempMin[[iLayer]] <- as.double(TempMin + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmin"]) / 100) - LayerTempMax[[iLayer]] <- as.double(TempMax + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmax"]) / 100) - } + LayerTempMin[[iLayer]] <- as.double(TempMin + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmin"]) / 100) + LayerTempMax[[iLayer]] <- as.double(TempMax + (ZInputs - ZLayers[iLayer]) * abs(TabGradT[, "grad_Tmax"]) / 100) } } - - - + } + + + ##Solid_Fraction_for_each_elevation_layer______________________________________________________ - LayerFracSolidPrecip <- list() - - ##Thresold_of_inputs_median_elevation - Zthreshold <- 1500 - - ##Option - Option <- "USACE" - if (!is.na(ZInputs)) { - if (ZInputs < Zthreshold & !is.null(TempMin) & !is.null(TempMax)) { - Option <- "Hydrotel" - } - } - - ##On_each_elevation_layer... - for (iLayer in 1:NLayers) { + LayerFracSolidPrecip <- list() - ##Turcotte_formula_from_Hydrotel - if (Option == "Hydrotel") { - TempMin <- LayerTempMin[[iLayer]] - TempMax <- LayerTempMax[[iLayer]] - SolidFraction <- 1 - TempMax / (TempMax - TempMin) - SolidFraction[TempMin >= 0] <- 0 - SolidFraction[TempMax <= 0] <- 1 - } - ##USACE_formula - if (Option == "USACE") { - USACE_Tmin <- -1.0 - USACE_Tmax <- 3.0 - TempMean <- LayerTempMean[[iLayer]] - SolidFraction <- 1 - (TempMean - USACE_Tmin) / (USACE_Tmax - USACE_Tmin) - SolidFraction[TempMean > USACE_Tmax] <- 0 - SolidFraction[TempMean < USACE_Tmin] <- 1 - } - LayerFracSolidPrecip[[iLayer]] <- as.double(SolidFraction) + ##Thresold_of_inputs_median_elevation + Zthreshold <- 1500 + + ##Option + Option <- "USACE" + if (!is.na(ZInputs)) { + if (ZInputs < Zthreshold & !is.null(TempMin) & !is.null(TempMax)) { + Option <- "Hydrotel" } - namesLayer <- sprintf("L%i", seq_along(LayerPrecip)) - names(LayerPrecip) <- namesLayer - names(LayerTempMean) <- namesLayer - if (!is.null(TempMin) & !is.null(TempMax)) { - names(LayerTempMin) <- namesLayer - names(LayerTempMax) <- namesLayer - } - names(LayerFracSolidPrecip) <- namesLayer - - - + } + + ##On_each_elevation_layer... + for (iLayer in 1:NLayers) { + + ##Turcotte_formula_from_Hydrotel + if (Option == "Hydrotel") { + TempMin <- LayerTempMin[[iLayer]] + TempMax <- LayerTempMax[[iLayer]] + SolidFraction <- 1 - TempMax / (TempMax - TempMin) + SolidFraction[TempMin >= 0] <- 0 + SolidFraction[TempMax <= 0] <- 1 + } + ##USACE_formula + if (Option == "USACE") { + USACE_Tmin <- -1.0 + USACE_Tmax <- 3.0 + TempMean <- LayerTempMean[[iLayer]] + SolidFraction <- 1 - (TempMean - USACE_Tmin) / (USACE_Tmax - USACE_Tmin) + SolidFraction[TempMean > USACE_Tmax] <- 0 + SolidFraction[TempMean < USACE_Tmin] <- 1 + } + LayerFracSolidPrecip[[iLayer]] <- as.double(SolidFraction) + } + namesLayer <- sprintf("L%i", seq_along(LayerPrecip)) + names(LayerPrecip) <- namesLayer + names(LayerTempMean) <- namesLayer + if (!is.null(TempMin) & !is.null(TempMax)) { + names(LayerTempMin) <- namesLayer + names(LayerTempMax) <- namesLayer + } + names(LayerFracSolidPrecip) <- namesLayer + + + ##END__________________________________________________________________________________________ - return(list(LayerPrecip = LayerPrecip, - LayerTempMean = LayerTempMean, - LayerTempMin = LayerTempMin, - LayerTempMax = LayerTempMax, - LayerFracSolidPrecip = LayerFracSolidPrecip, - ZLayers = ZLayers)) - - + return(list(LayerPrecip = LayerPrecip, + LayerTempMean = LayerTempMean, + LayerTempMin = LayerTempMin, + LayerTempMax = LayerTempMax, + LayerFracSolidPrecip = LayerFracSolidPrecip, + ZLayers = ZLayers)) + + } diff -Nru airgr-1.6.9.27/R/Imax.R airgr-1.6.10.4/R/Imax.R --- airgr-1.6.9.27/R/Imax.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/Imax.R 2021-01-28 12:56:23.000000000 +0000 @@ -1,17 +1,20 @@ -Imax <- function(InputsModel, - IndPeriod_Run, +Imax <- function(InputsModel, + IndPeriod_Run, TestedValues = seq(from = 0.1, to = 3, by = 0.1)) { - - ##_____Arguments_check_____________________________________________________________________ + + + ## ---------- check arguments + + ## InputsModel if (!inherits(InputsModel, "InputsModel")) { stop("'InputsModel' must be of class 'InputsModel'") - } + } if (!inherits(InputsModel, "hourly")) { stop("'InputsModel' must be of class 'hourly'") - } - - ##check_IndPeriod_Run + } + + ## IndPeriod_Run if (!is.vector(IndPeriod_Run)) { stop("'IndPeriod_Run' must be a vector of numeric values") } @@ -21,24 +24,28 @@ if (!identical(as.integer(IndPeriod_Run), IndPeriod_Run[1]:IndPeriod_Run[length(IndPeriod_Run)])) { stop("'IndPeriod_Run' must be a continuous sequence of integers") } - - ##TestedValues + + ## TestedValues if (!(is.numeric(TestedValues))) { stop("'TestedValues' must be 'numeric'") } - - ##aggregate data at the daily time step - TabSeries <- data.frame(DatesR = InputsModel$DatesR[IndPeriod_Run], - Precip = InputsModel$Precip[IndPeriod_Run], - PotEvap = InputsModel$PotEvap[IndPeriod_Run]) - daily_data <- SeriesAggreg(TabSeries, Format = "%Y%m%d", - ConvertFun = c("sum", "sum")) - - ##calculate total interception of daily GR models on the period + + ## ---------- hourly inputs aggregation + + ## aggregate data at the daily time step + daily_data <- SeriesAggreg(InputsModel[IndPeriod_Run], Format = "%Y%m%d") + + + ## ---------- calculate interception + + ## calculate total interception of daily GR models on the period cum_daily <- sum(pmin(daily_data$Precip, daily_data$PotEvap)) - - ##calculate total interception of the GR5H interception store on the period + if (anyNA(cum_daily)) { + stop("'IndPeriod_Run' must be set to select 24 hours by day") + } + + ## calculate total interception of the GR5H interception store on the period ## and compute difference with daily values differences <- array(NA, c(length(TestedValues))) for (Imax in TestedValues) { @@ -52,8 +59,8 @@ } differences[which(Imax == TestedValues)] <- abs(cum_hourly - cum_daily) } - - ##return the Imax value that minimises the difference + + ## return the Imax value that minimises the difference return(TestedValues[which.min(differences)]) - + } diff -Nru airgr-1.6.9.27/R/PEdaily_Oudin.R airgr-1.6.10.4/R/PEdaily_Oudin.R --- airgr-1.6.9.27/R/PEdaily_Oudin.R 2021-01-08 04:34:09.000000000 +0000 +++ airgr-1.6.10.4/R/PEdaily_Oudin.R 2021-01-28 12:56:23.000000000 +0000 @@ -70,7 +70,7 @@ COSOM <- -1 } if (COSOM > 1) { - COSOM <- 1 + COSOM <- 1 } COSOM2 <- COSOM * COSOM @@ -94,11 +94,11 @@ if (is.na(Temp[k])) { PE_Oudin_D[k] <- NA } else { - if (Temp[k] >= -5.0) { - PE_Oudin_D[k] <- GE * (Temp[k] + 5) / 100 / 28.5 - } else { - PE_Oudin_D[k] <- 0 - } + if (Temp[k] >= -5.0) { + PE_Oudin_D[k] <- GE * (Temp[k] + 5) / 100 / 28.5 + } else { + PE_Oudin_D[k] <- 0 + } } } diff -Nru airgr-1.6.9.27/R/PE_Oudin.R airgr-1.6.10.4/R/PE_Oudin.R --- airgr-1.6.9.27/R/PE_Oudin.R 2021-01-13 08:16:29.000000000 +0000 +++ airgr-1.6.10.4/R/PE_Oudin.R 2021-01-28 12:56:23.000000000 +0000 @@ -65,7 +65,7 @@ LInputs = as.integer(length(Temp)) if (length(FI) == 1) { - FI <- rep(FI, LInputs) + FI <- rep(FI, LInputs) } RESULTS <- .Fortran("frun_pe_oudin", PACKAGE = "airGR", @@ -96,7 +96,7 @@ COSOM <- -1 } if (COSOM > 1) { - COSOM <- 1 + COSOM <- 1 } COSOM2 <- COSOM * COSOM diff -Nru airgr-1.6.9.27/R/RunModel_GR2M.R airgr-1.6.10.4/R/RunModel_GR2M.R --- airgr-1.6.9.27/R/RunModel_GR2M.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/RunModel_GR2M.R 2021-01-28 12:56:23.000000000 +0000 @@ -59,8 +59,8 @@ ## Use of IniResLevels if (!is.null(RunOptions$IniResLevels)) { - RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm) - RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[2] ### routing store level (mm) + RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[2] ### routing store level (mm) } ## Call GR model Fortan diff -Nru airgr-1.6.9.27/R/RunModel_GR4H.R airgr-1.6.10.4/R/RunModel_GR4H.R --- airgr-1.6.9.27/R/RunModel_GR4H.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/RunModel_GR4H.R 2021-01-28 12:56:23.000000000 +0000 @@ -64,8 +64,8 @@ ## Use of IniResLevels if (!is.null(RunOptions$IniResLevels)) { - RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm) - RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm) + RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm) } ## Call GR model Fortan diff -Nru airgr-1.6.9.27/R/RunModel_GR4J.R airgr-1.6.10.4/R/RunModel_GR4J.R --- airgr-1.6.9.27/R/RunModel_GR4J.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/RunModel_GR4J.R 2021-01-28 12:56:23.000000000 +0000 @@ -63,8 +63,8 @@ ## Use of IniResLevels if (!is.null(RunOptions$IniResLevels)) { - RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm) - RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm) + RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm) } ## Call GR model Fortan diff -Nru airgr-1.6.9.27/R/RunModel_GR5H.R airgr-1.6.10.4/R/RunModel_GR5H.R --- airgr-1.6.9.27/R/RunModel_GR5H.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/RunModel_GR5H.R 2021-01-28 12:56:23.000000000 +0000 @@ -1,6 +1,6 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) { - - + + ## Initialization of variables NParam <- 5 FortranOutputs <- .FortranOutputs(GR = "GR5H")$GR @@ -10,24 +10,24 @@ } else { Imax <- -99 } - - + + ## 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(RunOptions, "RunOptions" )) { stop("'RunOptions' must be of class 'RunOptions' ") - } + } if (!inherits(RunOptions, "GR" )) { stop("'RunOptions' must be of class 'GR' ") - } + } if (!is.vector(Param) | !is.numeric(Param)) { stop("'Param' must be a numeric vector") } @@ -35,7 +35,7 @@ stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = "")) } Param <- as.double(Param) - + Param_X1X3_threshold <- 1e-2 Param_X4_threshold <- 0.5 if (Param[1L] < Param_X1X3_threshold) { @@ -49,35 +49,36 @@ if (Param[4L] < Param_X4_threshold) { warning(sprintf("Param[4] (X4: unit hydrograph time constant [h]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold)) Param[4L] <- Param_X4_threshold - } - + } + ## Input data preparation if (identical(RunOptions$IndPeriod_WarmUp, 0L)) { RunOptions$IndPeriod_WarmUp <- NULL } IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run) LInputSeries <- as.integer(length(IndPeriod1)) - if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs)) + if ("all" %in% RunOptions$Outputs_Sim) { + IndOutputs <- as.integer(1:length(FortranOutputs)) } else { IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim) } - + ## Output data preparation IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim - + ## Use of IniResLevels if (!is.null(RunOptions$IniResLevels)) { - RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm) - RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm) + RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm) if (IsIntStore) { RunOptions$IniStates[4] <- RunOptions$IniResLevels[4] * Imax ### interception store level (mm) } } - + ## Call GR model Fortan - RESULTS <- .Fortran("frun_gr5h", PACKAGE = "airGR", + RESULTS <- .Fortran("frun_gr5h", PACKAGE = "airGR", ## inputs LInputs = LInputSeries, ### length of input and output series InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h] @@ -97,14 +98,14 @@ RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA if (ExportStateEnd) { RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location - RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel, - ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, - IntStore = RESULTS$StateEnd[4L], - UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)], - GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, + RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel, + ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, + IntStore = RESULTS$StateEnd[4L], + UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)], + GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL, verbose = FALSE) } - + ## Output data preparation ## OutputsModel only if (!ExportDatesR & !ExportStateEnd) { @@ -113,30 +114,30 @@ } ## DatesR and OutputsModel only if (ExportDatesR & !ExportStateEnd) { - OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i])) names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs]) } ## OutputsModel and StateEnd only if (!ExportDatesR & ExportStateEnd) { - OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), + OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd)) names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd") } ## DatesR and OutputsModel and StateEnd if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) { - OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), - lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), + OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]), + lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]), list(RESULTS$StateEnd)) names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd") } - + ## End - rm(RESULTS) + rm(RESULTS) class(OutputsModel) <- c("OutputsModel", "hourly", "GR") if (IsIntStore) { class(OutputsModel) <- c(class(OutputsModel), "interception") } return(OutputsModel) - + } diff -Nru airgr-1.6.9.27/R/RunModel_GR5J.R airgr-1.6.10.4/R/RunModel_GR5J.R --- airgr-1.6.9.27/R/RunModel_GR5J.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/RunModel_GR5J.R 2021-01-28 12:56:23.000000000 +0000 @@ -64,8 +64,8 @@ ## Use of IniResLevels if (!is.null(RunOptions$IniResLevels)) { - RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm) - RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm) + RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm) } ## Call GR model Fortan diff -Nru airgr-1.6.9.27/R/RunModel_GR6J.R airgr-1.6.10.4/R/RunModel_GR6J.R --- airgr-1.6.9.27/R/RunModel_GR6J.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/RunModel_GR6J.R 2021-01-28 12:56:23.000000000 +0000 @@ -68,8 +68,8 @@ ## Use of IniResLevels if (!is.null(RunOptions$IniResLevels)) { - RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm) - RunOptions$IniStates[2] <- RunOptions$IniResLevels[2]*Param[3] ### routing store level (mm) + RunOptions$IniStates[1] <- RunOptions$IniResLevels[1] * Param[1] ### production store level (mm) + RunOptions$IniStates[2] <- RunOptions$IniResLevels[2] * Param[3] ### routing store level (mm) RunOptions$IniStates[3] <- RunOptions$IniResLevels[3] ### exponential store level (mm) } diff -Nru airgr-1.6.9.27/R/RunModel_Lag.R airgr-1.6.10.4/R/RunModel_Lag.R --- airgr-1.6.9.27/R/RunModel_Lag.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/RunModel_Lag.R 2021-01-28 12:56:23.000000000 +0000 @@ -50,8 +50,7 @@ NbUpBasins <- length(InputsModel$LengthHydro) LengthTs <- length(OutputsModel$QsimDown) - OutputsModel$Qsim <- - OutputsModel$QsimDown * InputsModel$BasinAreas[length(InputsModel$BasinAreas)] * 1e3 + OutputsModel$Qsim <- OutputsModel$QsimDown * InputsModel$BasinAreas[length(InputsModel$BasinAreas)] * 1e3 IniSD <- RunOptions$IniStates[grep("SD", names(RunOptions$IniStates))] if (length(IniSD) > 0) { @@ -78,12 +77,10 @@ } for (upstream_basin in seq_len(NbUpBasins)) { - Qupstream <- - InputsModel$Qupstream[RunOptions$IndPeriod_Run, upstream_basin] + Qupstream <- InputsModel$Qupstream[RunOptions$IndPeriod_Run, upstream_basin] if (!is.na(InputsModel$BasinAreas[upstream_basin])) { # Upstream flow with area needs to be converted to m3 by time step - Qupstream <- - Qupstream * InputsModel$BasinAreas[upstream_basin] * 1e3 + Qupstream <- Qupstream * InputsModel$BasinAreas[upstream_basin] * 1e3 } OutputsModel$Qsim <- OutputsModel$Qsim + c(IniStates[[upstream_basin]][-length(IniStates[[upstream_basin]])], diff -Nru airgr-1.6.9.27/R/RunModel.R airgr-1.6.10.4/R/RunModel.R --- airgr-1.6.9.27/R/RunModel.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/RunModel.R 2021-01-29 05:02:43.000000000 +0000 @@ -3,7 +3,7 @@ FUN_MOD <- match.fun(FUN_MOD) if (inherits(InputsModel, "SD")) { - # LAG Model take one parameter at the beginning of the vector + # Lag model take one parameter at the beginning of the vector iFirstParamRunOffModel <- 2 } else { # All parameters diff -Nru airgr-1.6.9.27/R/TransfoParam_CemaNeigeHyst.R airgr-1.6.10.4/R/TransfoParam_CemaNeigeHyst.R --- airgr-1.6.9.27/R/TransfoParam_CemaNeigeHyst.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/TransfoParam_CemaNeigeHyst.R 2021-01-28 12:56:23.000000000 +0000 @@ -22,15 +22,15 @@ ## transformation if (Direction == "TR") { - ParamOut <- ParamIn + ParamOut <- ParamIn ParamOut[, 1] <- (ParamIn[, 1] + 9.99) / 19.98 ### CemaNeige X1 (weighting coefficient for snow pack thermal state) ParamOut[, 2] <- exp(ParamIn[, 2]) / 200 ### CemaNeige X2 (degree-day melt coefficient) ParamOut[, 3] <- (ParamIn[, 3] * 5) + 50 ### Hyst Gaccum ParamOut[, 4] <- (ParamIn[, 4] / 19.98) + 0.5 ### Hyst CV } if (Direction == "RT") { - ParamOut <- ParamIn - ParamOut[, 1] <- ParamIn[, 1] * 19.98 - 9.99 ### CemaNeige X1 (weighting coefficient for snow pack thermal state) + ParamOut <- ParamIn + ParamOut[, 1] <- ParamIn[, 1] * 19.98 - 9.99 ### CemaNeige X1 (weighting coefficient for snow pack thermal state) ParamOut[, 2] <- log(ParamIn[, 2] * 200) ### CemaNeige X2 (degree-day melt coefficient) ParamOut[, 3] <- (ParamIn[, 3] - 50) / 5 ### Hyst Gaccum ParamOut[, 4] <- (ParamIn[, 4] - 0.5) * 19.98 ### Hyst CV diff -Nru airgr-1.6.9.27/R/TransfoParam_CemaNeige.R airgr-1.6.10.4/R/TransfoParam_CemaNeige.R --- airgr-1.6.9.27/R/TransfoParam_CemaNeige.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/TransfoParam_CemaNeige.R 2021-01-28 12:56:23.000000000 +0000 @@ -28,7 +28,7 @@ } if (Direction == "RT") { ParamOut <- ParamIn - ParamOut[, 1] <- ParamIn[, 1] * 19.98 - 9.99 ### CemaNeige X1 (weighting coefficient for snow pack thermal state) + ParamOut[, 1] <- ParamIn[, 1] * 19.98 - 9.99 ### CemaNeige X1 (weighting coefficient for snow pack thermal state) ParamOut[, 2] <- log(ParamIn[, 2] * 200) ### CemaNeige X2 (degree-day melt coefficient) } diff -Nru airgr-1.6.9.27/R/TransfoParam_GR1A.R airgr-1.6.10.4/R/TransfoParam_GR1A.R --- airgr-1.6.9.27/R/TransfoParam_GR1A.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/TransfoParam_GR1A.R 2021-01-28 12:56:23.000000000 +0000 @@ -25,7 +25,7 @@ ParamOut <- (ParamIn + 10.0) / 8 } if (Direction == "RT") { - ParamOut <- ParamIn * 8 - 10.0 + ParamOut <- ParamIn * 8 - 10.0 } diff -Nru airgr-1.6.9.27/R/TransfoParam_Lag.R airgr-1.6.10.4/R/TransfoParam_Lag.R --- airgr-1.6.9.27/R/TransfoParam_Lag.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/R/TransfoParam_Lag.R 2021-01-29 05:03:00.000000000 +0000 @@ -16,7 +16,7 @@ stop("'Direction' must be a character vector of length 1 equal to 'RT' or 'TR'") } if (ncol(ParamIn) != NParam) { - stop(sprintf("the LAG model requires %i parameters", NParam)) + stop(sprintf("the Lag model requires %i parameters", NParam)) } @@ -25,7 +25,7 @@ ParamOut <- 20 * (ParamIn + 10) / 20.0 } if (Direction == "RT") { - ParamOut <- ParamIn * 20.0 / 20 - 10 + ParamOut <- ParamIn * 20.0 / 20 - 10 } diff -Nru airgr-1.6.9.27/R/UtilsCemaNeige.R airgr-1.6.10.4/R/UtilsCemaNeige.R --- airgr-1.6.9.27/R/UtilsCemaNeige.R 1970-01-01 00:00:00.000000000 +0000 +++ airgr-1.6.10.4/R/UtilsCemaNeige.R 2021-01-28 12:56:23.000000000 +0000 @@ -0,0 +1,370 @@ +## daily gradients for mean, min and max air temperature +.GradT_Valery2010 <- as.data.frame(matrix(c( + 01, 01, 0.434, 0.366, 0.498, + 02, 01, 0.434, 0.366, 0.500, + 03, 01, 0.435, 0.367, 0.501, + 04, 01, 0.436, 0.367, 0.503, + 05, 01, 0.437, 0.367, 0.504, + 06, 01, 0.439, 0.367, 0.506, + 07, 01, 0.440, 0.367, 0.508, + 08, 01, 0.441, 0.368, 0.510, + 09, 01, 0.442, 0.368, 0.512, + 10, 01, 0.444, 0.368, 0.514, + 11, 01, 0.445, 0.368, 0.517, + 12, 01, 0.446, 0.368, 0.519, + 13, 01, 0.448, 0.369, 0.522, + 14, 01, 0.450, 0.369, 0.525, + 15, 01, 0.451, 0.369, 0.527, + 16, 01, 0.453, 0.370, 0.530, + 17, 01, 0.455, 0.370, 0.533, + 18, 01, 0.456, 0.370, 0.537, + 19, 01, 0.458, 0.371, 0.540, + 20, 01, 0.460, 0.371, 0.543, + 21, 01, 0.462, 0.371, 0.547, + 22, 01, 0.464, 0.372, 0.550, + 23, 01, 0.466, 0.372, 0.554, + 24, 01, 0.468, 0.373, 0.558, + 25, 01, 0.470, 0.373, 0.561, + 26, 01, 0.472, 0.374, 0.565, + 27, 01, 0.474, 0.374, 0.569, + 28, 01, 0.476, 0.375, 0.573, + 29, 01, 0.478, 0.375, 0.577, + 30, 01, 0.480, 0.376, 0.582, + 31, 01, 0.483, 0.376, 0.586, + 01, 02, 0.485, 0.377, 0.590, + 02, 02, 0.487, 0.377, 0.594, + 03, 02, 0.489, 0.378, 0.599, + 04, 02, 0.492, 0.379, 0.603, + 05, 02, 0.494, 0.379, 0.607, + 06, 02, 0.496, 0.380, 0.612, + 07, 02, 0.498, 0.381, 0.616, + 08, 02, 0.501, 0.381, 0.621, + 09, 02, 0.503, 0.382, 0.625, + 10, 02, 0.505, 0.383, 0.630, + 11, 02, 0.508, 0.384, 0.634, + 12, 02, 0.510, 0.384, 0.639, + 13, 02, 0.512, 0.385, 0.643, + 14, 02, 0.515, 0.386, 0.648, + 15, 02, 0.517, 0.387, 0.652, + 16, 02, 0.519, 0.387, 0.657, + 17, 02, 0.522, 0.388, 0.661, + 18, 02, 0.524, 0.389, 0.666, + 19, 02, 0.526, 0.390, 0.670, + 20, 02, 0.528, 0.391, 0.674, + 21, 02, 0.530, 0.392, 0.679, + 22, 02, 0.533, 0.393, 0.683, + 23, 02, 0.535, 0.393, 0.687, + 24, 02, 0.537, 0.394, 0.691, + 25, 02, 0.539, 0.395, 0.695, + 26, 02, 0.541, 0.396, 0.699, + 27, 02, 0.543, 0.397, 0.703, + 28, 02, 0.545, 0.398, 0.707, + 29, 02, 0.546, 0.399, 0.709, + 01, 03, 0.547, 0.399, 0.711, + 02, 03, 0.549, 0.400, 0.715, + 03, 03, 0.551, 0.401, 0.718, + 04, 03, 0.553, 0.402, 0.722, + 05, 03, 0.555, 0.403, 0.726, + 06, 03, 0.557, 0.404, 0.729, + 07, 03, 0.559, 0.405, 0.732, + 08, 03, 0.560, 0.406, 0.736, + 09, 03, 0.562, 0.406, 0.739, + 10, 03, 0.564, 0.407, 0.742, + 11, 03, 0.566, 0.408, 0.745, + 12, 03, 0.567, 0.409, 0.748, + 13, 03, 0.569, 0.410, 0.750, + 14, 03, 0.570, 0.411, 0.753, + 15, 03, 0.572, 0.412, 0.756, + 16, 03, 0.573, 0.413, 0.758, + 17, 03, 0.575, 0.414, 0.761, + 18, 03, 0.576, 0.415, 0.763, + 19, 03, 0.577, 0.416, 0.765, + 20, 03, 0.579, 0.417, 0.767, + 21, 03, 0.580, 0.417, 0.769, + 22, 03, 0.581, 0.418, 0.771, + 23, 03, 0.582, 0.419, 0.773, + 24, 03, 0.583, 0.420, 0.774, + 25, 03, 0.584, 0.421, 0.776, + 26, 03, 0.585, 0.422, 0.777, + 27, 03, 0.586, 0.422, 0.779, + 28, 03, 0.587, 0.423, 0.780, + 29, 03, 0.588, 0.424, 0.781, + 30, 03, 0.589, 0.425, 0.782, + 31, 03, 0.590, 0.425, 0.783, + 01, 04, 0.591, 0.426, 0.784, + 02, 04, 0.591, 0.427, 0.785, + 03, 04, 0.592, 0.427, 0.785, + 04, 04, 0.593, 0.428, 0.786, + 05, 04, 0.593, 0.429, 0.787, + 06, 04, 0.594, 0.429, 0.787, + 07, 04, 0.595, 0.430, 0.787, + 08, 04, 0.595, 0.431, 0.788, + 09, 04, 0.596, 0.431, 0.788, + 10, 04, 0.596, 0.432, 0.788, + 11, 04, 0.597, 0.432, 0.788, + 12, 04, 0.597, 0.433, 0.788, + 13, 04, 0.597, 0.433, 0.788, + 14, 04, 0.598, 0.434, 0.788, + 15, 04, 0.598, 0.434, 0.788, + 16, 04, 0.598, 0.435, 0.787, + 17, 04, 0.599, 0.435, 0.787, + 18, 04, 0.599, 0.436, 0.787, + 19, 04, 0.599, 0.436, 0.786, + 20, 04, 0.599, 0.436, 0.786, + 21, 04, 0.600, 0.437, 0.785, + 22, 04, 0.600, 0.437, 0.785, + 23, 04, 0.600, 0.437, 0.784, + 24, 04, 0.600, 0.438, 0.784, + 25, 04, 0.600, 0.438, 0.783, + 26, 04, 0.601, 0.438, 0.783, + 27, 04, 0.601, 0.438, 0.782, + 28, 04, 0.601, 0.439, 0.781, + 29, 04, 0.601, 0.439, 0.781, + 30, 04, 0.601, 0.439, 0.780, + 01, 05, 0.601, 0.439, 0.779, + 02, 05, 0.601, 0.439, 0.778, + 03, 05, 0.601, 0.439, 0.778, + 04, 05, 0.601, 0.440, 0.777, + 05, 05, 0.601, 0.440, 0.776, + 06, 05, 0.601, 0.440, 0.775, + 07, 05, 0.601, 0.440, 0.775, + 08, 05, 0.601, 0.440, 0.774, + 09, 05, 0.601, 0.440, 0.773, + 10, 05, 0.602, 0.440, 0.772, + 11, 05, 0.602, 0.440, 0.772, + 12, 05, 0.602, 0.440, 0.771, + 13, 05, 0.602, 0.440, 0.770, + 14, 05, 0.602, 0.440, 0.770, + 15, 05, 0.602, 0.440, 0.769, + 16, 05, 0.602, 0.440, 0.768, + 17, 05, 0.602, 0.440, 0.768, + 18, 05, 0.602, 0.440, 0.767, + 19, 05, 0.602, 0.440, 0.767, + 20, 05, 0.602, 0.440, 0.766, + 21, 05, 0.602, 0.440, 0.766, + 22, 05, 0.602, 0.440, 0.765, + 23, 05, 0.602, 0.440, 0.765, + 24, 05, 0.602, 0.440, 0.764, + 25, 05, 0.602, 0.440, 0.764, + 26, 05, 0.602, 0.440, 0.764, + 27, 05, 0.602, 0.439, 0.763, + 28, 05, 0.602, 0.439, 0.763, + 29, 05, 0.602, 0.439, 0.763, + 30, 05, 0.602, 0.439, 0.762, + 31, 05, 0.602, 0.439, 0.762, + 01, 06, 0.602, 0.439, 0.762, + 02, 06, 0.602, 0.439, 0.762, + 03, 06, 0.602, 0.439, 0.762, + 04, 06, 0.602, 0.439, 0.762, + 05, 06, 0.602, 0.439, 0.762, + 06, 06, 0.602, 0.438, 0.761, + 07, 06, 0.602, 0.438, 0.761, + 08, 06, 0.602, 0.438, 0.761, + 09, 06, 0.602, 0.438, 0.761, + 10, 06, 0.602, 0.438, 0.761, + 11, 06, 0.602, 0.438, 0.762, + 12, 06, 0.602, 0.438, 0.762, + 13, 06, 0.602, 0.438, 0.762, + 14, 06, 0.602, 0.438, 0.762, + 15, 06, 0.602, 0.437, 0.762, + 16, 06, 0.602, 0.437, 0.762, + 17, 06, 0.602, 0.437, 0.762, + 18, 06, 0.602, 0.437, 0.762, + 19, 06, 0.602, 0.437, 0.763, + 20, 06, 0.602, 0.437, 0.763, + 21, 06, 0.602, 0.437, 0.763, + 22, 06, 0.602, 0.436, 0.763, + 23, 06, 0.602, 0.436, 0.763, + 24, 06, 0.602, 0.436, 0.764, + 25, 06, 0.602, 0.436, 0.764, + 26, 06, 0.601, 0.436, 0.764, + 27, 06, 0.601, 0.436, 0.764, + 28, 06, 0.601, 0.436, 0.764, + 29, 06, 0.601, 0.435, 0.765, + 30, 06, 0.601, 0.435, 0.765, + 01, 07, 0.601, 0.435, 0.765, + 02, 07, 0.600, 0.435, 0.765, + 03, 07, 0.600, 0.435, 0.765, + 04, 07, 0.600, 0.434, 0.766, + 05, 07, 0.600, 0.434, 0.766, + 06, 07, 0.599, 0.434, 0.766, + 07, 07, 0.599, 0.434, 0.766, + 08, 07, 0.599, 0.434, 0.766, + 09, 07, 0.598, 0.433, 0.766, + 10, 07, 0.598, 0.433, 0.766, + 11, 07, 0.598, 0.433, 0.766, + 12, 07, 0.597, 0.433, 0.766, + 13, 07, 0.597, 0.432, 0.767, + 14, 07, 0.597, 0.432, 0.767, + 15, 07, 0.596, 0.432, 0.767, + 16, 07, 0.596, 0.432, 0.766, + 17, 07, 0.595, 0.431, 0.766, + 18, 07, 0.595, 0.431, 0.766, + 19, 07, 0.594, 0.431, 0.766, + 20, 07, 0.594, 0.430, 0.766, + 21, 07, 0.593, 0.430, 0.766, + 22, 07, 0.593, 0.430, 0.766, + 23, 07, 0.592, 0.429, 0.765, + 24, 07, 0.592, 0.429, 0.765, + 25, 07, 0.591, 0.428, 0.765, + 26, 07, 0.590, 0.428, 0.765, + 27, 07, 0.590, 0.428, 0.764, + 28, 07, 0.589, 0.427, 0.764, + 29, 07, 0.588, 0.427, 0.764, + 30, 07, 0.588, 0.426, 0.763, + 31, 07, 0.587, 0.426, 0.763, + 01, 08, 0.586, 0.425, 0.762, + 02, 08, 0.586, 0.425, 0.762, + 03, 08, 0.585, 0.424, 0.761, + 04, 08, 0.584, 0.424, 0.761, + 05, 08, 0.583, 0.423, 0.760, + 06, 08, 0.583, 0.423, 0.760, + 07, 08, 0.582, 0.422, 0.759, + 08, 08, 0.581, 0.421, 0.758, + 09, 08, 0.580, 0.421, 0.758, + 10, 08, 0.579, 0.420, 0.757, + 11, 08, 0.578, 0.420, 0.756, + 12, 08, 0.578, 0.419, 0.755, + 13, 08, 0.577, 0.418, 0.754, + 14, 08, 0.576, 0.418, 0.754, + 15, 08, 0.575, 0.417, 0.753, + 16, 08, 0.574, 0.416, 0.752, + 17, 08, 0.573, 0.415, 0.751, + 18, 08, 0.572, 0.415, 0.750, + 19, 08, 0.571, 0.414, 0.749, + 20, 08, 0.570, 0.413, 0.748, + 21, 08, 0.569, 0.413, 0.747, + 22, 08, 0.569, 0.412, 0.746, + 23, 08, 0.568, 0.411, 0.745, + 24, 08, 0.567, 0.410, 0.744, + 25, 08, 0.566, 0.409, 0.743, + 26, 08, 0.565, 0.409, 0.742, + 27, 08, 0.564, 0.408, 0.741, + 28, 08, 0.563, 0.407, 0.740, + 29, 08, 0.562, 0.406, 0.738, + 30, 08, 0.561, 0.405, 0.737, + 31, 08, 0.560, 0.405, 0.736, + 01, 09, 0.558, 0.404, 0.735, + 02, 09, 0.557, 0.403, 0.734, + 03, 09, 0.556, 0.402, 0.732, + 04, 09, 0.555, 0.401, 0.731, + 05, 09, 0.554, 0.401, 0.730, + 06, 09, 0.553, 0.400, 0.728, + 07, 09, 0.552, 0.399, 0.727, + 08, 09, 0.551, 0.398, 0.725, + 09, 09, 0.550, 0.397, 0.724, + 10, 09, 0.549, 0.396, 0.723, + 11, 09, 0.548, 0.396, 0.721, + 12, 09, 0.546, 0.395, 0.720, + 13, 09, 0.545, 0.394, 0.718, + 14, 09, 0.544, 0.393, 0.717, + 15, 09, 0.543, 0.392, 0.715, + 16, 09, 0.542, 0.391, 0.713, + 17, 09, 0.541, 0.391, 0.712, + 18, 09, 0.540, 0.390, 0.710, + 19, 09, 0.538, 0.389, 0.709, + 20, 09, 0.537, 0.388, 0.707, + 21, 09, 0.536, 0.388, 0.705, + 22, 09, 0.535, 0.387, 0.703, + 23, 09, 0.533, 0.386, 0.702, + 24, 09, 0.532, 0.385, 0.700, + 25, 09, 0.531, 0.385, 0.698, + 26, 09, 0.530, 0.384, 0.696, + 27, 09, 0.528, 0.383, 0.694, + 28, 09, 0.527, 0.383, 0.692, + 29, 09, 0.526, 0.382, 0.690, + 30, 09, 0.525, 0.381, 0.688, + 01, 10, 0.523, 0.381, 0.686, + 02, 10, 0.522, 0.380, 0.684, + 03, 10, 0.521, 0.379, 0.682, + 04, 10, 0.519, 0.379, 0.680, + 05, 10, 0.518, 0.378, 0.678, + 06, 10, 0.517, 0.377, 0.676, + 07, 10, 0.515, 0.377, 0.674, + 08, 10, 0.514, 0.376, 0.671, + 09, 10, 0.512, 0.376, 0.669, + 10, 10, 0.511, 0.375, 0.667, + 11, 10, 0.510, 0.375, 0.664, + 12, 10, 0.508, 0.374, 0.662, + 13, 10, 0.507, 0.374, 0.659, + 14, 10, 0.505, 0.373, 0.657, + 15, 10, 0.504, 0.373, 0.654, + 16, 10, 0.502, 0.372, 0.652, + 17, 10, 0.501, 0.372, 0.649, + 18, 10, 0.499, 0.372, 0.647, + 19, 10, 0.498, 0.371, 0.644, + 20, 10, 0.496, 0.371, 0.641, + 21, 10, 0.495, 0.371, 0.639, + 22, 10, 0.493, 0.370, 0.636, + 23, 10, 0.492, 0.370, 0.633, + 24, 10, 0.490, 0.370, 0.630, + 25, 10, 0.489, 0.369, 0.628, + 26, 10, 0.487, 0.369, 0.625, + 27, 10, 0.485, 0.369, 0.622, + 28, 10, 0.484, 0.368, 0.619, + 29, 10, 0.482, 0.368, 0.616, + 30, 10, 0.481, 0.368, 0.613, + 31, 10, 0.479, 0.368, 0.610, + 01, 11, 0.478, 0.368, 0.607, + 02, 11, 0.476, 0.367, 0.604, + 03, 11, 0.475, 0.367, 0.601, + 04, 11, 0.473, 0.367, 0.598, + 05, 11, 0.471, 0.367, 0.595, + 06, 11, 0.470, 0.367, 0.592, + 07, 11, 0.468, 0.367, 0.589, + 08, 11, 0.467, 0.366, 0.586, + 09, 11, 0.465, 0.366, 0.583, + 10, 11, 0.464, 0.366, 0.580, + 11, 11, 0.462, 0.366, 0.577, + 12, 11, 0.461, 0.366, 0.574, + 13, 11, 0.459, 0.366, 0.571, + 14, 11, 0.458, 0.366, 0.568, + 15, 11, 0.456, 0.366, 0.565, + 16, 11, 0.455, 0.366, 0.562, + 17, 11, 0.454, 0.366, 0.559, + 18, 11, 0.452, 0.365, 0.556, + 19, 11, 0.451, 0.365, 0.553, + 20, 11, 0.450, 0.365, 0.550, + 21, 11, 0.448, 0.365, 0.547, + 22, 11, 0.447, 0.365, 0.544, + 23, 11, 0.446, 0.365, 0.542, + 24, 11, 0.445, 0.365, 0.539, + 25, 11, 0.443, 0.365, 0.536, + 26, 11, 0.442, 0.365, 0.533, + 27, 11, 0.441, 0.365, 0.531, + 28, 11, 0.440, 0.365, 0.528, + 29, 11, 0.439, 0.365, 0.526, + 30, 11, 0.438, 0.365, 0.523, + 01, 12, 0.437, 0.365, 0.521, + 02, 12, 0.436, 0.365, 0.519, + 03, 12, 0.435, 0.365, 0.517, + 04, 12, 0.434, 0.365, 0.515, + 05, 12, 0.434, 0.365, 0.513, + 06, 12, 0.433, 0.365, 0.511, + 07, 12, 0.432, 0.365, 0.509, + 08, 12, 0.431, 0.365, 0.507, + 09, 12, 0.431, 0.365, 0.505, + 10, 12, 0.430, 0.365, 0.504, + 11, 12, 0.430, 0.365, 0.502, + 12, 12, 0.429, 0.365, 0.501, + 13, 12, 0.429, 0.365, 0.500, + 14, 12, 0.429, 0.365, 0.498, + 15, 12, 0.428, 0.365, 0.497, + 16, 12, 0.428, 0.365, 0.496, + 17, 12, 0.428, 0.365, 0.496, + 18, 12, 0.428, 0.365, 0.495, + 19, 12, 0.428, 0.365, 0.494, + 20, 12, 0.428, 0.365, 0.494, + 21, 12, 0.428, 0.365, 0.494, + 22, 12, 0.428, 0.365, 0.493, + 23, 12, 0.429, 0.365, 0.493, + 24, 12, 0.429, 0.366, 0.493, + 25, 12, 0.429, 0.366, 0.493, + 26, 12, 0.430, 0.366, 0.494, + 27, 12, 0.430, 0.366, 0.494, + 28, 12, 0.431, 0.366, 0.495, + 29, 12, 0.431, 0.366, 0.495, + 30, 12, 0.432, 0.366, 0.496, + 31, 12, 0.433, 0.366, 0.497), + ncol = 5, byrow = TRUE, + dimnames = list(NULL, c("day", "month", "grad_Tmean", "grad_Tmin", "grad_Tmax")))) diff -Nru airgr-1.6.9.27/R/UtilsErrorCrit.R airgr-1.6.10.4/R/UtilsErrorCrit.R --- airgr-1.6.9.27/R/UtilsErrorCrit.R 2021-01-11 16:41:01.000000000 +0000 +++ airgr-1.6.10.4/R/UtilsErrorCrit.R 2021-01-28 12:56:23.000000000 +0000 @@ -91,7 +91,7 @@ VarSim[is.na(VarObs)] <- NA VarSim <- sort(VarSim, na.last = TRUE) VarObs <- sort(VarObs, na.last = TRUE) - InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE) + InputsCrit$BoolCrit <- sort(InputsCrit$BoolCrit, decreasing = TRUE) } if (InputsCrit$transfo == "boxcox") { muTransfoVarObs <- (0.01 * mean(VarObs, na.rm = TRUE))^0.25 diff -Nru airgr-1.6.9.27/src/airGR.c airgr-1.6.10.4/src/airGR.c --- airgr-1.6.9.27/src/airGR.c 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/src/airGR.c 2021-01-28 12:56:23.000000000 +0000 @@ -2,7 +2,7 @@ #include // for NULL #include -/* FIXME: +/* FIXME: Check these declarations against the C/Fortran source code. */ @@ -26,7 +26,7 @@ {"frun_gr4j", (DL_FUNC) &F77_NAME(frun_gr4j), 11}, {"frun_gr5j", (DL_FUNC) &F77_NAME(frun_gr5j), 11}, {"frun_gr6j", (DL_FUNC) &F77_NAME(frun_gr6j), 11}, - {"frun_pe_oudin", (DL_FUNC) &F77_NAME(frun_pe_oudin), 5}, + {"frun_pe_oudin", (DL_FUNC) &F77_NAME(frun_pe_oudin), 5}, {NULL, NULL, 0} }; diff -Nru airgr-1.6.9.27/src/frun_GR5H.f90 airgr-1.6.10.4/src/frun_GR5H.f90 --- airgr-1.6.9.27/src/frun_GR5H.f90 2021-01-21 16:43:19.000000000 +0000 +++ airgr-1.6.10.4/src/frun_GR5H.f90 2021-01-28 12:56:23.000000000 +0000 @@ -76,8 +76,11 @@ doubleprecision, dimension(NMISC) :: MISC doubleprecision :: D,P1,E,Q - IF (Imax .LT. 0.) IsIntStore = .FALSE. - IF (Imax .GE. 0.) IsIntStore = .TRUE. + IF (Imax .LT. 0.d0) THEN + IsIntStore = .FALSE. + ELSE + IsIntStore = .TRUE. + ENDIF !-------------------------------------------------------------- ! Initializations diff -Nru airgr-1.6.9.27/tests/testthat/helper_regression.R airgr-1.6.10.4/tests/testthat/helper_regression.R --- airgr-1.6.9.27/tests/testthat/helper_regression.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/helper_regression.R 2021-01-28 12:56:23.000000000 +0000 @@ -1,5 +1,5 @@ StoreStableExampleResults <- function( - package = "airGR", + package = "airGR", path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "stable"), ...) { install.packages(package, repos = "http://cran.r-project.org") @@ -7,8 +7,8 @@ } StoreDevExampleResults <- function( - package = "airGR", - path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "dev"), + package = "airGR", + path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "dev"), ...) { StoreExampleResults(package = package, path = path, ...) } @@ -75,7 +75,9 @@ } CompareStableDev <- function() { - res = testthat::test_file("tests/testthat/regression.R") - dRes = as.data.frame(res) - if(any(dRes[,"failed"]>0) | any(dRes[,"error"])) quit(status = 1) + res <- testthat::test_file("tests/testthat/regression.R") + dRes <- as.data.frame(res) + if(any(dRes[, "failed"] > 0) | any(dRes[, "error"])) { + quit(status = 1) + } } diff -Nru airgr-1.6.9.27/tests/testthat/helper_vignettes.R airgr-1.6.10.4/tests/testthat/helper_vignettes.R --- airgr-1.6.9.27/tests/testthat/helper_vignettes.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/helper_vignettes.R 2021-01-28 12:56:23.000000000 +0000 @@ -3,12 +3,12 @@ #' @param fileRmd Rmd file to #' @param tmpFolder Folder storing the script containing extracted chunks #' @param force.eval Force execution of chunks with parameter eval=FALSE -RunRmdChunks <- function(fileRmd, - tmpFolder = "../tmp", - force.eval = TRUE) { +RunRmdChunks <- function(fileRmd, + tmpFolder = "../tmp", + force.eval = TRUE) { dir.create(tmpFolder, showWarnings = FALSE) output <- file.path(tmpFolder, - gsub("\\.Rmd", "\\.R", basename(fileRmd), ignore.case = TRUE)) + gsub("\\.Rmd", "\\.R", basename(fileRmd), ignore.case = TRUE)) knitr::purl(fileRmd, output = output, quiet = TRUE) sTxt <- readLines(output) if (force.eval) { @@ -30,8 +30,8 @@ for (i in 1:length(chunksEvalStart)) { # Remove comments on eval=F chunk lines sTxt[chunksEvalStart[i]:chunksEvalEnd[i]] <- gsub(pattern = "^## ", - replace = "", - x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]]) + replace = "", + x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]]) } } @@ -70,12 +70,12 @@ RunVignetteChunks <- function(vignette, tmpFolder = "../tmp", force.eval = TRUE) { - if(file.exists(file.path("../../vignettes/", paste0(vignette, ".Rmd")))) { + if(file.exists(sprintf("../../vignettes/%s.Rmd", vignette))) { # testthat context in development environnement - RunRmdChunks(file.path("../../vignettes/", paste0(vignette, ".Rmd")), tmpFolder, force.eval) + RunRmdChunks(sprintf("../../vignettes/%s.Rmd", vignette), tmpFolder, force.eval) } else { # R CMD check context in package environnement - RunRmdChunks(system.file(file.path("doc/", paste0(vignette, ".Rmd")), package = "airGR"), tmpFolder, force.eval) + RunRmdChunks(system.file(sprintf("doc/%s.Rmd", vignette), package = "airGR"), tmpFolder, force.eval) } return(TRUE) } @@ -92,4 +92,4 @@ Conversion <- Conversion / 86400 # Day -> seconds notNA <- which(!is.na(BasinObs$Qmm)) expect_equal(BasinObs$Qmm[notNA] * Conversion, BasinObs$Qls[notNA], tolerance = tolerance) -} \ No newline at end of file +} diff -Nru airgr-1.6.9.27/tests/testthat/regression.R airgr-1.6.10.4/tests/testthat/regression.R --- airgr-1.6.9.27/tests/testthat/regression.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/regression.R 2021-01-28 12:56:23.000000000 +0000 @@ -35,7 +35,7 @@ message("File ", file.path(getwd(), regIgnoreFile), " not found") regIgnore <- NULL } - lapply(X = refVarFiles, CompareWithStable, testDir = file.path(tmp_path, "dev"), regIgnore = regIgnore) + lapply(refVarFiles, FUN = CompareWithStable, testDir = file.path(tmp_path, "dev"), regIgnore = regIgnore) } else { stop("Regression tests compared to released version needs that you run the following instructions first:\n", "Rscript tests/testthat/regression_tests.R stable\n", diff -Nru airgr-1.6.9.27/tests/testthat/regression_tests.R airgr-1.6.10.4/tests/testthat/regression_tests.R --- airgr-1.6.9.27/tests/testthat/regression_tests.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/regression_tests.R 2021-01-28 12:56:23.000000000 +0000 @@ -1,9 +1,9 @@ # Execute Regression test by comparing RD files stored in folders /tests/tmp/ref and /tests/tmp/test -Args = commandArgs(trailingOnly=TRUE) +Args <- commandArgs(trailingOnly = TRUE) source("tests/testthat/helper_regression.R") -lActions = list( +lActions <- list( stable = StoreStableExampleResults, dev = StoreDevExampleResults, compare = CompareStableDev @@ -15,7 +15,7 @@ stop("This script should be run with one argument in the command line:\n", "`Rscript tests/regression_tests.R [stable|dev|compare]`.\n", "Available arguments are:\n", - "- stable: install stable version from CRAN, run and store examples\n", + "- stable: install stable version from CRAN, run and store examples\n", "- dev: install dev version from current directory, run and store examples\n", "- compare: stored results of both versions") } diff -Nru airgr-1.6.9.27/tests/testthat/test-CreateiniStates.R airgr-1.6.10.4/tests/testthat/test-CreateiniStates.R --- airgr-1.6.9.27/tests/testthat/test-CreateiniStates.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/test-CreateiniStates.R 2021-01-28 12:56:23.000000000 +0000 @@ -3,25 +3,23 @@ data(L0123001) test_that("Error: SD argument provided on non-SD 'InputsModel'", { - InputsModel <- - CreateInputsModel( - FUN_MOD = RunModel_GR4J, - DatesR = BasinObs$DatesR, - Precip = BasinObs$P, - PotEvap = BasinObs$E - ) + InputsModel <- CreateInputsModel( + FUN_MOD = RunModel_GR4J, + DatesR = BasinObs$DatesR, + Precip = BasinObs$P, + PotEvap = BasinObs$E + ) expect_error( - IniStates <- - CreateIniStates( - FUN_MOD = RunModel_GR4J, - InputsModel = InputsModel, - ProdStore = 0, - RoutStore = 0, - ExpStore = NULL, - UH1 = c(0.52, 0.54, 0.15, rep(0, 17)), - UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)), - SD = list(rep(0, 10)) - ), + IniStates <- CreateIniStates( + FUN_MOD = RunModel_GR4J, + InputsModel = InputsModel, + ProdStore = 0, + RoutStore = 0, + ExpStore = NULL, + UH1 = c(0.52, 0.54, 0.15, rep(0, 17)), + UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)), + SD = list(rep(0, 10)) + ), regexp = "'SD' argument provided and" ) }) @@ -29,10 +27,9 @@ BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea) # Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs -Qupstream <- - floor((sin(( - seq_along(BasinObs$Qmm) / 365 * 2 * 3.14 - )) + 1) * mean(BasinObs$Qmm, na.rm = TRUE)) +Qupstream <- floor((sin(( + seq_along(BasinObs$Qmm) / 365 * 2 * 3.14 +)) + 1) * mean(BasinObs$Qmm, na.rm = TRUE)) InputsModel <- CreateInputsModel( FUN_MOD = RunModel_GR4J, @@ -46,8 +43,27 @@ test_that("Error: Non-list 'SD' argument", { expect_error( - IniStates <- - CreateIniStates( + IniStates <- CreateIniStates( + FUN_MOD = RunModel_GR4J, + InputsModel = InputsModel, + ProdStore = 0, + RoutStore = 0, + ExpStore = NULL, + UH1 = c(0.52, 0.54, 0.15, rep(0, 17)), + UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)), + SD = rep(0, 10) + ), + regexp = "'SD' argument must be a list" + ) +}) + +test_that("Error: Non-numeric items in 'SD' list argument", { + lapply(list(list(list(rep( + 0, 10 + ))), list(toto = NULL)), + function(x) { + expect_error( + IniStates <- CreateIniStates( FUN_MOD = RunModel_GR4J, InputsModel = InputsModel, ProdStore = 0, @@ -55,47 +71,27 @@ ExpStore = NULL, UH1 = c(0.52, 0.54, 0.15, rep(0, 17)), UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)), - SD = rep(0, 10) + SD = x ), - regexp = "'SD' argument must be a list" - ) -}) - -test_that("Error: Non-numeric items in 'SD' list argument", { - lapply(list(list(list(rep(0, 10))), list(toto = NULL)), - function(x) { - expect_error( - IniStates <- - CreateIniStates( - FUN_MOD = RunModel_GR4J, - InputsModel = InputsModel, - ProdStore = 0, - RoutStore = 0, - ExpStore = NULL, - UH1 = c(0.52, 0.54, 0.15, rep(0, 17)), - UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)), - SD = x - ), - regexp = "Each item of 'SD' list argument must be numeric" - ) - }) + regexp = "Each item of 'SD' list argument must be numeric" + ) + }) }) test_that("Error: Number of items not equal to number of upstream connections", { lapply(list(list(), list(rep(0, 10), rep(0, 10))), function(x) { expect_error( - IniStates <- - CreateIniStates( - FUN_MOD = RunModel_GR4J, - InputsModel = InputsModel, - ProdStore = 0, - RoutStore = 0, - ExpStore = NULL, - UH1 = c(0.52, 0.54, 0.15, rep(0, 17)), - UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)), - SD = x - ), + IniStates <- CreateIniStates( + FUN_MOD = RunModel_GR4J, + InputsModel = InputsModel, + ProdStore = 0, + RoutStore = 0, + ExpStore = NULL, + UH1 = c(0.52, 0.54, 0.15, rep(0, 17)), + UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)), + SD = x + ), regexp = "list argument must be the same as the number of upstream" ) }) diff -Nru airgr-1.6.9.27/tests/testthat/test-CreateRunOptions.R airgr-1.6.10.4/tests/testthat/test-CreateRunOptions.R --- airgr-1.6.9.27/tests/testthat/test-CreateRunOptions.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/test-CreateRunOptions.R 2021-01-28 12:56:23.000000000 +0000 @@ -2,26 +2,29 @@ test_that("Warm start of GR4J should give same result as warmed model", { data(L0123001) - InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, + InputsModel <- CreateInputsModel(FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, Precip = BasinObs$P, PotEvap = BasinObs$E) Param <- c(X1 = 257.238, X2 = 1.012, X3 = 88.235, X4 = 2.208) - Ind_Run1 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"), - which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-12-31")) - Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"), + Ind_Run1 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"), + which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-12-31")) + Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"), which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-12-31")) # 1990-1991 RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModel, IndPeriod_Run = c(Ind_Run1, Ind_Run2))) + InputsModel = InputsModel, + IndPeriod_Run = c(Ind_Run1, Ind_Run2))) OutputsModel <- RunModel_GR4J(InputsModel = InputsModel, RunOptions = RunOptions, Param = Param) # 1990 RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModel, IndPeriod_Run = Ind_Run1)) + InputsModel = InputsModel, + IndPeriod_Run = Ind_Run1)) OutputsModel1 <- RunModel_GR4J(InputsModel = InputsModel, - RunOptions = RunOptions1, Param = Param) + RunOptions = RunOptions1, Param = Param) # Warm start 1991 RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModel, IndPeriod_Run = Ind_Run2, + InputsModel = InputsModel, + IndPeriod_Run = Ind_Run2, IndPeriod_WarmUp = 0L, IniStates = OutputsModel1$StateEnd) OutputsModel2 <- RunModel_GR4J(InputsModel = InputsModel, diff -Nru airgr-1.6.9.27/tests/testthat/test-evap.R airgr-1.6.10.4/tests/testthat/test-evap.R --- airgr-1.6.9.27/tests/testthat/test-evap.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/test-evap.R 2021-01-28 12:56:23.000000000 +0000 @@ -6,7 +6,7 @@ TimeStepOut = "daily") { PotEvap <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1, Temp = BasinObs$T, - Lat = Lat, LatUnit = LatUnit, + Lat = Lat, LatUnit = LatUnit, TimeStepIn = TimeStepIn, TimeStepOut = TimeStepOut) PotEvapFor <- PE_Oudin(JD = as.POSIXlt(BasinObs$DatesR)$yday + 1, Temp = BasinObs$T, @@ -19,7 +19,7 @@ test_that("PE_Oudin works", { skip_on_cran() rm(list = ls()) - + data(L0123001); BasinObs_L0123001 <- BasinObs data(L0123002); BasinObs_L0123002 <- BasinObs @@ -30,14 +30,14 @@ Lat = 0.8, LatUnit = "rad", TimeStepIn = "daily", TimeStepOut = "hourly")) expect_true(comp_evap(BasinObs = BasinObs_L0123002, - Lat = 0.9, LatUnit = "rad", + Lat = 0.9, LatUnit = "rad", TimeStepIn = "daily", TimeStepOut = "daily")) expect_true(comp_evap(BasinObs = BasinObs_L0123002, Lat = 0.9, LatUnit = "rad", TimeStepIn = "daily", TimeStepOut = "hourly")) - + ## check with several catchments using different values for Lat - + ## one by one PotEvapFor1 <- PE_Oudin(JD = as.POSIXlt(BasinObs_L0123001$DatesR)$yday + 1, Temp = BasinObs_L0123001$T, @@ -47,7 +47,7 @@ Temp = BasinObs_L0123002$T, Lat = 0.9, LatUnit = "rad", RunFortran = TRUE) - + ## all in one BasinObs_L0123001$Lat <- 0.8 BasinObs_L0123002$Lat <- 0.9 @@ -56,7 +56,6 @@ Temp = BasinObs$T, Lat = BasinObs$Lat, LatUnit = "rad", RunFortran = TRUE) - + expect_equal(PotEvapFor, c(PotEvapFor1, PotEvapFor2)) - }) diff -Nru airgr-1.6.9.27/tests/testthat/test-RunModel_Lag.R airgr-1.6.10.4/tests/testthat/test-RunModel_Lag.R --- airgr-1.6.9.27/tests/testthat/test-RunModel_Lag.R 1970-01-01 00:00:00.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/test-RunModel_Lag.R 2021-01-28 12:56:23.000000000 +0000 @@ -0,0 +1,231 @@ +context("RunModel_Lag") + +data(L0123001) + +test_that("'BasinAreas' must have one more element than 'LengthHydro'", { + expect_error( + InputsModel <- CreateInputsModel( + FUN_MOD = RunModel_GR4J, + DatesR = BasinObs$DatesR, + Precip = BasinObs$P, + PotEvap = BasinObs$E, + Qupstream = matrix(BasinObs$Qmm, ncol = 1), + LengthHydro = 1, + BasinAreas = 1 + ), + regexp = "'BasinAreas' must have one more element than 'LengthHydro'" + ) +}) + +BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea) + +test_that("'Qupstream' cannot contain any NA value", { + expect_error( + InputsModel <- CreateInputsModel( + FUN_MOD = RunModel_GR4J, + DatesR = BasinObs$DatesR, + Precip = BasinObs$P, + PotEvap = BasinObs$E, + Qupstream = matrix(BasinObs$Qmm, ncol = 1), + LengthHydro = 1, + BasinAreas = BasinAreas + ), + regexp = "'Qupstream' cannot contain any NA value" + ) +}) + +# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs +Qupstream <- floor((sin((seq_along(BasinObs$Qmm)/365*2*3.14))+1) * mean(BasinObs$Qmm, na.rm = TRUE)) + +InputsModel <- CreateInputsModel( + FUN_MOD = RunModel_GR4J, + DatesR = BasinObs$DatesR, + Precip = BasinObs$P, + PotEvap = BasinObs$E, + Qupstream = matrix(Qupstream, ncol = 1), + LengthHydro = 1000, + BasinAreas = BasinAreas +) + +Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"), + which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31")) + +RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, + InputsModel = InputsModel, + IndPeriod_Run = Ind_Run)) + +test_that("InputsModel parameter should contain an OutputsModel key", { + expect_error( + RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), + regexp = "'InputsModel' should contain an 'OutputsModel' key" + ) +}) + +Param <- c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started + +OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = Param) + +test_that("InputsModel$OutputsModel should contain a Qsim key", { + InputsModel$OutputsModel <- OutputsGR4JOnly + InputsModel$OutputsModel$Qsim <- NULL + expect_error( + RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), + regexp = "should contain a key 'Qsim'" + ) +}) + +test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", { + InputsModel$OutputsModel <- OutputsGR4JOnly + InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0) + expect_error( + RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), + regexp = "should have the same lenght as" + ) +}) + +test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", { + InputsModel$OutputsModel <- OutputsGR4JOnly + InputsModel$OutputsModel$Qsim[10L] <- NA + expect_error( + RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), + regexp = "contain no NA" + ) +}) + +test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { + UpstBasinArea <- InputsModel$BasinAreas[1L] + InputsModel$BasinAreas[1L] <- 0 + OutputsSD <- RunModel(InputsModel, + RunOptions, + Param = c(1, Param), + FUN_MOD = RunModel_GR4J) + expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim) +}) + +test_that("Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", { + InputsModel$LengthHydro <- 0 + InputsModel$BasinAreas <- c(BasinInfo$BasinArea, 0) + OutputsSD <- RunModel(InputsModel, + RunOptions, + Param = c(1, Param), + FUN_MOD = RunModel_GR4J) + expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run]) +}) + +ParamSD <- c(InputsModel$LengthHydro / (24 * 60 * 60), Param) # Speed corresponding to one time step delay + +QlsGR4Only <- OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2L] * 1e6 / 86400 + +test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", { + OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) + QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400 + QlsUpstLagObs <- c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1L] * 1e6 / 86400 + expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) +}) + +test_that("1 input with lag of 0.5 time step delay out gives an output delayed of 0.5 time step", { + OutputsSD <- RunModel(InputsModel, RunOptions, + Param = c(InputsModel$LengthHydro / (12 * 3600), Param), + FUN_MOD = RunModel_GR4J) + QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400 + QlsUpstLagObs <- (Qupstream[Ind_Run] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]))/2 * InputsModel$BasinAreas[1L] * 1e6 / 86400 + expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) +}) + +test_that("Params from calibration with simulated data should be similar to initial params", { + InputsCrit <- CreateInputsCrit( + FUN_CRIT = ErrorCrit_NSE, + InputsModel = InputsModel, + RunOptions = RunOptions, + VarObs = "Q", + Obs = (c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] + + BasinObs$Qmm[Ind_Run] * BasinAreas[2L]) / sum(BasinAreas) + ) + CalibOptions <- CreateCalibOptions( + FUN_MOD = RunModel_GR4J, + FUN_CALIB = Calibration_Michel, + IsSD = TRUE + ) + OutputsCalib <- Calibration_Michel( + InputsModel = InputsModel, + RunOptions = RunOptions, + InputsCrit = InputsCrit, + CalibOptions = CalibOptions, + FUN_MOD = RunModel_GR4J + ) + expect_equal(OutputsCalib$ParamFinalR[2:5] / ParamSD[2:5], rep(1, 4), tolerance = 1e-2) + expect_equal(OutputsCalib$ParamFinalR[1L], ParamSD[1L], tolerance = 2e-3) +}) + +test_that("1 no area input with lag of 1 time step delay out gives an output delayed of one time step converted to mm", { + Qm3GR4Only <- OutputsGR4JOnly$Qsim * BasinAreas[2L] * 1e3 + # Specify that upstream flow is not related to an area + InputsModel$BasinAreas <- c(NA, BasinAreas[2L]) + # Convert upstream flow to m3/day + InputsModel$Qupstream <- matrix(Qupstream, ncol = 1) * BasinAreas[1L] * 1e3 + + OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) + + expect_false(any(is.na(OutputsSD$Qsim))) + + Qm3SdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas, na.rm = TRUE) * 1e3 + Qm3UpstLagObs <- c(0, InputsModel$Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) + + expect_equal(Qm3SdSim - Qm3GR4Only, Qm3UpstLagObs) +}) + +# *** IniStates tests *** +IM <- InputsModel +IM$BasinAreas <- rep(BasinInfo$BasinArea, 3) +IM$Qupstream <- cbind(IM$Qupstream, IM$Qupstream) +IM$LengthHydro <- c(1000, 1500) + +PSDini <- ParamSD +PSDini[1] <- PSDini[1] / 2 # 2 time step delay +Ind_Run1 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"), + which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-12-31")) +Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"), + which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-12-31")) + +# 1990 +RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, + InputsModel = IM, + IndPeriod_Run = Ind_Run1)) +OutputsModel1 <- RunModel(InputsModel = IM, + RunOptions = RunOptions1, Param = PSDini, + FUN_MOD = RunModel_GR4J) +# 1990-1991 +RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, + InputsModel = IM, + IndPeriod_Run = c(Ind_Run1, Ind_Run2))) +OutputsModel <- RunModel(InputsModel = IM, + RunOptions = RunOptions, + Param = PSDini, + FUN_MOD = RunModel_GR4J) + +test_that("Warm start should give same result as warmed model", { + # Warm start 1991 + RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J, + InputsModel = IM, IndPeriod_Run = Ind_Run2, + IndPeriod_WarmUp = 0L, + IniStates = OutputsModel1$StateEnd) + OutputsModel2 <- RunModel(InputsModel = IM, + RunOptions = RunOptions2, + Param = PSDini, + FUN_MOD = RunModel_GR4J) + # Compare 1991 Qsim from warm started and from 1990-1991 + names(OutputsModel2$Qsim) <- NULL + expect_equal(OutputsModel2$Qsim, OutputsModel$Qsim[366:730]) +}) + +test_that("Error on Wrong length of iniState$SD", { + OutputsModel1$StateEnd$SD[[1]] <- c(1,1) + RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J, + InputsModel = IM, IndPeriod_Run = Ind_Run2, + IndPeriod_WarmUp = 0L, + IniStates = OutputsModel1$StateEnd) + expect_error(RunModel(InputsModel = IM, RunOptions = RunOptions2, Param = PSDini, FUN_MOD = RunModel_GR4J) + ) +}) diff -Nru airgr-1.6.9.27/tests/testthat/test-RunModel_LAG.R airgr-1.6.10.4/tests/testthat/test-RunModel_LAG.R --- airgr-1.6.9.27/tests/testthat/test-RunModel_LAG.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/test-RunModel_LAG.R 1970-01-01 00:00:00.000000000 +0000 @@ -1,226 +0,0 @@ -context("RunModel_Lag") - -data(L0123001) - -test_that("'BasinAreas' must have one more element than 'LengthHydro'", { - expect_error( - InputsModel <- CreateInputsModel( - FUN_MOD = RunModel_GR4J, - DatesR = BasinObs$DatesR, - Precip = BasinObs$P, - PotEvap = BasinObs$E, - Qupstream = matrix(BasinObs$Qmm, ncol = 1), - LengthHydro = 1, - BasinAreas = 1 - ), - regexp = "'BasinAreas' must have one more element than 'LengthHydro'" - ) -}) - -BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea) - -test_that("'Qupstream' cannot contain any NA value", { - expect_error( - InputsModel <- CreateInputsModel( - FUN_MOD = RunModel_GR4J, - DatesR = BasinObs$DatesR, - Precip = BasinObs$P, - PotEvap = BasinObs$E, - Qupstream = matrix(BasinObs$Qmm, ncol = 1), - LengthHydro = 1, - BasinAreas = BasinAreas - ), - regexp = "'Qupstream' cannot contain any NA value" - ) -}) - -# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs -Qupstream <- floor((sin((seq_along(BasinObs$Qmm)/365*2*3.14))+1) * mean(BasinObs$Qmm, na.rm = TRUE)) - -InputsModel <- CreateInputsModel( - FUN_MOD = RunModel_GR4J, - DatesR = BasinObs$DatesR, - Precip = BasinObs$P, - PotEvap = BasinObs$E, - Qupstream = matrix(Qupstream, ncol = 1), - LengthHydro = 1000, - BasinAreas = BasinAreas -) - -Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"), - which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31")) - -RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModel, - IndPeriod_Run = Ind_Run)) - -test_that("InputsModel parameter should contain an OutputsModel key", { - expect_error( - RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), - regexp = "'InputsModel' should contain an 'OutputsModel' key" - ) -}) - -Param <- c(257.237556, 1.012237, 88.234673, 2.207958) # From vignettes/V01_get_started - -OutputsGR4JOnly <- RunModel_GR4J(InputsModel = InputsModel, - RunOptions = RunOptions, - Param = Param) - -test_that("InputsModel$OutputsModel should contain a Qsim key", { - InputsModel$OutputsModel <- OutputsGR4JOnly - InputsModel$OutputsModel$Qsim <- NULL - expect_error( - RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), - regexp = "should contain a key 'Qsim'" - ) -}) - -test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOptions$IndPeriod_Run'", { - InputsModel$OutputsModel <- OutputsGR4JOnly - InputsModel$OutputsModel$Qsim <- c(InputsModel$OutputsModel$Qsim, 0) - expect_error( - RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), - regexp = "should have the same lenght as" - ) -}) - -test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", { - InputsModel$OutputsModel <- OutputsGR4JOnly - InputsModel$OutputsModel$Qsim[10L] <- NA - expect_error( - RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1), - regexp = "contain no NA" - ) -}) - -test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { - UpstBasinArea <- InputsModel$BasinAreas[1L] - InputsModel$BasinAreas[1L] <- 0 - OutputsSD <- RunModel(InputsModel, - RunOptions, - Param = c(1, Param), - FUN_MOD = RunModel_GR4J) - expect_equal(OutputsGR4JOnly$Qsim, OutputsSD$Qsim) -}) - -test_that("Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone", { - InputsModel$LengthHydro <- 0 - InputsModel$BasinAreas <- c(BasinInfo$BasinArea, 0) - OutputsSD <- RunModel(InputsModel, - RunOptions, - Param = c(1, Param), - FUN_MOD = RunModel_GR4J) - expect_equal(OutputsSD$Qsim, Qupstream[Ind_Run]) -}) - -ParamSD <- c(InputsModel$LengthHydro / (24 * 60 * 60), Param) # Speed corresponding to one time step delay - -QlsGR4Only <- OutputsGR4JOnly$Qsim * InputsModel$BasinAreas[2L] * 1e6 / 86400 - -test_that("1 input with lag of 1 time step delay out gives an output delayed of one time step", { - OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) - QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400 - QlsUpstLagObs <- c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * InputsModel$BasinAreas[1L] * 1e6 / 86400 - expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) -}) - -test_that("1 input with lag of 0.5 time step delay out gives an output delayed of 0.5 time step", { - OutputsSD <- RunModel(InputsModel, RunOptions, - Param = c(InputsModel$LengthHydro / (12 * 3600), Param), - FUN_MOD = RunModel_GR4J) - QlsSdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas) * 1e6 / 86400 - QlsUpstLagObs <- (Qupstream[Ind_Run] + c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]))/2 * InputsModel$BasinAreas[1L] * 1e6 / 86400 - expect_equal(QlsSdSim - QlsGR4Only, QlsUpstLagObs) -}) - -test_that("Params from calibration with simulated data should be similar to initial params", { - InputsCrit <- CreateInputsCrit( - FUN_CRIT = ErrorCrit_NSE, - InputsModel = InputsModel, - RunOptions = RunOptions, - VarObs = "Q", - Obs = ( - c(0, Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) * BasinAreas[1L] + - BasinObs$Qmm[Ind_Run] * BasinAreas[2L] - ) / sum(BasinAreas) - ) - CalibOptions <- CreateCalibOptions( - FUN_MOD = RunModel_GR4J, - FUN_CALIB = Calibration_Michel, - IsSD = TRUE - ) - OutputsCalib <- Calibration_Michel( - InputsModel = InputsModel, - RunOptions = RunOptions, - InputsCrit = InputsCrit, - CalibOptions = CalibOptions, - FUN_MOD = RunModel_GR4J - ) - expect_equal(OutputsCalib$ParamFinalR[2:5] / ParamSD[2:5], rep(1, 4), tolerance = 1e-2) - expect_equal(OutputsCalib$ParamFinalR[1L], ParamSD[1L], tolerance = 2e-3) -}) - -test_that("1 no area input with lag of 1 time step delay out gives an output delayed of one time step converted to mm", { - Qm3GR4Only <- OutputsGR4JOnly$Qsim * BasinAreas[2L] * 1e3 - # Specify that upstream flow is not related to an area - InputsModel$BasinAreas <- c(NA, BasinAreas[2L]) - # Convert upstream flow to m3/day - InputsModel$Qupstream <- matrix(Qupstream, ncol = 1) * BasinAreas[1L] * 1e3 - - OutputsSD <- RunModel(InputsModel, RunOptions, Param = ParamSD, FUN_MOD = RunModel_GR4J) - - expect_false(any(is.na(OutputsSD$Qsim))) - - Qm3SdSim <- OutputsSD$Qsim * sum(InputsModel$BasinAreas, na.rm = TRUE) * 1e3 - Qm3UpstLagObs <- c(0, InputsModel$Qupstream[Ind_Run[1:(length(Ind_Run) - 1)]]) - - expect_equal(Qm3SdSim - Qm3GR4Only, Qm3UpstLagObs) -}) - -# *** IniStates tests *** -IM <- InputsModel -IM$BasinAreas <- rep(BasinInfo$BasinArea, 3) -IM$Qupstream <- cbind(IM$Qupstream, IM$Qupstream) -IM$LengthHydro <- c(1000, 1500) - -PSDini <- ParamSD -PSDini[1] <- PSDini[1] / 2 # 2 time step delay -Ind_Run1 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-01-01"), - which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1990-12-31")) -Ind_Run2 <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-01-01"), - which(format(BasinObs$DatesR, format = "%Y-%m-%d")=="1991-12-31")) - -# 1990 -RunOptions1 <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = IM, IndPeriod_Run = Ind_Run1)) -OutputsModel1 <- RunModel(InputsModel = IM, - RunOptions = RunOptions1, Param = PSDini, FUN_MOD = RunModel_GR4J) -# 1990-1991 -RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = IM, IndPeriod_Run = c(Ind_Run1, Ind_Run2))) -OutputsModel <- RunModel(InputsModel = IM, - RunOptions = RunOptions, Param = PSDini, FUN_MOD = RunModel_GR4J) - -test_that("Warm start should give same result as warmed model", { - # Warm start 1991 - RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = IM, IndPeriod_Run = Ind_Run2, - IndPeriod_WarmUp = 0L, - IniStates = OutputsModel1$StateEnd) - OutputsModel2 <- RunModel(InputsModel = IM, - RunOptions = RunOptions2, Param = PSDini, FUN_MOD = RunModel_GR4J) - # Compare 1991 Qsim from warm started and from 1990-1991 - names(OutputsModel2$Qsim) <- NULL - expect_equal(OutputsModel2$Qsim, OutputsModel$Qsim[366:730]) -}) - -test_that("Error on Wrong length of iniState$SD", { - OutputsModel1$StateEnd$SD[[1]] <- c(1,1) - RunOptions2 <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = IM, IndPeriod_Run = Ind_Run2, - IndPeriod_WarmUp = 0L, - IniStates = OutputsModel1$StateEnd) - expect_error(RunModel(InputsModel = IM, RunOptions = RunOptions2, Param = PSDini, FUN_MOD = RunModel_GR4J) - ) -}) diff -Nru airgr-1.6.9.27/tests/testthat/test-SeriesAggreg.R airgr-1.6.10.4/tests/testthat/test-SeriesAggreg.R --- airgr-1.6.9.27/tests/testthat/test-SeriesAggreg.R 2021-01-11 08:29:36.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/test-SeriesAggreg.R 2021-01-28 21:27:11.000000000 +0000 @@ -61,9 +61,10 @@ E = BasinObs$E, Qmm = BasinObs$Qmm ) - GoodValues <- apply(BasinObs[BasinObs$DatesR >= "1984-09-01" & - BasinObs$DatesR < "1985-09-01", - c("P", "E", "Qmm")], 2, sum) + GoodValues <- apply(BasinObs[BasinObs$DatesR >= as.POSIXct("1984-09-01", tz = "UTC") & + BasinObs$DatesR < as.POSIXct("1985-09-01", tz = "UTC"), + c("P", "E", "Qmm")], + MARGIN = 2, FUN = sum) TestedValues <- unlist(SeriesAggreg(TabSeries, Format = "%Y", YearFirstMonth = 9, @@ -229,7 +230,7 @@ Qls <- BasinObs[, c("DatesR", "Qls")] test_ConvertFunRegime <- function(x, ConvertFun, TimeFormat) { expect_equal(nrow(SeriesAggreg(x, TimeFormat, ConvertFun = ConvertFun)), - length(unique(format(BasinObs$DatesR, "%Y")))) + length(unique(format(BasinObs$DatesR, "%Y")))) } lapply(c("max", "min", "median"), function(x) {test_ConvertFunRegime(Qls, x, "%Y")}) }) diff -Nru airgr-1.6.9.27/tests/testthat/test-vignettes.R airgr-1.6.10.4/tests/testthat/test-vignettes.R --- airgr-1.6.9.27/tests/testthat/test-vignettes.R 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/tests/testthat/test-vignettes.R 2021-01-28 21:11:42.000000000 +0000 @@ -11,11 +11,14 @@ skip_on_cran() rm(list = ls()) load(system.file("vignettesData/vignetteParamOptim.rda", package = "airGR")) + load(system.file("vignettesData/vignetteParamOptimCaramel.rda", package = "airGR")) rda_resGLOB <- resGLOB rda_resPORT <- resPORT + rda_optMO <- optMO expect_true(RunVignetteChunks("V02.1_param_optim")) - expect_equal(summary(resGLOB), summary(rda_resGLOB), tolerance = 1E-7) - expect_equal(resGLOB[,-1], rda_resGLOB[,-1], tolerance = 1E-2) # High tolerance due to randomisation in optimisations + expect_equal(summary(resGLOB), summary(rda_resGLOB), tolerance = 1e-7) + expect_equal(resGLOB[, -1], rda_resGLOB[, -1], tolerance = 1e-2) # High tolerance due to randomisation in optimisations + expect_equal(summary(optMO$parameters), summary(rda_optMO$parameters), tolerance = 1e-7) }) test_that("V02.2_param_mcmc works", { @@ -25,15 +28,14 @@ rda_gelRub <- gelRub rda_multDRAM <- multDRAM expect_true(RunVignetteChunks("V02.2_param_mcmc")) - expect_equal(gelRub, rda_gelRub, tolerance = 1E-7) - expect_equal(multDRAM, rda_multDRAM, tolerance = 1E-7) + expect_equal(gelRub, rda_gelRub, tolerance = 1e-7) + expect_equal(multDRAM, rda_multDRAM, tolerance = 1e-7) }) test_that("V03_param_sets_GR4J works", { skip_on_cran() rm(list = ls()) expect_true(RunVignetteChunks("V03_param_sets_GR4J")) - }) test_that("V04_cemaneige_hysteresis works", { @@ -46,8 +48,8 @@ rda_OutputsCrit_Val_NoHyst <- OutputsCrit_Val_NoHyst expect_true(RunVignetteChunks("V04_cemaneige_hysteresis")) TestQmmQlsConversion(BasinObs, BasinInfo$BasinArea) - expect_equal(OutputsCrit_Cal, rda_OutputsCrit_Cal, tolerance = 1E-7) - expect_equal(OutputsCrit_Cal_NoHyst, rda_OutputsCrit_Cal_NoHyst, tolerance = 1E-7) - expect_equal(OutputsCrit_Val, rda_OutputsCrit_Val, tolerance = 1E-7) - expect_equal(OutputsCrit_Val_NoHyst, rda_OutputsCrit_Val_NoHyst, tolerance = 1E-7) + expect_equal(OutputsCrit_Cal, rda_OutputsCrit_Cal, tolerance = 1e-7) + expect_equal(OutputsCrit_Cal_NoHyst, rda_OutputsCrit_Cal_NoHyst, tolerance = 1e-7) + expect_equal(OutputsCrit_Val, rda_OutputsCrit_Val, tolerance = 1e-7) + expect_equal(OutputsCrit_Val_NoHyst, rda_OutputsCrit_Val_NoHyst, tolerance = 1e-7) }) diff -Nru airgr-1.6.9.27/vignettes/V01_get_started.Rmd airgr-1.6.10.4/vignettes/V01_get_started.Rmd --- airgr-1.6.9.27/vignettes/V01_get_started.Rmd 2021-01-13 16:50:44.000000000 +0000 +++ airgr-1.6.10.4/vignettes/V01_get_started.Rmd 2021-01-28 21:14:32.000000000 +0000 @@ -1,5 +1,6 @@ --- title: "Get Started with airGR" +author: "Guillaume Thirel, Olivier Delaigue, Laurent Coron" bibliography: V00_airgr_ref.bib output: rmarkdown::html_vignette vignette: > diff -Nru airgr-1.6.9.27/vignettes/V02.1_param_optim.Rmd airgr-1.6.10.4/vignettes/V02.1_param_optim.Rmd --- airgr-1.6.9.27/vignettes/V02.1_param_optim.Rmd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/vignettes/V02.1_param_optim.Rmd 2021-01-28 21:11:42.000000000 +0000 @@ -1,6 +1,6 @@ --- title: "Plugging in new calibration algorithms in airGR" -author: "François Bourgin" +author: "François Bourgin, Guillaume Thirel" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::rmarkdown} @@ -15,9 +15,13 @@ library(DEoptim) library(hydroPSO) # Needs R version >= 3.6 or latticeExtra <= 0.6-28 on R 3.5 library(Rmalschains) +library(caRamel) +library(ggplot2) +library(GGally) # source("airGR.R") set.seed(321) load(system.file("vignettesData/vignetteParamOptim.rda", package = "airGR")) +load(system.file("vignettesData/vignetteParamOptimCaramel.rda", package = "airGR")) ``` @@ -158,7 +162,7 @@ ```{r, warning=FALSE, echo=FALSE, eval=FALSE} resGLOB <- data.frame(Algo = c("airGR", "PORT", "DE", "PSO", "MA-LS"), round(rbind( - OutputsCalib$ParamFinalR , + OutputsCalib$ParamFinalR, airGR::TransfoParam_GR4J(ParamIn = optPORT$par , Direction = "TR"), airGR::TransfoParam_GR4J(ParamIn = as.numeric(optDE$optim$bestmem), Direction = "TR"), airGR::TransfoParam_GR4J(ParamIn = as.numeric(optPSO$par) , Direction = "TR"), @@ -172,4 +176,100 @@ +# Multiobjective optimization + +Multiobjective optimization is used to explore possible trade-offs between different performances criteria. +Here we use the following R implementation of an efficient strategy: +* [caRamel: Automatic Calibration by Evolutionary Multi Objective Algorithm](https://cran.r-project.org/package=caRamel) + +Motivated by using the rainfall-runoff model for low flow simulation, we explore the trade-offs between the KGE values obtained without any data transformation and with the inverse transformation. + +First, the OptimGR4J function previously used is modified to return two values. + +```{r, warning=FALSE, results='hide', eval=FALSE} +InputsCrit_inv <- InputsCrit +InputsCrit_inv$transfo <- "inv" + +MOptimGR4J <- function(i) { + if (algo == "caRamel") { + ParamOptim <- x[i, ] + } + ## Transformation of the parameter set to real space + RawParamOptim <- airGR::TransfoParam_GR4J(ParamIn = ParamOptim, + Direction = "TR") + ## Simulation given a parameter set + OutputsModel <- airGR::RunModel_GR4J(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = RawParamOptim) + ## Computation of the value of the performance criteria + OutputsCrit1 <- airGR::ErrorCrit_KGE(InputsCrit = InputsCrit, + OutputsModel = OutputsModel, + verbose = FALSE) + ## Computation of the value of the performance criteria + OutputsCrit2 <- airGR::ErrorCrit_KGE(InputsCrit = InputsCrit_inv, + OutputsModel = OutputsModel, + verbose = FALSE) + return(c(OutputsCrit1$CritValue, OutputsCrit2$CritValue)) +} +``` + +## caRamel +caRamel is a multiobjective evolutionary algorithm combining the MEAS algorithm and the NGSA-II algorithm. + +```{r, warning=FALSE, results='hide', eval=FALSE} +algo <- "caRamel" +optMO <- caRamel::caRamel(nobj = 2, + nvar = 4, + minmax = rep(TRUE, 2), + bounds = matrix(c(lowerGR4J, upperGR4J), ncol = 2), + func = MOptimGR4J, + popsize = 100, + archsize = 100, + maxrun = 15000, + prec = rep(1.e-3, 2), + carallel = FALSE, + graph = FALSE) +``` + +The algorithm returns parameter sets that describe the pareto front, illustrating the trade-off between overall good performance and good performance for low flow. + +```{r, fig.width=6, fig.height=6, warning=FALSE} +ggplot() + + geom_point(aes(optMO$objectives[, 1], optMO$objectives[, 2])) + + coord_equal(xlim = c(0.4, 0.9), ylim = c(0.4, 0.9)) + + xlab("KGE") + ylab("KGE [1/Q]") + + theme_bw() +``` + +The pameter sets can be viewed in the parameter space, illustrating different populations. + +```{r fig.height=6, fig.width=6, message=FALSE, warning=FALSE} +param_optMO <- apply(optMO$parameters, MARGIN = 1, FUN = function(x) { + airGR::TransfoParam_GR4J(x, Direction = "TR") + }) +GGally::ggpairs(data.frame(t(param_optMO)), diag = NULL) + theme_bw() +``` + +```{r fig.height=6, fig.width=12, message=FALSE, warning=FALSE} +RunOptions$Outputs_Sim <- "Qsim" +run_optMO <- apply(optMO$parameters, MARGIN = 1, FUN = function(x) { + airGR::RunModel_GR4J(InputsModel = InputsModel, + RunOptions = RunOptions, + Param = x) + }$Qsim) +run_optMO <- data.frame(run_optMO) + +ggplot() + + geom_line(aes(x = as.POSIXct(InputsModel$DatesR[Ind_Run]), + y = run_optMO$X1)) + + geom_line(aes(x = as.POSIXct(InputsModel$DatesR[Ind_Run]), + y = run_optMO$X54), + colour = "darkred") + + scale_x_datetime(limits = c(as.POSIXct("1998-01-01"), NA)) + + ylab("Discharge [mm/d]") + xlab("Date") + + scale_y_sqrt() + + theme_bw() +``` + + diff -Nru airgr-1.6.9.27/vignettes/V03_param_sets_GR4J.Rmd airgr-1.6.10.4/vignettes/V03_param_sets_GR4J.Rmd --- airgr-1.6.9.27/vignettes/V03_param_sets_GR4J.Rmd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/vignettes/V03_param_sets_GR4J.Rmd 2021-01-28 21:13:47.000000000 +0000 @@ -1,5 +1,6 @@ --- title: "Generalist parameter sets for the GR4J model" +author: "Olivier Delaigue, Guillaume Thirel" bibliography: V00_airgr_ref.bib output: rmarkdown::html_vignette vignette: > diff -Nru airgr-1.6.9.27/vignettes/V04_cemaneige_hysteresis.Rmd airgr-1.6.10.4/vignettes/V04_cemaneige_hysteresis.Rmd --- airgr-1.6.9.27/vignettes/V04_cemaneige_hysteresis.Rmd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/vignettes/V04_cemaneige_hysteresis.Rmd 2021-01-28 21:14:06.000000000 +0000 @@ -1,5 +1,6 @@ --- title: "Using satellite snow cover area data for calibrating and improving CemaNeige" +author: "Guillaume Thirel, Olivier Delaigue" bibliography: V00_airgr_ref.bib output: rmarkdown::html_vignette vignette: > diff -Nru airgr-1.6.9.27/vignettes/V05_sd_model.Rmd airgr-1.6.10.4/vignettes/V05_sd_model.Rmd --- airgr-1.6.9.27/vignettes/V05_sd_model.Rmd 2021-01-06 10:07:45.000000000 +0000 +++ airgr-1.6.10.4/vignettes/V05_sd_model.Rmd 2021-01-29 05:03:09.000000000 +0000 @@ -69,10 +69,12 @@ Ind_Run <- seq(which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1990-01-01"), which(format(BasinObs$DatesR, format = "%Y-%m-%d") == "1999-12-31")) RunOptionsUp <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModelUp, IndPeriod_Run = Ind_Run, - IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL) + InputsModel = InputsModelUp + , IndPeriod_WarmUp = NULL, IndPeriod_Run = Ind_Run, + IniStates = NULL, IniResLevels = NULL) InputsCritUp <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelUp, - RunOptions = RunOptionsUp, VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run]) + RunOptions = RunOptionsUp, + VarObs = "Q", Obs = BasinObs$Qmm[Ind_Run]) CalibOptionsUp <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel) OutputsCalibUp <- Calibration_Michel(InputsModel = InputsModelUp, RunOptions = RunOptionsUp, InputsCrit = InputsCritUp, CalibOptions = CalibOptionsUp, @@ -101,9 +103,9 @@ InputsModelDown1 <- CreateInputsModel( FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, Precip = BasinObs$P, PotEvap = BasinObs$E, - Qupstream = matrix(QObsUp, ncol = 1), # Upstream observed flow - LengthHydro = 100 * 1000, # Distance between upstream catchment outlet and the downstream one in m - BasinAreas = c(180, 180) # Upstream and downstream areas in km² + Qupstream = matrix(QObsUp, ncol = 1), # upstream observed flow + LengthHydro = 1e2 * 1e3, # distance between upstream catchment outlet & the downstream one [m] + BasinAreas = c(180, 180) # upstream and downstream areas [km²] ) ``` @@ -111,15 +113,19 @@ ```{r} RunOptionsDown <- CreateRunOptions(FUN_MOD = RunModel_GR4J, - InputsModel = InputsModelDown1, IndPeriod_Run = Ind_Run, - IniStates = NULL, IniResLevels = NULL, IndPeriod_WarmUp = NULL) + InputsModel = InputsModelDown1, + IndPeriod_WarmUp = NULL, IndPeriod_Run = Ind_Run, + IniStates = NULL, IniResLevels = NULL) InputsCritDown <- CreateInputsCrit(FUN_CRIT = ErrorCrit_NSE, InputsModel = InputsModelDown1, - RunOptions = RunOptionsDown, VarObs = "Q", Obs = QObsDown[Ind_Run]) + RunOptions = RunOptionsDown, + VarObs = "Q", Obs = QObsDown[Ind_Run]) CalibOptionsDown <- CreateCalibOptions(FUN_MOD = RunModel_GR4J, FUN_CALIB = Calibration_Michel, - IsSD = TRUE) # Don't forget to specify that it's an SD model here -OutputsCalibDown1 <- Calibration_Michel(InputsModel = InputsModelDown1, RunOptions = RunOptionsDown, - InputsCrit = InputsCritDown, CalibOptions = CalibOptionsDown, + IsSD = TRUE) # specify that it's a SD model +OutputsCalibDown1 <- Calibration_Michel(InputsModel = InputsModelDown1, + RunOptions = RunOptionsDown, + InputsCrit = InputsCritDown, + CalibOptions = CalibOptionsDown, FUN_MOD = RunModel_GR4J) ``` @@ -151,8 +157,10 @@ We calibrate the model with the `InputsModel` object previously created for substituting the observed upstream flow with the simulated one: ```{r} -OutputsCalibDown2 <- Calibration_Michel(InputsModel = InputsModelDown2, RunOptions = RunOptionsDown, - InputsCrit = InputsCritDown, CalibOptions = CalibOptionsDown, +OutputsCalibDown2 <- Calibration_Michel(InputsModel = InputsModelDown2, + RunOptions = RunOptionsDown, + InputsCrit = InputsCritDown, + CalibOptions = CalibOptionsDown, FUN_MOD = RunModel_GR4J) ParamDown2 <- OutputsCalibDown2$ParamFinalR ``` @@ -162,7 +170,7 @@ ## Identification of Lag parameter -The theoretical LAG parameter should be equal to: +The theoretical Lag parameter should be equal to: ```{r} Lag <- InputsModelDown1$LengthHydro / (2 * 86400) @@ -172,10 +180,14 @@ Both calibrations overestimate this parameter: ```{r} -mLag <- matrix(c(Lag, OutputsCalibDown1$ParamFinalR[1], OutputsCalibDown2$ParamFinalR[1]), ncol = 1) -rownames(mLag) = c("theoretical", "calibrated with observed upstream flow", - "calibrated with simulated upstream flow") -colnames(mLag) = c("Lag parameter") +mLag <- matrix(c(Lag, + OutputsCalibDown1$ParamFinalR[1], + OutputsCalibDown2$ParamFinalR[1]), + ncol = 1, + dimnames = list(c("theoretical", + "calibrated with observed upstream flow", + "calibrated with simulated upstream flow"), + c("Lag parameter"))) knitr::kable(mLag) ``` @@ -197,11 +209,17 @@ ## Parameters and performance of each subcatchment for all calibrations ```{r} -comp <- matrix(c(0, OutputsCalibUp$ParamFinalR, rep(OutputsCalibDown1$ParamFinalR, 2), - OutputsCalibDown2$ParamFinalR, ParamDownTheo), ncol = 5, byrow = TRUE) -comp <- cbind(comp, c(OutputsCalibUp$CritFinal, OutputsCalibDown1$CritFinal, - CritDown1$CritValue, OutputsCalibDown2$CritFinal, CritDownTheo$CritValue)) -colnames(comp) <- c("Lag", paste0("x", 1:4), "NSE") +comp <- matrix(c(0, OutputsCalibUp$ParamFinalR, + rep(OutputsCalibDown1$ParamFinalR, 2), + OutputsCalibDown2$ParamFinalR, + ParamDownTheo), + ncol = 5, byrow = TRUE) +comp <- cbind(comp, c(OutputsCalibUp$CritFinal, + OutputsCalibDown1$CritFinal, + CritDown1$CritValue, + OutputsCalibDown2$CritFinal, + CritDownTheo$CritValue)) +colnames(comp) <- c("Lag", paste0("X", 1:4), "NSE") rownames(comp) <- c("Calibration of the upstream subcatchment", "Calibration 1 with observed upstream flow", "Validation 1 with simulated upstream flow",