feat: seemless integration of airGR into airGRiwrm

- import airGR with "Depends"
- remove all library(airGR) and airGR::FUN

Closes #63

.Rbuildignore

@@ -11,3 +11,4 @@
 ^pkgdown
 ^docs
 ^vignettes/seinebasin$
+^man-roxygen$

DESCRIPTION

@@ -16,8 +16,7 @@ Imports:
     dplyr,
     utils,
     grDevices,
-    graphics,
-    airGR (>= 1.6.12.9001)
+    graphics
 Suggests:
     knitr,
     rmarkdown,
@@ -29,6 +28,7 @@ VignetteBuilder: knitr
 URL: https://airgriwrm.g-eau.fr/
 BugReports: https://gitlab.irstea.fr/in-wop/airGRiwrm/-/issues/
 Depends:
-    R (>= 2.10)
+    R (>= 2.10),
+    airGR (>= 1.6.12.9001)
 Remotes:
     url::https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/archive/dev/airgr-dev.zip

NAMESPACE

@@ -5,14 +5,18 @@ S3method(Calibration,InputsModel)
 S3method(ConvertMeteoSD,GRiwrm)
 S3method(ConvertMeteoSD,character)
 S3method(ConvertMeteoSD,matrix)
+S3method(CreateCalibOptions,"function")
 S3method(CreateCalibOptions,GRiwrmInputsModel)
 S3method(CreateCalibOptions,InputsModel)
+S3method(CreateCalibOptions,character)
 S3method(CreateInputsCrit,GRiwrmInputsModel)
 S3method(CreateInputsCrit,InputsModel)
 S3method(CreateInputsModel,GRiwrm)
 S3method(CreateInputsModel,default)
+S3method(CreateRunOptions,"function")
 S3method(CreateRunOptions,GRiwrmInputsModel)
 S3method(CreateRunOptions,InputsModel)
+S3method(CreateRunOptions,character)
 S3method(RunModel,GR)
 S3method(RunModel,GRiwrmInputsModel)
 S3method(RunModel,InputsModel)

R/Calibration.GRiwrmInputsModel.R

@@ -78,6 +78,7 @@ Calibration.GRiwrmInputsModel <- function(InputsModel,
 #' @param InputsCrit \[InputsCritLavenneFunction\] object internally created by [CreateInputsCrit.GRiwrmInputsModel]
 #'
 #' @return \[InputsCrit\] object with De Lavenne regularisation
+#' @import airGR
 #' @noRd
 #'
 getInputsCrit_Lavenne <- function(id, OutputsModel, InputsCrit) {

R/Calibration.InputsModel.R

 #' @rdname Calibration
 #' @export
 Calibration.InputsModel <- function(InputsModel, ...) {
-  airGR::Calibration(InputsModel, FUN_MOD = InputsModel$FUN_MOD, ...)
+  if (!exists("FUN_MOD") && !is.null(InputsModel$FUN_MOD)) {
+    airGR::Calibration(InputsModel, FUN_MOD = InputsModel$FUN_MOD, ...)
+  } else {
+    airGR::Calibration(InputsModel, ...)
+  }
 }

R/CreateCalibOptions.GRiwrmInputsModel.R

 #' @rdname CreateCalibOptions
 #' @export
-CreateCalibOptions.GRiwrmInputsModel <- function(InputsModel, ...) {
+CreateCalibOptions.GRiwrmInputsModel <- function(x, ...) {
 
   CalibOptions <- list()
   class(CalibOptions) <- c("GRiwrmCalibOptions", class(CalibOptions))
 
-  for(IM in InputsModel) {
-    CalibOptions[[IM$id]] <- CreateCalibOptions.InputsModel(
-      InputsModel = IM,
+  for(IM in x) {
+    CalibOptions[[IM$id]] <- CreateCalibOptions(
+      IM,
       ...
     )
   }

R/CreateCalibOptions.InputsModel.R

-#' @rdname CreateCalibOptions
-#' @export
-CreateCalibOptions.InputsModel <- function(InputsModel,
-                               ...) {
-  airGR::CreateCalibOptions(
-    FUN_MOD = InputsModel$FUN_MOD,
-    IsSD = !is.null(InputsModel$Qupstream),
-    ...
-  )
-}

R/CreateCalibOptions.R

@@ -2,7 +2,7 @@
 #'
 #' This function can be used either for a catchment (with an \emph{InputsModel} object) or for a network (with a \emph{GRiwrmInputsModel} object)
 #'
-#' @param InputsModel object of class \emph{InputsModel} or \emph{GRiwrmInputsModel}. See [CreateInputsModel] for details
+#' @template param_x
 #' @param ... arguments passed to [airGR::CreateCalibOptions], see details
 #'
 #' @details See [airGR::CreateCalibOptions] documentation for a complete list of arguments.
@@ -15,6 +15,43 @@
 #'
 #' @rdname CreateCalibOptions
 #' @export
-CreateCalibOptions <- function(InputsModel, ...) {
-  UseMethod("CreateCalibOptions", InputsModel)
+CreateCalibOptions <- function(x, ...) {
+  UseMethod("CreateCalibOptions", x)
+}
+
+#' @rdname CreateCalibOptions
+#' @export
+CreateCalibOptions.InputsModel <- function(x,
+                                           ...) {
+  if (!exists("FUN_MOD") && !is.null(x$FUN_MOD)) {
+    airGR::CreateCalibOptions(
+      FUN_MOD = x$FUN_MOD,
+      IsSD = !is.null(x$Qupstream),
+      ...
+    )
+  } else {
+    airGR::CreateCalibOptions(
+      ...
+    )
+  }
+}
+
+#' @rdname CreateCalibOptions
+#' @export
+CreateCalibOptions.character <- function(x,
+                                           ...) {
+  airGR::CreateCalibOptions(
+    FUN_MOD = x,
+    ...
+  )
+}
+
+#' @rdname CreateCalibOptions
+#' @export
+CreateCalibOptions.function <- function(x,
+                                         ...) {
+  airGR::CreateCalibOptions(
+    FUN_MOD = x,
+    ...
+  )
 }

R/CreateGRiwrm.R

@@ -21,28 +21,7 @@
 #'
 #' @aliases GRiwrm
 #' @export
-#' @examples
-#' ###################################################################
-#' # Run the `airGR::RunModel_Lag` example in the GRiwrm fashion way #
-#' ###################################################################
-#'
-#' # Run the airGR RunModel_Lag example for harvesting the necessary data
-#' library(airGR)
-#' example(RunModel_Lag)
-#' # detach the package because otherwise airGR overwrites the airGRiwrm functions
-#' detach("package:airGR")
-#'
-#' # This example is a network of 2 nodes which can be described like this:
-#' db <- data.frame(id = c("Reservoir", "GaugingDown"),
-#'                  length = c(LengthHydro, NA),
-#'                  down = c("GaugingDown", NA),
-#'                  area = c(NA, BasinInfo$BasinArea),
-#'                  model = c(NA, "RunModel_GR4J"),
-#'                  stringsAsFactors = FALSE)
-#'
-#' # Create GRiwrm object from the data.frame
-#' griwrm <- CreateGRiwrm(db)
-#' str(griwrm)
+#' @inherit RunModel.GRiwrmInputsModel return examples
 #'
 CreateGRiwrm <- function(db,
                    cols = list(

R/CreateInputsCrit.GRiwrmInputsModel.R

 #' @rdname CreateInputsCrit
+#' @import airGR
 #' @export
 CreateInputsCrit.GRiwrmInputsModel <- function(InputsModel,
-                                               FUN_CRIT = airGR::ErrorCrit_NSE,
+                                               FUN_CRIT = ErrorCrit_NSE,
                                                RunOptions,
                                                Obs,
                                                AprioriIds = NULL,

R/CreateInputsModel.GRiwrm.R

@@ -20,47 +20,7 @@
 #'
 #' @return A \emph{GRiwrmInputsModel} object which is a list of \emph{InputsModel} objects created by [airGR::CreateInputsModel] with one item per modelled sub-catchment.
 #' @export
-#' @examples
-#' ##################################################################
-#' # Run the `airGR RunModel_Lag` example in the GRiwrm fashion way #
-#' ##################################################################
-#'
-#' # Run the airGR RunModel_Lag example for harvesting necessary data
-#' library(airGR)
-#' example(RunModel_Lag)
-#' # detach the package because otherwise airGR overwrites the airGRiwrm functions
-#' detach("package:airGR")
-#'
-#' # This example is a network of 2 nodes which can be described like this:
-#' db <- data.frame(id = c("Reservoir", "GaugingDown"),
-#'                  length = c(LengthHydro, NA),
-#'                  down = c("GaugingDown", NA),
-#'                  area = c(NA, BasinInfo$BasinArea),
-#'                  model = c(NA, "RunModel_GR4J"),
-#'                  stringsAsFactors = FALSE)
-#'
-#' # Create GRiwrm object from the data.frame
-#' griwrm <- CreateGRiwrm(db)
-#' str(griwrm)
-#'
-#' # Formatting observations for the hydrological models
-#' # Each input data should be a matrix or a data.frame with the correct id as the column name
-#' Precip <- matrix(BasinObs$P, ncol = 1)
-#' colnames(Precip) <- "GaugingDown"
-#' PotEvap <- matrix(BasinObs$E, ncol = 1)
-#' colnames(PotEvap) <- "GaugingDown"
-#'
-#' # Observed flows should at least contains flows that are directly injected in the model
-#' Qobs = matrix(Qupstream, ncol = 1)
-#' colnames(Qobs) <- "Reservoir"
-#' str(Qobs)
-#'
-#' InputsModels <- CreateInputsModel(griwrm,
-#'                             DatesR = BasinObs$DatesR,
-#'                             Precip = Precip,
-#'                             PotEvap = PotEvap,
-#'                             Qobs = Qobs)
-#' str(InputsModels)
+#' @inherit RunModel.GRiwrmInputsModel return examples
 #'
 CreateInputsModel.GRiwrm <- function(x, DatesR,
                                      Precip = NULL,

R/CreateInputsModel.R

@@ -6,7 +6,17 @@
 #' @param ... further arguments passed to or from other methods.
 #'
 #' @return InputsModel or GRiwrmInputsObject object
+#' @rdname CreateInputsModel
+#' @import airGR
 #' @export
 CreateInputsModel <- function(x, ...) {
   UseMethod("CreateInputsModel", x)
 }
+
+#' @rdname CreateInputsModel
+#' @export
+CreateInputsModel.default <- function(x,
+                                      ...) {
+
+  airGR::CreateInputsModel(FUN_MOD = x, ...)
+}

R/CreateInputsModel.default.R

-#' Wrapper for [airGR::CreateInputsModel] for one sub-basin
-#'
-#' @param x [function] hydrological model function (e.g. [airGR::RunModel_GR4J]...)
-#' @param ... arguments passed to [airGR::CreateInputsModel]
-#' @import airGR
-#' @export
-#'
-CreateInputsModel.default <- function(x,
-                                      ...) {
-
-  airGR::CreateInputsModel(FUN_MOD = x, ...)
-}

R/CreateRunOptions.GRiwrmInputsModel.R

 #' @param IniStates (optional) [numeric] object or [list] of [numeric] object of class \emph{IniStates}, see [airGR::CreateIniStates] for details
 #' @rdname CreateRunOptions
 #' @export
-CreateRunOptions.GRiwrmInputsModel <- function(InputsModel, IniStates = NULL, ...) {
+CreateRunOptions.GRiwrmInputsModel <- function(x, IniStates = NULL, ...) {
 
   RunOptions <- list()
   class(RunOptions) <- append(class(RunOptions), "GRiwrmRunOptions")
 
-  for(id in names(InputsModel)) {
-    RunOptions[[id]] <- CreateRunOptions(InputsModel = InputsModel[[id]], IniStates = IniStates[[id]], ...)
+  for(id in names(x)) {
+    RunOptions[[id]] <- CreateRunOptions(x[[id]], IniStates = IniStates[[id]], ...)
   }
   return(RunOptions)
 }

R/CreateRunOptions.InputsModel.R

-#' @rdname CreateRunOptions
-#' @export
-CreateRunOptions.InputsModel <- function(InputsModel, ...) {
-
-  airGR::CreateRunOptions(FUN_MOD = InputsModel$FUN_MOD,
-                          InputsModel = InputsModel,
-                          ...)
-}

R/CreateRunOptions.R

@@ -2,7 +2,7 @@
 #'
 #' This function can be used either for a catchment (with an \emph{InputsModel} object) or for a network (with a \emph{GRiwrmInputsModel} object)
 #'
-#' @param InputsModel object of class \emph{InputsModel} or \emph{GRiwrmInputsModel}. See [CreateInputsModel] for details
+#' @template param_x
 #' @param ... arguments passed to [airGR::CreateRunOptions], see details
 #'
 #' @details See [airGR::CreateRunOptions] documentation for a complete list of arguments.
@@ -18,6 +18,35 @@
 #' @rdname CreateRunOptions
 #' @export
 #' @inherit RunModel.GRiwrmInputsModel return examples
-CreateRunOptions <- function(InputsModel, ...) {
-  UseMethod("CreateRunOptions", InputsModel)
+CreateRunOptions <- function(x, ...) {
+  UseMethod("CreateRunOptions", x)
+}
+
+#' @rdname CreateRunOptions
+#' @export
+CreateRunOptions.InputsModel <- function(x, ...) {
+  if (!exists("FUN_MOD") && !is.null(x$FUN_MOD)) {
+    airGR::CreateRunOptions(FUN_MOD = x$FUN_MOD,
+                            InputsModel = x,
+                            ...)
+  } else {
+    airGR::CreateRunOptions(InputsModel = x,
+                            ...)
+  }
+}
+
+#' @rdname CreateRunOptions
+#' @export
+CreateRunOptions.character <- function(x, ...) {
+
+  airGR::CreateRunOptions(FUN_MOD = x,
+                          ...)
+}
+
+#' @rdname CreateRunOptions
+#' @export
+CreateRunOptions.function <- function(x, ...) {
+
+  airGR::CreateRunOptions(FUN_MOD = x,
+                          ...)
 }

R/CreateSupervisor.R

@@ -14,7 +14,6 @@
 #' @examples
 #' data(Severn)
 #' nodes <- Severn$BasinsInfo[, c("gauge_id", "downstream_id", "distance_downstream", "area")]
-#' nodes$distance_downstream <- nodes$distance_downstream * 1000 # Conversion km -> m
 #' nodes$model <- "RunModel_GR4J"
 #' griwrm <- CreateGRiwrm(nodes,
 #'                  list(id = "gauge_id",

R/RunModel.GR.R

 #' Run of a rainfall-runoff model on a sub-basin
 #'
-#' @inherit airGR::RunModel
 #' @param x \[object of class `InputsModel`\] `InputsModel` for [airGR::RunModel]
+#' @param RunOptions \[object of class *RunOptions*\] see [airGR::CreateRunOptions] for details
+#' @param Param [numeric] vector of model parameters (See details for SD lag model)
 #' @param ... further arguments passed to or from other methods
 #'
+#' @inherit airGR::RunModel description details return
 #' @export
 #'
 RunModel.GR <- function(x, RunOptions, Param, ...) {

R/RunModel.GRiwrmInputsModel.R

@@ -8,15 +8,36 @@
 #' @return [[list] of class \emph{GRiwrmOutputsModel}] list of \emph{OutputsModel} objects (See \[airGR::RunModel]) for each node of the semi-distributed model
 #' @export
 #' @examples
-#' #################################################################
-#' # Run the `airGRRunModel_Lag` example in the GRiwrm fashion way #
-#' #################################################################
+#' ###################################################################
+#' # Run the `airGR::RunModel_Lag` example in the GRiwrm fashion way #
+#' # Simulation of a reservoir with a purpose of low-flow mitigation #
+#' ###################################################################
 #'
-#' # Run the airGR RunModel_Lag example for harvesting necessary data
-#' library(airGR)
-#' example(RunModel_Lag)
-#' # detach the package because otherwise airGR overwrites the airGRiwrm functions
-#' detach("package:airGR")
+#' ## ---- preparation of the InputsModel object
+#'
+#' ## loading package and catchment data
+#' library(airGRiwrm)
+#' data(L0123001)
+#'
+#' ## ---- specifications of the reservoir
+#'
+#' ## the reservoir withdraws 1 m3/s when it's possible considering the flow observed in the basin
+#' Qupstream <- matrix(-sapply(BasinObs$Qls / 1000 - 1, function(x) {
+#'   min(1, max(0, x, na.rm = TRUE))
+#' }), ncol = 1)
+#'
+#' ## except between July and September when the reservoir releases 3 m3/s for low-flow mitigation
+#' month <- as.numeric(format(BasinObs$DatesR, "%m"))
+#' Qupstream[month >= 7 & month <= 9] <- 3
+#' Qupstream <- Qupstream * 86400 ## Conversion in m3/day
+#'
+#' ## the reservoir is not an upstream subcachment: its areas is NA
+#' BasinAreas <- c(NA, BasinInfo$BasinArea)
+#'
+#' ## delay time between the reservoir and the catchment outlet is 2 days and the distance is 150 km
+#' LengthHydro <- 150
+#' ## with a delay of 2 days for 150 km, the flow velocity is 75 km per day
+#' Velocity <- (LengthHydro * 1e3 / 2) / (24 * 60 * 60) ## Conversion km/day -> m/s
 #'
 #' # This example is a network of 2 nodes which can be describe like this:
 #' db <- data.frame(id = c("Reservoir", "GaugingDown"),
@@ -37,12 +58,9 @@
 #' PotEvap <- matrix(BasinObs$E, ncol = 1)
 #' colnames(PotEvap) <- "GaugingDown"
 #'
-#' # Observed flows are integrated now because we mix:
-#' #  - flows that are directly injected in the model
-#' #  - flows that could be used for the calibration of the hydrological models
-#' Qobs = matrix(c(Qupstream, BasinObs$Qmm), ncol = 2)
-#' colnames(Qobs) <- griwrm$id
-#' str(Qobs)
+#' # Observed flows contain flows that are directly injected in the model
+#' Qobs = matrix(Qupstream, ncol = 1)
+#' colnames(Qobs) <- "Reservoir"
 #'
 #' # Creation of the GRiwrmInputsModel object (= a named list of InputsModel objects)
 #' InputsModels <- CreateInputsModel(griwrm,
@@ -52,22 +70,27 @@
 #'                             Qobs = Qobs)
 #' str(InputsModels)
 #'
+#' ## run period selection
+#' 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"))
+#'
 #' # Creation of the GriwmRunOptions object
-#' RunOptions2 <- CreateRunOptions(InputsModels,
+#' RunOptions <- CreateRunOptions(InputsModels,
 #'                                 IndPeriod_Run = Ind_Run)
-#' str(RunOptions2)
+#' str(RunOptions)
 #'
 #' # Parameters of the SD models should be encapsulated in a named list
-#' Param2 <- list(`GaugingDown` = c(Velocity, Param))
+#' ParamGR4J <- c(X1 = 257.238, X2 = 1.012, X3 = 88.235, X4 = 2.208)
+#' Param <- list(`GaugingDown` = c(Velocity, ParamGR4J))
 #'
 #' # RunModel for the whole network
 #' OutputsModels <- RunModel(InputsModels,
-#'                           RunOptions = RunOptions2,
-#'                           Param = Param2)
+#'                           RunOptions = RunOptions,
+#'                           Param = Param)
 #' str(OutputsModels)
 #'
-#' # Comparison between GRiwrm simulation and airGR simulation
-#' plot(OutputsModels, Qobs = data.frame(`GaugingDown` = OutputsModel$Qsim))
+#' # Compare Simulation with reservoir and observation of natural flow
+#' plot(OutputsModels, data.frame(GaugingDown = BasinObs$Qmm[Ind_Run]))
 RunModel.GRiwrmInputsModel <- function(x, RunOptions, Param, ...) {
 
   checkRunModelParameters(x, RunOptions, Param)

man-roxygen/param_x.R

+#' @param x [function], [character], or object of class \emph{InputsModel} runs [airGR::CreateRunOptions]for a catchment. Use object of class \emph{GRiwrmInputsModel} for a network. See [CreateInputsModel] for details
+#'