Commit 4c8bf21b authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

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

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

Closes #67

See merge request !24
parents b7316fed b1fcddef
Pipeline #19029 passed with stages
in 12 minutes and 33 seconds
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")),
......
......@@ -8,6 +8,8 @@ useDynLib(airGR, .registration = TRUE)
#####################################
## S3 methods ##
#####################################
S3method('[', InputsModel)
S3method('[', OutputsModel)
S3method(plot, OutputsModel)
S3method(SeriesAggreg, data.frame)
S3method(SeriesAggreg, list)
......
......@@ -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
......
......@@ -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)
......
......@@ -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()
}
}
......@@ -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}
}
......
......@@ -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}
}
......
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