Skip to content
GitLab

Resolve "airGR compatibility: debugged version of RunModel_Lag"

Merged Dorchies David requested to merge 33-airgr-compatibility-debugged-version-of-runmodel_lag into dev
Viewing commit 1e16121b
Prev Next
Show latest version
10 files
+ 99
− 132
R/CreateSupervisor.R
+ 1
− 0
@@ -41,6 +41,7 @@ CreateSupervisor <- function(InputsModel, TimeStep = 1L) {
e$supervisor <- e
# Copy of InputsModel, griwrm and prepare OutputsModel
e$DatesR <- InputsModel[[1]]$DatesR
e$InputsModel <- InputsModel
e$griwrm <- attr(InputsModel, "GRiwrm")
e$OutputsModel <- list()
R/RunModel.Supervisor.R
+ 12
− 4
@@ -9,10 +9,14 @@
#' @export
RunModel.Supervisor <- function(x, RunOptions, Param, ...) {
# Save InputsModel for restoration at the end (Supervisor is an environment...)
InputsModelBackup <- x$InputsModel
# Time steps handling
x$ts.index0 <- RunOptions[[1]]$IndPeriod_Run[1] - 1
ts.start <- RunOptions[[1]]$IndPeriod_Run[1]
ts.end <- RunOptions[[1]]$IndPeriod_Run[length(RunOptions[[1]]$IndPeriod_Run)]
IndPeriod_Run <- RunOptions[[1]]$IndPeriod_Run
x$ts.index0 <- IndPeriod_Run[1] - 1
ts.start <- IndPeriod_Run[1]
ts.end <- IndPeriod_Run[length(IndPeriod_Run)]
superTSstarts <- seq(ts.start, ts.end, x$.TimeStep)
lSuperTS <- lapply(
superTSstarts, function(x, TS, xMax) {
@@ -93,6 +97,10 @@ RunModel.Supervisor <- function(x, RunOptions, Param, ...) {
x$OutputsModel[[id]]$Qsim <-
Qsim_m3[, id] / sum(x$InputsModel[[id]]$BasinAreas, na.rm = TRUE) / 1e3
}
attr(x$OutputsModel, "Qm3s") <- OutputsModelQsim(x$InputsModel, x$OutputsModel, RunOptions[[1]]$IndPeriod_Run)
attr(x$OutputsModel, "Qm3s") <- OutputsModelQsim(x$InputsModel, x$OutputsModel, IndPeriod_Run)
# restoration of InputsModel (Supervisor is an environment...)
x$InputsModel <- InputsModelBackup
return(x$OutputsModel)
}
inst/seine_data/config_reservoirs.json deleted 100644 → 0
+ 0
− 54
{
"Aube": {
"file": "Obs_Aube_1987-2008.txt",
"connections": {
"AUBE-_P2": {
"col": "Q_prise_m3s",
"type": "in"
},
"AUBE-_R3": {
"col": "Q_restitution_total_m3s",
"type": "out"
}
}
},
"Marne": {
"file": "Obs_Marne_1973-2008.txt",
"connections": {
"MARNE_P23": {
"col": "Q_prise_Marne_m3s",
"type": "in"
},
"MARNE_P28": {
"col": "Q_prise_Blaise_m3s",
"type": "in"
},
"MARNE_R25": {
"col": "Q_restitution_total_m3s",
"type": "out"
}
}
},
"Panneciere": {
"file": "Obs_Panneciere_1949-2008.txt",
"connections": {
"PANNEC_R": {
"col": "Q_aval_bassin_m3s",
"type": "out"
}
}
},
"Seine": {
"file": "Obs_Seine_1965-2008.txt",
"connections": {
"SEINE_P7": {
"col": "Q_prise_m3s",
"type": "in"
},
"SEINE_R8": {
"col": "Q_restitution_total_m3s",
"type": "out"
}
}
}
}
\ No newline at end of file
inst/seine_data/network_gauging_stations.txt deleted 100644 → 0
+ 0
− 26
id_sgl;id_hydro;lambert2.x;lambert2.y;area;description;id_aval;distance_aval
TRANN_01;;766626.06;2369152.25;1557.06;L'Aube à Trannes;ARCIS_24;68100
GURGY_02;H2221010;689713.00;2320549.00;3819.77;L'Yonne à Gurgy;COURL_23;83612
BRIEN_03;H2482010;695313.00;2332549.00;2979.77;L'Armançon à Brienon-sur-Armançon;COURL_23;84653
STDIZ_04;H5071010;791113.00;2407349.00;2347.53;La Marne à Saint-Dizier;CHALO_21;85570
PARIS_05;H5920010;602213.00;2427449.00;43824.66;La Seine à Paris;;
BAR-S_06;H0400010;751913.00;2348349.00;2340.37;La Seine à Bar-sur-Seine;MERY-_22;79766
CHAUM_07;;716518.38;2241747.00;216.50;L'Yonne à Chaumard;GURGY_02;153074
CUSSY_08;H2172310;726013.00;2275149.00;247.99;Le Cousin à Cussy-les-Forges;GURGY_02;91378
STGER_09;;718512.88;2266649.25;402.74;La Cure à St-Germain;GURGY_02;94152
GUILL_10;H2322020;731013.00;2282349.00;488.71;Le Serein à Guillon;CHABL_12;66026
AISY-_11;H2452020;742413.00;2298149.00;1349.51;L'Armançon à Aisy-sur-Armançon;BRIEN_03;102428
CHABL_12;H2342010;709613.00;2314149.00;1116.27;Le Serein à Chablis;COURL_23;111781
NOGEN_13;;685912.88;2389349.25;9182.39;La Seine à Nogent-sur-Seine;MONTE_15;63215
EPISY_14;H3621010;633413.00;2371049.00;3916.71;Le Loing à Épisy;ALFOR_16;89196
MONTE_15;;645112.88;2376849.25;21199.39;La Seine à Montereau;ALFOR_16;94475
ALFOR_16;H4340020;606013.00;2420349.00;30784.71;La Seine à Alfortville;PARIS_05;9263
NOISI_17;H5841010;620913.00;2428949.00;12547.72;La Marne à Noisiel;PARIS_05;39384
MONTR_18;H5752020;638013.00;2431849.00;1184.81;Le Grand Morin à Montry;NOISI_17;37915
LOUVE_19;H5083050;791613.00;2393949.00;461.74;La Blaise à Louvemont;CHALO_21;86165
LASSI_20;H1362010;759513.00;2385549.00;876.53;La Voire à Lassicourt;ARCIS_24;43618
CHALO_21;H5201010;747713.00;2441349.00;6291.55;La Marne à Châlons-sur-Marne;NOISI_17;237937
MERY-_22;H0810010;714913.00;2390949.00;3899.62;La Seine à Méry-sur-Seine;NOGEN_13;49933
COURL_23;H2721010;660813.00;2370449.00;10687.35;L'Yonne à Courlon-sur-Yonne;MONTE_15;26159
ARCIS_24;H1501010;733313.00;2394749.00;3594.60;L'Aube à Arcis-sur-Aube;NOGEN_13;70926
VITRY_25;H5172010;768513.00;2418849.00;2109.14;La Saulx à Vitry-en-Perthois;CHALO_21;38047
inst/seine_data/network_reservoir_connections.txt deleted 100644 → 0
+ 0
− 10
id;length;down
AUBE-_P2;66500;ARCIS_24
AUBE-_R3;44500;ARCIS_24
MARNE_P23;3000;STDIZ_04
MARNE_P28;82420;CHALO_21
MARNE_R25;56870;CHALO_21
PANNEC_P;153074;GURGY_02
PANNEC_R;153074;GURGY_02
SEINE_P7;73766;MERY-_22
SEINE_R8;41766;MERY-_22
inst/vignettes/ParamV03.RDS 0 → 100644
+ 0
− 0

ParamV03.RDS

Download
vignettes/V01_Structure_SD_model.Rmd
+ 0
− 11
@@ -109,15 +109,4 @@ The **airGR** `CreateInputsModel` function is extended in order to handle the `G
InputsModel <- CreateInputsModel(griwrm, DatesR, Precip, PotEvap, Qobs)
```
## Save data for next vignettes
```{r}
getwd()
dir.create("cache", showWarnings = FALSE)
save(griwrm, Qobs, InputsModel, file = file.path(tempdir(), "V01.RData"))
save(griwrm, DatesR, Precip, PotEvap, Qobs, file = file.path(tempdir(), "V01b.RData"))
```
# References
vignettes/V02_Calibration_SD_model.Rmd
+ 14
− 12
@@ -32,22 +32,25 @@ To facilitate the use of the package, there are several functions dedicated to t
### GRiwrmInputsModel object
The production method of the `GRiwrmInputsModel` object is detailed in the vignette "01_First_network" of the package.
Run `vignette("01_Structure_SD_model", package = "airGRiwrm")` before this one in order to create the Rdata file containing the `GRiwrmInputsModel` object:
The production method of the `GRiwrmInputsModel` object is detailed in the vignette "V01_Structure_SD_model" of the package. The following code chunk resumes all the steps of this vignette:
```{r}
load(file.path(tempdir(), "V01.RData"))
data(Severn)
nodes <- Severn$BasinsInfo[, c("gauge_id", "downstream_id", "distance_downstream", "area")]
nodes$distance_downstream <- nodes$distance_downstream
nodes$model <- "RunModel_GR4J"
griwrm <- GRiwrm(nodes, list(id = "gauge_id", down = "downstream_id", length = "distance_downstream"))
BasinsObs <- Severn$BasinsObs
DatesR <- BasinsObs[[1]]$DatesR
PrecipTot <- cbind(sapply(BasinsObs, function(x) {x$precipitation}))
PotEvapTot <- cbind(sapply(BasinsObs, function(x) {x$peti}))
Qobs <- cbind(sapply(BasinsObs, function(x) {x$discharge_spec}))
Precip <- ConvertMeteoSD(griwrm, PrecipTot)
PotEvap <- ConvertMeteoSD(griwrm, PotEvapTot)
InputsModel <- CreateInputsModel(griwrm, DatesR, Precip, PotEvap, Qobs)
str(InputsModel)
```
The vignette "01_First_network" also provided a matrix with the observed flow of the nodes:
```{r}
head(Qobs)
```
## GriwmRunOptions object
The `CreateRunOptions()` function allows to prepare the options required for the `RunModel()` function.
@@ -107,7 +110,6 @@ Before using the automatic calibration tool, the user needs to prepare the calib
```{r CalibOption}
CalibOptions <- CreateCalibOptions(InputsModel)
str(CalibOptions)
```
```{r, echo=FALSE}
vignettes/V03_Open-loop_influenced_flow.Rmd
+ 33
− 10
@@ -21,8 +21,6 @@ library(airGRiwrm)
## Presentation of the study case
We can see in vignette 'V02_Calibration_SD_model' that calibration result for the flow simulated on the Avon at Evesham (Gauging station '54002') and on the Severn at Buildwas (Gauging station '54095') is not satisfactory. These upper basins are heavily influenced by impoundments and inter-basin transfers [@higgsHydrologicalChangesRiver1988].
To cope with this influenced flow, we won't try to simulate it with a hydrological model and we will directly inject in the model the observed flow at these nodes.
@@ -31,14 +29,17 @@ To cope with this influenced flow, we won't try to simulate it with a hydrologic
### Modifying the GRiwrm object
The production method of the `GRiwrm` object is detailed in the vignette "01_First_network" of the package (and also in the documentation, type `?GRiwrm` to access to it).
Run `vignette("01_Structure_SD_model", package = "airGRiwrm")` before this one in order to create the Rdata file containing the `GRiwrmInputsModel` object:
The production method of the `GRiwrm` object is detailed in the vignette "V01_Structure_SD_model" of the package. The following code chunk resumes all the necessary steps:
```{r}
load(file.path(tempdir(), "V01.RData"))
data(Severn)
nodes <- Severn$BasinsInfo[, c("gauge_id", "downstream_id", "distance_downstream", "area")]
nodes$distance_downstream <- nodes$distance_downstream
nodes$model <- "RunModel_GR4J"
griwrm <- GRiwrm(nodes, list(id = "gauge_id", down = "downstream_id", length = "distance_downstream"))
```
To notify the SD model that the provided flow on a node should be directly used instead of an hydrological model, you only need to declare its model as `NA`:
```{r}
@@ -62,19 +63,41 @@ DiagramGRiwrm(griwrmV03)
### Generate the GRiwrmInputsModel object
Since the network description has changed, the `GRiwrmInputsModel` should be generated again from its inputs recorded in the vignette "01_First_network":
The formatting of the input data is described in the vignette "V01_Structure_SD_model". the following code chunk resumes this formatting procedure:
```{r}
BasinsObs <- Severn$BasinsObs
DatesR <- BasinsObs[[1]]$DatesR
PrecipTot <- cbind(sapply(BasinsObs, function(x) {x$precipitation}))
PotEvapTot <- cbind(sapply(BasinsObs, function(x) {x$peti}))
Qobs <- cbind(sapply(BasinsObs, function(x) {x$discharge_spec}))
Precip <- ConvertMeteoSD(griwrm, PrecipTot)
PotEvap <- ConvertMeteoSD(griwrm, PotEvapTot)
```
The `GRiwrmInputsModel` object can be generated taking into account the new `GRiwrm` object:
```{r}
load(file.path(tempdir(), "V01b.RData"))
IM_OL <- CreateInputsModel(griwrmV03, DatesR, Precip, PotEvap, Qobs)
```
## Calibration of the new model
We reuse the calibration options and criteria created in vignette "V02_Calibration_SD_model". Run `vignette("02_Calibration_SD_model", package = "airGRiwrm")` before this one in order to create these variables.
Calibration options and criteria procedures are detailed in vignette "V02_Calibration_SD_model". The following code chunk resume this procedure:
```{r}
load(file.path(tempdir(), "V02.RData"))
IndPeriod_Run <- seq(
which(DatesR == (DatesR[1] + 365*24*60*60)), # Set aside warm-up period
length(DatesR) # Until the end of the time series
)
IndPeriod_WarmUp = seq(1,IndPeriod_Run[1]-1)
RunOptions <- CreateRunOptions(IM_OL,
IndPeriod_WarmUp = IndPeriod_WarmUp,
IndPeriod_Run = IndPeriod_Run)
InputsCrit <- CreateInputsCrit(IM_OL,
FUN_CRIT = airGR::ErrorCrit_KGE2,
RunOptions = RunOptions, Qobs = Qobs)
CalibOptions <- CreateCalibOptions(IM_OL)
```
The **airGR** calibration process is applied on each hydrological node of the `GRiwrm` network from upstream nodes to downstream nodes.
vignettes/V04_Closed-loop_regulated_withdrawal.Rmd
+ 39
− 5
@@ -26,12 +26,18 @@ library(airGRiwrm)
Starting from the network and the calibration set in the vignette "V03_Open-loop_influenced_flow", we add 2 intake points for irrigation.
Vignettes "V01_Structure_SD_model.Rmd" and "V03_Open-loop_influenced_flow" should be run in order to load input data and parameters of the model:
The following code chunk resumes the procedure of the vignette "V03_Open-loop_influenced_flow":
```{r load_cache}
load(file.path(tempdir(), "V01b.RData"))
load(file.path(tempdir(), "V02.RData"))
load(file.path(tempdir(), "V03.RData"))
data(Severn)
nodes <- Severn$BasinsInfo[, c("gauge_id", "downstream_id", "distance_downstream", "area")]
nodes$distance_downstream <- nodes$distance_downstream
nodes$model <- "RunModel_GR4J"
griwrm <- GRiwrm(nodes, list(id = "gauge_id", down = "downstream_id", length = "distance_downstream"))
griwrmV03 <- griwrm
griwrmV03$model[griwrm$id == "54002"] <- NA
griwrmV03$model[griwrm$id == "54095"] <- NA
griwrmV03
```
## Network configuration
@@ -67,6 +73,16 @@ Irrigation perimeters #1 cover an area of 15 km² and the perimeter #2 an area o
The objective of these irrigation system is to cover the deficit in rain [@burtIrrigationPerformanceMeasures1997] with 80% of success. Here's below the calculation of the 8th decile of monthly water need given meteorological data of catchments "54001" and "54032" (unit mm/day) :
```{r monthly_water_need}
# Formatting climatic data for CreateInputsModel (See vignette V01_Structure_SD_model for details)
BasinsObs <- Severn$BasinsObs
DatesR <- BasinsObs[[1]]$DatesR
PrecipTot <- cbind(sapply(BasinsObs, function(x) {x$precipitation}))
PotEvapTot <- cbind(sapply(BasinsObs, function(x) {x$peti}))
Qobs <- cbind(sapply(BasinsObs, function(x) {x$discharge_spec}))
Precip <- ConvertMeteoSD(griwrm, PrecipTot)
PotEvap <- ConvertMeteoSD(griwrm, PotEvapTot)
# Calculation of the water need at the sub-basin scale
dailyWaterNeed <- PotEvap - Precip
dailyWaterNeed <- cbind(as.data.frame(DatesR), dailyWaterNeed[,c("54001", "54032")])
monthlyWaterNeed <- airGR::SeriesAggreg(dailyWaterNeed, "%m", rep("q80",2))
@@ -212,9 +228,12 @@ for (x in 1:ncol(m))
As for the previous model, we need to set up an `GRiwrmInputsModel` object containing all the model inputs:
```{r}
# a flow is needed for all the nodes in the network
# A flow is needed for all the nodes in the network
# even if it is overwritten after by a controller
# The Qobs matrix is completed with 2 new columns for the new nodes
QobsIrrig <- cbind(Qobs, Irrigation1 = 0, Irrigation2 = 0)
# Creation of the GRiwrmInputsModel object
IM_Irrig <- CreateInputsModel(griwrmV04, DatesR, Precip, PotEvap, QobsIrrig)
```
@@ -316,6 +335,21 @@ CreateController(sv,
# Running the simulation
First we need to create a `GRiwrmRunOptions` object and load the parameters calibrated in the vignette "V03_Open-loop_influenced_flow":
```{r}
IndPeriod_Run <- seq(
which(DatesR == (DatesR[1] + 365*24*60*60)), # Set aside warm-up period
length(DatesR) # Until the end of the time series
)
IndPeriod_WarmUp = seq(1,IndPeriod_Run[1]-1)
RunOptions <- CreateRunOptions(IM_Irrig,
IndPeriod_WarmUp = IndPeriod_WarmUp,
IndPeriod_Run = IndPeriod_Run)
ParamV03 <- readRDS(system.file("vignettes", "ParamV03.RDS", package = "airGRiwrm"))
```
For running a model with a supervision, you only need to substitute `InputsModel` by a `Supervisor` in the `RunModel` function call.
```{r}