v1.6.9.0 feat(S3): '[' S3 method for InputsModel and OutputsModel classes

Refs #67

DESCRIPTION

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

NEWS.md

@@ -2,7 +2,7 @@
 
 
 
-### 1.6.8.44 Release Notes (2021-01-08)
+### 1.6.9.0 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/Utils.R

@@ -11,6 +11,8 @@
 #   }
 # }
 
+
+
 ## =================================================================================
 ## function to manage Fortran outputs
 ## =================================================================================
@@ -74,3 +76,77 @@
   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, ]
+    }
+    if (is.vector(x) | inherits(x, "POSIXt")) {
+      res0 <- x[i]
+    }
+    if (is.list(x) & !inherits(x, "POSIXt")) {
+      res0 <- .ExtractInputsModel(x = x, i = i)
+    }
+    return(res0)
+  })
+  if (!is.null(x$ZLayers)) {
+    res$ZLayers <- x$ZLayers
+  }
+  class(res) <- class(x)
+  res
+}
+
+'[.InputsModel' <- function(x, i) {
+  if (!inherits(x, "InputsModel")) {
+    stop("'x' must be of class 'InputsModel'")
+  }
+  .ExtractInputsModel(x, i)
+}
+
+
+## InputsModel
+
+.ExtractOutputsModel <- function(x, i) {
+  IsStateEnd <- !is.null(x$StateEnd)
+  if (IsStateEnd) {
+    IsStateEnd <- TRUE
+    StateEnd <- x$StateEnd
+    x$StateEnd <- NULL
+  }
+  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 (IsStateEnd) {
+    res$StateEnd <- StateEnd
+  }
+  class(res) <- class(x)
+  res
+}
+
+'[.OutputsModel' <- function(x, i) {
+  if (!inherits(x, "OutputsModel")) {
+    stop("'x' must be of class 'OutputsModel'")
+  }
+  .ExtractOutputsModel(x, i)
+}