From 3f08d613c36cb70a71e3cbb2676815713287fdc4 Mon Sep 17 00:00:00 2001 From: Delaigue Olivier <olivier.delaigue@irstea.fr> Date: Fri, 8 Jan 2021 06:36:08 +0100 Subject: [PATCH] v1.6.9.0 feat(S3): '[' S3 method for InputsModel and OutputsModel classes Refs #67 --- DESCRIPTION | 2 +- NEWS.md | 3 ++- R/Utils.R | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 79 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 09f5f69e..0e841ee6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ 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")), diff --git a/NEWS.md b/NEWS.md index b9d37506..72be2a43 100644 --- a/NEWS.md +++ b/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 diff --git a/R/Utils.R b/R/Utils.R index d1cde5eb..b30a9e08 100644 --- a/R/Utils.R +++ b/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) +} -- GitLab