Merge branch '67-extract-inputsmodel-and-outputsmodel-objects' into 'dev'

Resolve "Add '['.InputsModel and '['.OutputsModel functions"

Closes #67

See merge request !24

DESCRIPTION

 Package: airGR
 Type: Package
 Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
-Version: 1.6.8.44
+Version: 1.6.9.9
 Date: 2021-01-08
 Authors@R: c(
   person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),

NAMESPACE

@@ -8,6 +8,8 @@ useDynLib(airGR, .registration = TRUE)
 #####################################
 ##            S3 methods           ##
 #####################################
+S3method('[', InputsModel)
+S3method('[', OutputsModel)
 S3method(plot, OutputsModel)
 S3method(SeriesAggreg, data.frame)
 S3method(SeriesAggreg, list)

NEWS.md

@@ -2,7 +2,7 @@
 
 
 
-### 1.6.8.44 Release Notes (2021-01-08)
+### 1.6.9.9 Release Notes (2021-01-08)
 
 #### New features
 
@@ -12,6 +12,7 @@
 - `PE_Oudin()` now presents a `RunFortran` argument to run the code in Fortran or in R. The Fortran mode is the fastest. ([#62](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/62))
 - Added `RunModel_Lag()` which allows to perform a single run for the Lag model over the test period in order to run semi-distributed GR models. ([#34](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/34))
 - Added the 'sd_model' vignette to explain how to manage the use of semi-distributed GR models. ([#34](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/34))
+- Added `[` S3 method for `InputsModel` and, `OutputsModel` class objects in order to extract subsets of them. ([#67](https://gitlab.irstea.fr/HYCAR-Hydro/airgr/-/issues/67))
 
 
 #### Deprecated and defunct

R/SeriesAggreg.list.R

@@ -6,6 +6,10 @@ SeriesAggreg.list <- function(x,
                               except = NULL,
                               recursive = TRUE,
                               ...) {
+
+  classIni <- class(x)
+  class(x) <- "list" # in order to avoid the use of '['.InputsModel' or '['.OutputsModel' when x[i] is used
+
   if (missing(Format)) {
     Format <- .GetSeriesAggregFormat(NewTimeFormat)
   } else if (!is.null(NewTimeFormat)) {
@@ -143,7 +147,7 @@ SeriesAggreg.list <- function(x,
 
     class(res) <- gsub("hourly|daily|monthly|yearly",
                        .GetSeriesAggregClass(Format),
-                       class(x))
+                       classIni)
 
     return(res)
 

R/Utils.R

@@ -11,6 +11,8 @@
 #   }
 # }
 
+
+
 ## =================================================================================
 ## function to manage Fortran outputs
 ## =================================================================================
@@ -74,3 +76,93 @@
   res <- list(GR = outGR, CN = outCN)
 
 }
+
+
+
+## =================================================================================
+## functions to extract parts of InputsModel or OutputsModel objects
+## =================================================================================
+
+## InputsModel
+
+.ExtractInputsModel <- function(x, i) {
+  res <- lapply(x, function(x) {
+    if (is.matrix(x)) {
+      res0 <- x[i, , drop = FALSE]
+    }
+    if (is.vector(x) | inherits(x, "POSIXt")) {
+      res0 <- x[i]
+    }
+    if (is.list(x) & !inherits(x, "POSIXt")) {
+      if (inherits(x, "OutputsModel")) {
+        res0 <- .ExtractOutputsModel(x = x, i = i)
+      } else {
+        res0 <- .ExtractInputsModel(x = x, i = i)
+      }
+    }
+    return(res0)
+  })
+  if (!is.null(x$ZLayers)) {
+    res$ZLayers <- x$ZLayers
+  }
+  if (inherits(x, "SD")) {
+    res$LengthHydro <- x$LengthHydro
+    res$BasinAreas  <- x$BasinAreas
+  }
+  class(res) <- class(x)
+  res
+}
+
+'[.InputsModel' <- function(x, i) {
+  if (!inherits(x, "InputsModel")) {
+    stop("'x' must be of class 'InputsModel'")
+  }
+  if (is.factor(i)) {
+    i <- as.character(i)
+  }
+  if (is.numeric(i)) {
+    .ExtractInputsModel(x, i)
+  } else {
+    NextMethod()
+  }
+}
+
+
+## InputsModel
+
+.ExtractOutputsModel <- function(x, i) {
+  res <- lapply(x, function(x) {
+    if (is.matrix(x)  && length(dim(x)) == 2L) {
+      res0 <- x[i, ]
+    }
+    if (is.array(x) && length(dim(x)) == 3L) {
+      res0 <- x[i, , ]
+    }
+    if (is.vector(x) | inherits(x, "POSIXt")) {
+      res0 <- x[i]
+    }
+    if (is.list(x) & !inherits(x, "POSIXt")) {
+      res0 <- .ExtractOutputsModel(x = x, i = i)
+    }
+    return(res0)
+  })
+  if (!is.null(x$StateEnd)) {
+    res$StateEnd <- x$StateEnd
+  }
+  class(res) <- class(x)
+  res
+}
+
+'[.OutputsModel' <- function(x, i) {
+  if (!inherits(x, "OutputsModel")) {
+    stop("'x' must be of class 'OutputsModel'")
+  }
+  if (is.factor(i)) {
+    i <- as.character(i)
+  }
+  if (is.numeric(i)) {
+    .ExtractOutputsModel(x, i)
+  } else {
+    NextMethod()
+  }
+}

man/CreateInputsModel.Rd

@@ -3,6 +3,7 @@
 
 \name{CreateInputsModel}
 \alias{CreateInputsModel}
+\alias{[.InputsModel}
 
 
 \title{Creation of the InputsModel object required to the RunModel functions}
@@ -19,6 +20,8 @@ CreateInputsModel(FUN_MOD, DatesR, Precip, PrecipScale = TRUE, PotEvap = NULL,
                   ZInputs = NULL, HypsoData = NULL, NLayers = 5,
                   Qupstream = NULL, LengthHydro = NULL, BasinAreas = NULL,
                   verbose = TRUE)
+
+\method{[}{InputsModel}(x, i)
 }
 
 
@@ -53,6 +56,9 @@ CreateInputsModel(FUN_MOD, DatesR, Precip, PrecipScale = TRUE, PotEvap = NULL,
 
 \item{BasinAreas}{(optional) [numeric] real giving the area of each upstream sub-catchment [km2] and the area of the downstream sub-catchment in the last item, required to create the SD model inputs (see details)}
 
+\item{x}{[InputsModel] object of class InputsModel}
+
+\item{i}{[integer] of the indices to subset a time series or [character] names of the elements to extract}
 }
 
 

man/RunModel.Rd

@@ -3,6 +3,7 @@
 
 \name{RunModel}
 \alias{RunModel}
+\alias{[.OutputsModel}
 
 
 \title{Run with the provided hydrological model function}
@@ -15,6 +16,8 @@ Function which performs a single model run with the provided function over the s
 
 \usage{
 RunModel(InputsModel, RunOptions, Param, FUN_MOD)
+
+\method{[}{OutputsModel}(x, i)
 }
 
 
@@ -26,6 +29,10 @@ RunModel(InputsModel, RunOptions, Param, FUN_MOD)
 \item{Param}{[numeric] vector of model parameters (See details for SD lag model)}
 
 \item{FUN_MOD}{[function] hydrological model function (e.g. \code{\link{RunModel_GR4J}}, \code{\link{RunModel_CemaNeigeGR4J}})}
+
+\item{x}{[InputsModel] object of class InputsModel}
+
+\item{i}{[integer] of the indices to subset a time series or [character] names of the elements to extract}
 }