From 8ef0f0def6387d405c8f581a1b2f1c5f6914966c Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@irstea.fr>
Date: Sat, 9 Jan 2021 18:05:36 +0100
Subject: [PATCH] fix: Single ConvertFun argument for list
- ConvertFun for InputsModel and OutputsModel are entirely defined into SeriesAggreg.list
- otherwise SeriesAggreg.list only accept a single ConvertFun to apply to all elements and sub-elements of the list
Refs #82
---
R/SeriesAggreg.InputsModel.R | 2 +-
R/SeriesAggreg.OutputsModel.R | 2 +-
R/SeriesAggreg.list.R | 58 ++++++++++++++++++++----------
man/SeriesAggreg.Rd | 2 +-
tests/testthat/test-SeriesAggreg.R | 5 ++-
5 files changed, 47 insertions(+), 22 deletions(-)
diff --git a/R/SeriesAggreg.InputsModel.R b/R/SeriesAggreg.InputsModel.R
index 4a62b4ec..37513f46 100644
--- a/R/SeriesAggreg.InputsModel.R
+++ b/R/SeriesAggreg.InputsModel.R
@@ -1,7 +1,7 @@
SeriesAggreg.InputsModel <- function(x, Format, ...) {
SeriesAggreg.list(x,
Format,
- ConvertFun = .GetAggregConvertFun(names(x), Format),
+ ConvertFun = NA,
except = c("ZLayers", "LengthHydro", "BasinAreas"),
...)
}
diff --git a/R/SeriesAggreg.OutputsModel.R b/R/SeriesAggreg.OutputsModel.R
index 27eb2ff3..3bf0d8ae 100644
--- a/R/SeriesAggreg.OutputsModel.R
+++ b/R/SeriesAggreg.OutputsModel.R
@@ -1,7 +1,7 @@
SeriesAggreg.OutputsModel <- function(x, Format, ...) {
SeriesAggreg.list(x,
Format,
- ConvertFun = .GetAggregConvertFun(names(x), Format),
+ ConvertFun = NA,
except = "StateEnd",
...)
}
diff --git a/R/SeriesAggreg.list.R b/R/SeriesAggreg.list.R
index 299bce02..c9117e92 100644
--- a/R/SeriesAggreg.list.R
+++ b/R/SeriesAggreg.list.R
@@ -12,6 +12,16 @@ SeriesAggreg.list <- function(x,
warning("deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
call. = FALSE)
}
+ # Check ConvertFun
+ if (any(class(x) %in% c("InputsModel", "OutputsModel"))) {
+ if (!all(is.na(ConvertFun))) {
+ warning("Argument 'ConvertFun' is ignored on 'InputsModel' and 'OutputsModel' objects")
+ }
+ } else if (length(ConvertFun)!=1) {
+ stop("Argument 'ConvertFun' must be of length 1 with 'list' object")
+ } else if (!is.character(ConvertFun)) {
+ stop("Argument 'ConvertFun' must be a character")
+ }
# Determination of DatesR
if (!is.null(x$DatesR)) {
@@ -59,13 +69,11 @@ SeriesAggreg.list <- function(x,
}
dfOut <- NULL
if (length(cols)) {
- ConvertFun2 <- .GetAggregConvertFun(names(cols), Format)
- if (is.null(recursive)) {
- if (missing(ConvertFun)) {
- stop("'ConvertFun' argument should provided if 'recursive = NULL'")
- } else if (!is.na(ConvertFun)) {
- ConvertFun2 <- rep(ConvertFun, length(cols))
- }
+ # Treating aggregation at root level
+ if (is.na(ConvertFun)) {
+ ConvertFun2 <- .GetAggregConvertFun(names(cols), Format)
+ } else {
+ ConvertFun2 <- rep(ConvertFun, length(cols))
}
dfOut <- SeriesAggreg(cbind(DatesR, as.data.frame(cols)),
Format,
@@ -93,17 +101,27 @@ SeriesAggreg.list <- function(x,
dfCols <- c(dfCols, x[sapply(x, inherits, "matrix")])
listCols <- listCols[setdiff(names(listCols), names(dfCols))]
if (length(listCols) > 0) {
- # Check for predefined ConvertFun for all sub-elements
- ConvertFun <- .GetAggregConvertFun(names(listCols), Format)
+ if (is.na(ConvertFun)) {
+ # Check for predefined ConvertFun for all sub-elements
+ listConvertFun <- .GetAggregConvertFun(names(listCols), Format)
+ } else {
+ listConvert
+ }
# Run SeriesAggreg for each embedded list
- listRes <- lapply(names(listCols), function(x) {
- listCols[[x]]$DatesR <- DatesR
- SeriesAggreg(listCols[[x]],
+ listRes <- lapply(names(listCols), function(y) {
+ listCols[[y]]$DatesR <- DatesR
+ if (is.na(ConvertFun)) {
+ SeriesAggreg.list(listCols[[y]],
Format = Format,
- except = except,
- ConvertFun = ConvertFun[x],
recursive = NULL,
- ...)
+ ...,
+ ConvertFun = listConvertFun[y])
+ } else {
+ SeriesAggreg.list(listCols[[y]],
+ Format = Format,
+ recursive = NULL,
+ ...)
+ }
})
names(listRes) <- names(listCols)
if (is.null(res$DatesR)) {
@@ -129,10 +147,14 @@ SeriesAggreg.list <- function(x,
"), it will be ignored in the aggregation"
)
} else {
- ConvertFun <- rep(.GetAggregConvertFun(key, Format), ncol(m))
- res[[key]] <- SeriesAggreg(data.frame(DatesR, m),
+ if (is.na(ConvertFun)) {
+ ConvertFun2 <- rep(.GetAggregConvertFun(key, Format), ncol(m))
+ } else {
+ ConvertFun2 <- rep(ConvertFun, ncol(m))
+ }
+ res[[key]] <- SeriesAggreg.data.frame(data.frame(DatesR, m),
Format = Format,
- ConvertFun = ConvertFun)
+ ConvertFun = ConvertFun2)
}
}
}
diff --git a/man/SeriesAggreg.Rd b/man/SeriesAggreg.Rd
index aa7e67fd..c402a5eb 100644
--- a/man/SeriesAggreg.Rd
+++ b/man/SeriesAggreg.Rd
@@ -62,7 +62,7 @@ Warning: on the aggregated outputs, the dates correspond to the beginning of the
\item{NewTimeFormat}{(deprecated) [character] output time step format (i.e. \code{"hourly"}, \code{"daily"}, \code{"monthly"} or \code{"yearly"}). Use the \code{Format} argument instead}
-\item{ConvertFun}{[character] names of aggregation functions (e.g. for P[mm], T[degC], Q[mm]: \code{ConvertFun = c("sum", "mean", "sum"})) (default: use the name of the column (see details) or \code{"mean"} for regime calculation)}
+\item{ConvertFun}{[character] names of aggregation functions (e.g. for P[mm], T[degC], Q[mm]: \code{ConvertFun = c("sum", "mean", "sum"})) or name of aggregation function to apply to all elements if the parameter 'x' is a [list]}
\item{YearFirstMonth}{(optional) [numeric] integer used when \code{Format = "\%Y"} to set when the starting month of the year (e.g. 01 for calendar year or 09 for hydrological year starting in September)}
diff --git a/tests/testthat/test-SeriesAggreg.R b/tests/testthat/test-SeriesAggreg.R
index 7ec93199..4d4d4907 100644
--- a/tests/testthat/test-SeriesAggreg.R
+++ b/tests/testthat/test-SeriesAggreg.R
@@ -90,7 +90,10 @@ test_that("No DatesR should warning", {
E = BasinObs$E,
Qmm = BasinObs$Qmm
)
- expect_warning(SeriesAggreg(TabSeries, "%Y%m"), regexp = "has been automatically chosen")
+ expect_warning(
+ SeriesAggreg(TabSeries, "%Y%m", ConvertFun = "sum"),
+ regexp = "has been automatically chosen"
+ )
})
test_that("Check SeriesAggreg.list 'DatesR' argument", {
--
GitLab