feat(SeriesAggreg): Add internal quantile function

Fix #82

R/SeriesAggreg.data.frame.R

@@ -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
     }

R/SeriesAggreg.list.R

@@ -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) {

man/SeriesAggreg.Rd

@@ -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)
 }

tests/testthat/test-SeriesAggreg.R

@@ -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"))
+})
+