Commit d505a801 authored by Dorchies David's avatar Dorchies David
Browse files

feat(SeriesAggreg): Add internal quantile function

Fix #82
parent 8ef0f0de
Pipeline #19005 passed with stages
in 12 minutes and 36 seconds
......@@ -51,15 +51,21 @@ SeriesAggreg.data.frame <- function(x,
if (length(ConvertFun) != (ncol(x) - 1)) {
stop(sprintf("'ConvertFun' must be of length %i (ncol(x)-1)", ncol(x) - 1))
}
listConvertFun <- lapply(unique(ConvertFun), match.fun)
listConvertFun <- lapply(unique(ConvertFun), function(y) {
if (!grepl("^q\\d+$", y, ignore.case = TRUE)) {
return(match.fun(y))
}
})
names(listConvertFun) <- unique(ConvertFun)
lapply(ConvertFun, function(y) {
TestOutput <- listConvertFun[[y]](1:10)
if(!is.numeric(TestOutput)) {
stop(sprintf("Returned value of '%s' function should be numeric", y))
}
if(length(TestOutput) != 1) {
stop(sprintf("Returned value of '%s' function should be of length 1", y))
if (!grepl("^q\\d+$", y, ignore.case = TRUE)) {
TestOutput <- listConvertFun[[y]](1:10)
if(!is.numeric(TestOutput)) {
stop(sprintf("Returned value of '%s' function should be numeric", y))
}
if(length(TestOutput) != 1) {
stop(sprintf("Returned value of '%s' function should be of length 1", y))
}
}
})
......@@ -146,10 +152,24 @@ SeriesAggreg.data.frame <- function(x,
listTsAggreg <- lapply(names(listConvertFun), function(y) {
if (any(ConvertFun == y)) {
colTsAggreg <- c("Fac2", colnames(x)[-1L][ConvertFun == y])
aggregate(. ~ Fac2,
data = TabSeries2[, colTsAggreg],
FUN = listConvertFun[[y]],
na.action = na.pass)
if (grepl("^q\\d+$", y, ignore.case = TRUE)) {
probs <- as.numeric(gsub("^q", "", y, ignore.case = TRUE)) / 100
if (probs < 0 || probs > 1) {
stop("'Q...' format of argument 'ConvertFun' must be an integer between 0 and 100")
}
aggregate(. ~ Fac2,
data = TabSeries2[, colTsAggreg],
FUN = quantile,
na.action = na.pass,
probs = probs,
type = 8,
na.rm = TRUE)
} else {
aggregate(. ~ Fac2,
data = TabSeries2[, colTsAggreg],
FUN = listConvertFun[[y]],
na.action = na.pass)
}
} else {
NULL
}
......
......@@ -104,8 +104,6 @@ SeriesAggreg.list <- function(x,
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(y) {
......
......@@ -25,6 +25,11 @@ Warning: on the aggregated outputs, the dates correspond to the beginning of the
\code{\link{SeriesAggreg.InputsModel}} and \code{\link{SeriesAggreg.OutputsModel}}
call \code{\link{SeriesAggreg.list}} which itself calls \code{\link{SeriesAggreg.data.frame}}.
So, all arguments passed to any \code{\link{SeriesAggreg}} method will be passed to \code{\link{SeriesAggreg.data.frame}}.
Argument \code{ConvertFun} also supports quantile calculation by using the syntax "Q[nn]" with [nn] the requested percentile.
E.g. use "Q90" for calculating 90th percentile in the aggregation.
The formula used is: \code{quantile(x, probs = perc / 100, type = 8, na.rm = TRUE)}.
}
......@@ -62,7 +67,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"})) or name of aggregation function to apply to all elements if the parameter 'x' is a [list]}
\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] (See details)}
\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)}
......@@ -77,7 +82,6 @@ Warning: on the aggregated outputs, the dates correspond to the beginning of the
\item{\dots}{Arguments passed to \code{\link{SeriesAggreg.list}} and then to \code{\link{SeriesAggreg.data.frame}}}
}
\value{
[POSIXct+numeric] data.frame containing a vector of aggregated dates (POSIXct) and time series values numeric)
}
......
......@@ -233,3 +233,19 @@ test_that("SeriesAggreg should work with ConvertFun 'min', 'max' and 'median'",
}
lapply(c("max", "min", "median"), function(x) {test_ConvertFunRegime(Qls, x, "%Y")})
})
test_that("Error on convertFun Q without 0-100", {
Qls <- BasinObs[, c("DatesR", "Qls")]
expect_error(SeriesAggreg(Qls, "%Y", "q101"))
expect_error(SeriesAggreg(Qls, "%Y", "q-2"))
expect_error(SeriesAggreg(Qls, "%Y", "q12.5"))
})
test_that("ConvertFun q50 should be equal to median", {
Qls <- BasinObs[, c("DatesR", "Qls")]
expect_equal(SeriesAggreg(Qls, "%Y", "q50"),
SeriesAggreg(Qls, "%Y", "median"))
expect_equal(SeriesAggreg(Qls, "%Y", "q50"),
SeriesAggreg(Qls, "%Y", "q050"))
})
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