Commit 3f08d613 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

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

Refs #67
parent b7316fed
Pipeline #18970 canceled with stages
in 34 seconds
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")),
......
......@@ -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
......
......@@ -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)
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment