feat: Calibration of GR-IWRM natural model

- Add all functions for calibration
- vignette for calibration in context of natural catchment

Refs #3

NAMESPACE

 # Generated by roxygen2: do not edit by hand
 
-S3method(Calibration,default)
-S3method(Calibration,griwrm)
+S3method(Calibration,GriwrmInputsModel)
+S3method(Calibration,InputsModel)
+S3method(CreateCalibOptions,GriwrmInputsModel)
+S3method(CreateCalibOptions,InputsModel)
+S3method(CreateInputsCrit,GriwrmInputsModel)
+S3method(CreateInputsCrit,InputsModel)
 S3method(CreateInputsModel,Griwrm)
 S3method(CreateInputsModel,default)
 S3method(CreateRunOptions,GriwrmInputsModel)
@@ -10,6 +14,8 @@ S3method(RunModel,GriwrmInputsModel)
 S3method(RunModel,InputsModel)
 S3method(merge,Gits)
 export(Calibration)
+export(CreateCalibOptions)
+export(CreateInputsCrit)
 export(CreateInputsModel)
 export(CreateRunOptions)
 export(Ginet)

R/Calibration.GriwrmInputsModel.R

+#' Calibration of a semi-distributed run-off model
+#'
+#' @param InputsModel object of class \emph{GriwrmInputsModel}, see \code{\link{CreateInputsModel.Griwrm}} for details.
+#' @param RunOptions object of class \emph{GriwrmRunOptions}, see \code{\link{CreateRunOptiosn.Griwrm}} for details.
+#' @param InputsCrit object of class \emph{GriwrmInputsCrit}, see \code{\link{CreateInputsCrit.Griwrm}} for details.
+#' @param CalibOptions object of class \emph{GriwrmCalibOptions}, see \code{\link{CreateCalibOptions.Griwrm}} for details.
+#' @param useUpstreamQsim boolean describing if simulated (\code{TRUE}) or observed (\code{FALSE}) flows are used for calibration. Default is \code{TRUE}.
+#' @param verbose (optional) boolean indicating if the function is run in verbose mode or not, default = \code{TRUE}
+#' @param ... further arguments passed to \code{\link[airGR]{Calibration}}.
+#'
+#' @return GriwrmOutputsCalib object which is a list of OutputsCalib (See \code{\link[airGR]{Calibration}}) for each node of the semi-distributed model.
+#' @export
+Calibration.GriwrmInputsModel <- function(InputsModel,
+                                          RunOptions,
+                                          InputsCrit,
+                                          CalibOptions,
+                                          useUpstreamQsim = TRUE,
+                                          verbose = TRUE,
+                                          ...) {
+
+  OutputsCalib <- list()
+  class(OutputsCalib) <- append(class(OutputsCalib), "GriwrmOutputsCalib")
+
+  OutputsModel <- list()
+  class(OutputsModel) <- append(class(OutputsModel), "GriwrmOutputsModel")
+
+  for(IM in InputsModel) {
+    if(verbose) cat("Calibration.GriwrmInputsModel: Treating sub-basin", IM$id, "...\n")
+
+    if(useUpstreamQsim) {
+      # Update InputsModel$QobsUpstr with simulated upstream flows
+      IM <- UpdateQsimUpstream(IM, OutputsModel)
+    }
+
+    OutputsCalib[[IM$id]] <- Calibration.InputsModel(
+      InputsModel = IM,
+      RunOptions = RunOptions[[IM$id]],
+      InputsCrit = InputsCrit[[IM$id]],
+      CalibOptions = CalibOptions[[IM$id]],
+      ...
+    )
+
+    if(useUpstreamQsim) {
+      # Run the model for the sub-basin
+      OutputsModel[[IM$id]] <- RunModel(
+        InputsModel = IM,
+        RunOptions = RunOptions[[IM$id]],
+        Param = OutputsCalib[[IM$id]]$ParamFinalR
+      )
+    }
+
+  }
+
+  return(OutputsCalib)
+
+}

R/Calibration.InputsModel.R

+#' Wrapper to \code{\link[airGR]{Calibration}}.
+#'
+#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details.
+#' @param ... further arguments passed to \code{\link[airGR]{Calibration}}.
+#'
+#' @return \emph{CalibOutput} object.
+#' @export
+Calibration.InputsModel <- function(InputsModel, ...) {
+  airGR::Calibration(InputsModel, FUN_MOD = InputsModel$FUN_MOD, ...)
+}

R/Calibration.R

+#' Calibration of either airGR model and GRIWRM semi-distributive model
+#'
+#' @param InputsModel the class of the first parameter determine which calibration is used
+#' @param ... further arguments passed to or from other methods.
+#'
+#' @return \emph{OutputsCalib} or \emph{GriwrmOutputsCalib} object
+#' @export
+Calibration <- function(InputsModel, ...) {
+  UseMethod("Calibration", InputsModel)
+}

R/CreateCalibOptions.GriwrmInputsModel.R

+#' Title
+#'
+#' @param InputsModel object of class \emph{GriwrmInputsModel}, see \code{\link{CreateInputsModel.Griwrm}} for details.
+#' @param ... further arguments passed to \code{\link[airGR]{CreateCalibOptions}}.
+#'
+#' @return \emph{GriwrmCalibOptions} object.
+#' @export
+CreateCalibOptions.GriwrmInputsModel <- function(InputsModel, ...) {
+
+  CalibOptions <- list()
+
+  for(IM in InputsModel) {
+    CalibOptions[[IM$id]] <- CreateCalibOptions.InputsModel(
+      InputsModel = IM,
+      ...
+    )
+  }
+  return(CalibOptions)
+}

R/CreateCalibOptions.InputsModel.R

+#' Wrapper to \code{\link[airGR]{CreateCalibOptions}}
+#'
+#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details.
+#' @param ... further arguments passed to \code{\link[airGR]{CreateCalibOptions}}.
+#'
+#' @return \emph{CalibOptions} object.
+#' @export
+CreateCalibOptions.InputsModel <- function(InputsModel,
+                               ...) {
+  airGR::CreateCalibOptions(
+    FUN_MOD = InputsModel$FUN_MOD,
+    IsSD = !is.null(InputsModel$QobsUpstr),
+    ...
+  )
+}

R/CreateCalibOptions.R

+#' CreateCalibOptions both available for \emph{InputsModel} and \emph{GrwirmInputsModel} objects
+#'
+#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details.
+#' @param ... further arguments passed to or from other methods.
+#'
+#' @return
+#' @export
+CreateCalibOptions <- function(InputsModel, ...) {
+  UseMethod("CreateCalibOptions", InputsModel)
+}

R/CreateInputsCrit.GriwrmInputsModel.R

+#' Create \emph{GriwrmInputsCrit} object for GR-IWRM.
+#' @param InputsModel  object of class \emph{GriwrmInputsModel}, see \code{\link{CreateInputsModel.Griwrm}} for details.
+#' @param FUN_CRIT \[function (atomic or list)\] error criterion function (e.g. \code{\link[airGR]{ErrorCrit_RMSE}}, \code{\link[airGR]{ErrorCrit_NSE}})
+#' @param RunOptions object of class \emph{GriwrmRunOptions}, see \code{[CreateRunOptions.Griwrm]} for details.
+#' @param gits object of class \emph{Gits}, see [Gits].
+#' @param ... further arguments passed to \code{\link[airGR]{CreateInputsCrit}}.
+#'
+#' @return Object of class \emph{GriwrmInputsCrit}
+#' @export
+CreateInputsCrit.GriwrmInputsModel <- function(InputsModel,
+                                               FUN_CRIT = airGR::ErrorCrit_NSE,
+                                               RunOptions,
+                                               gits,
+                                               ...) {
+  InputsCrit <- list()
+  class(InputsCrit) <- append(class(InputsCrit), "GriwrmInputsCrit")
+
+  for(IM in InputsModel) {
+    InputsCrit[[IM$id]] <- CreateInputsCrit.InputsModel(
+      InputsModel = IM,
+      FUN_CRIT = FUN_CRIT,
+      RunOptions = RunOptions[[IM$id]],
+      Obs = gits[[IM$id]]$Qobs[RunOptions[[IM$id]]$IndPeriod_Run],
+      ...
+    )
+  }
+
+  return(InputsCrit)
+}

R/CreateInputsCrit.InputsModel.R

+#' Wrapper to \code{\link[airGR]{CreateInputsCrit}}
+#'
+#' @param InputsModel object of class \emph{InputsModel}, see \code{\link[airGR]{CreateInputsModel}} for details.
+#' @param FUN_CRIT \[function (atomic or list)\] error criterion function (e.g. \code{\link[airGR]{ErrorCrit_RMSE}}, \code{\link[airGR]{ErrorCrit_NSE}})
+#' @param ... further arguments passed to \code{\link[airGR]{CreateInputsCrit}}
+#'
+#' @return object of class \emph{InputsCrit} containing the data required to evaluate the model outputs. See \code{\link[airGR]{CreateInputsCrit}}
+#' @export
+CreateInputsCrit.InputsModel <- function(InputsModel,
+                                         FUN_CRIT,
+                                         ...) {
+
+  airGR::CreateInputsCrit(FUN_CRIT = FUN_CRIT,
+                          InputsModel = InputsModel,
+                          ...)
+}

R/CreateInputsCrit.R

+#' Title
+#'
+#' @param InputsModel InputsModel for GR-IWRM (See \code{[CreateInputsModel.Griwrm]}) or AirGR (See \code{\link[airGR]{CreateInputsModel}})
+#' @param ... further arguments passed to or from other methods.
+#'
+#' @return
+#' @export
+CreateInputsCrit <- function(InputsModel, ...) {
+  UseMethod("CreateInputsCrit", InputsModel)
+}

R/CreateInputsModel.Griwrm.R

@@ -8,7 +8,7 @@
 #'
 #' @return GriwrmInputsModel object equivalent to airGR InputsModel object for a semi-distributed model (See \code{\link[airGR]{CreateInputsModel}})
 #' @export
-CreateInputsModel.Griwrm <- function(x, girop, gits, verbose = TRUE,...) {
+CreateInputsModel.Griwrm <- function(x, girop, gits, verbose = TRUE, ...) {
 
   InputsModel <- CreateEmptyGriwrmInputsModel()
 

R/UpdateQsimUpstream.R

 #' Update InputsModel$QobsUpstr with simulated upstream flows provided by GriwrmOutputsModels object.
 #'
 #' @param InputsModel \emph{GriwrmInputsModel} object. See \code{[CreateInputsModel.Griwrm]}.
-#' @param OutputsModels \emph{GriwrmOutputsModel} object provided by \code{[RunModel.GriwrmInputsModel]}.
+#' @param OutputsModel \emph{GriwrmOutputsModel} object provided by \code{[RunModel.GriwrmInputsModel]}.
 #'
 #' @description This function is used by \code{\link{RunModel.GriwrmInputsModel}} and \code{\link{Calibration.GriwrmInputsModel}} in order to provide upstream simulated flows to a node.
 #'
 #' @return InputsModel object with updated QobsUpsr
 #'
-UpdateQsimUpstream <- function(InputsModel, OutputsModels) {
+UpdateQsimUpstream <- function(InputsModel, OutputsModel) {
   if(length(InputsModel$UpstreamNodes) > 0) {
     for(i in 1:length(InputsModel$UpstreamNodes)) {
       QobsUpstr1 <- matrix(
         c(
           rep(0, length(RunOptions[[InputsModel$id]]$IndPeriod_WarmUp)),
-          OutputsModels[[InputsModel$UpstreamNodes[i]]]$Qsim
+          OutputsModel[[InputsModel$UpstreamNodes[i]]]$Qsim
         ), ncol = 1
       )
       if(i == 1) {

vignettes/V01_First_network.Rmd

@@ -130,6 +130,6 @@ InputsModel <- CreateInputsModel(ginet, girop, gits)
 
 ```{r}
 dir.create("_cache", showWarnings = FALSE)
-save(ginet, girop, gits, InputsModel, file = "_cache/seine.RData")
+save(ginet, girop, gits, InputsModel, file = "_cache/V01.RData")
 ```
 

vignettes/V03_First_Calibration.Rmd

+---
+title: "03_First_Calibration"
+author: "David Dorchies"
+vignette: >
+  %\VignetteIndexEntry{Calibration of naturalised semi-distributive model}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+## Loading network and time series data
+
+Run `vignette("01_First_network", package = "griwrm")` and `vignette("02_First_run", package = "griwrm")` before this one in order to create the Rdata files loaded below:
+
+```{r}
+load("_cache/V01.RData")
+load("_cache/V02.RData")
+```
+
+## InputsCrit object
+
+```{r cars}
+InputsCrit <- CreateInputsCrit(
+  InputsModel = InputsModel, 
+  RunOptions = RunOptions, gits = gits
+)
+str(InputsCrit)
+```
+
+## GriwrmCalibOptions object
+
+```{r, eval=FALSE}
+CalibOptions <- CreateCalibOptions(InputsModel)
+str(CalibOptions)
+```
+
+## Calibration
+
+```{r}
+OutputsCalib <- Calibration(InputsModel, RunOptions, InputsCrit, CalibOptions)
+```
+
+

vignettes/v02_First_run.Rmd

@@ -25,7 +25,7 @@ library(griwrm)
 Run `vignette("01_First_network", package = "griwrm")` before this one in order to create the Rdata file loaded below:
 
 ```{r}
-load("_cache/seine.RData")
+load("_cache/V01.RData")
 ```
 
 ### Loading 
@@ -111,6 +111,12 @@ OutputsModels <- RunModel(
 )
 ```
 
+## Save data for next vignettes
+
+```{r}
+save(RunOptions, file = "_cache/V02.RData")
+```
+
 ## Plot the result for each basin
 
 ```{r, fig.height = 5, fig.width = 8}