Commit 1c50513a authored by Dorchies David's avatar Dorchies David
Browse files

v1.6.8.10 refactor: Replace SeriesAggreg2.default by SeriesAggreg2.list

- Move `SeriesAggreg2.data.frame` to its own source file
- Simplification of methods argument lists
- Update `SeriesAggreg2` documentation

Refs #41
parent f60e0203
Pipeline #17741 passed with stages
in 11 minutes and 25 seconds
......@@ -4,3 +4,5 @@
^packrat/
^tests/tmp/
^\.regressionignore$
^\.gitlab-ci\.yml$
^\.vscode$
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.8.9
Version: 1.6.8.10
Date: 2020-11-20
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
......@@ -10,7 +10,7 @@ useDynLib(airGR, .registration = TRUE)
#####################################
S3method("plot", "OutputsModel")
S3method("SeriesAggreg2", "data.frame")
S3method("SeriesAggreg2", "default")
S3method("SeriesAggreg2", "list")
S3method("SeriesAggreg2", "InputsModel")
S3method("SeriesAggreg2", "OutputsModel")
......@@ -52,6 +52,7 @@ export(RunModel_GR6J)
export(RunModel_Lag)
export(SeriesAggreg)
export(SeriesAggreg2)
export(SeriesAggreg2.list)
export(SeriesAggreg2.data.frame)
export(SeriesAggreg2.InputsModel)
export(SeriesAggreg2.OutputsModel)
......
......@@ -2,17 +2,12 @@
### 1.6.8.8 Release Notes (2020-11-20)
### 1.6.8.10 Release Notes (2020-11-21)
#### New features
- Added <code>SeriesAggreg2</code> method.
- Added <code>SeriesAggreg2.default()</code> function.
- Added <code>SeriesAggreg2.InputsModel()</code> function.
- Added <code>SeriesAggreg2.OutputsModel()</code> function.
- Added <code>SeriesAggreg2.data.frame()</code> function. This new verson of the <code>SeriesAggreg()</code> function allows to compute regimes.
- Added<code>.AggregConvertFun()</code> private function in order to choose automatically the <code>ConvertFun</code> to apply on each element of <code>InputsModel</code> and <code>OutputsModel</code> ojects.
- Added <code>SeriesAggreg2</code> S3 method with functions for `InputsModel`, `OutputsModel`, `list`, `data.frame` class objects. This new version of the <code>SeriesAggreg()</code> function allows to compute regimes.
- Added<code>.AggregConvertFun()</code> private function in order to choose automatically the <code>ConvertFun</code> to apply on each element of <code>InputsModel</code> and <code>OutputsModel</code> objects.
#### Bug fixes
......
SeriesAggreg2.InputsModel <- function(TabSeries,
Format,
TimeFormat = NULL,
NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, ..., simplify = FALSE) {
SeriesAggreg2.InputsModel <- function(TabSeries, Format, ...) {
if (!inherits(TabSeries, "InputsModel")) {
stop("to be used with 'InputsModel' object")
}
res <- SeriesAggreg2.default(TabSeries = TabSeries,
Format = Format,
TimeFormat = TimeFormat,
NewTimeFormat = NewTimeFormat,
YearFirstMonth = YearFirstMonth, TimeLag = TimeLag,
verbose = verbose,
simplify = simplify)
res <- SeriesAggreg2.list(TabSeries = TabSeries, Format, ...)
if (inherits(TabSeries, "CemaNeige")) {
res$ZLayers <- TabSeries$ZLayers
......
SeriesAggreg2.OutputsModel <- function(TabSeries,
Format,
TimeFormat,
NewTimeFormat,
YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, ..., simplify = FALSE) {
SeriesAggreg2.OutputsModel <- function(TabSeries, Format, ...) {
if (!inherits(TabSeries, "OutputsModel")) {
stop("to be used with 'OutputsModel' object")
}
res <- SeriesAggreg2.default(TabSeries = TabSeries,
Format = Format,
TimeFormat = TimeFormat,
NewTimeFormat = NewTimeFormat,
YearFirstMonth = YearFirstMonth, TimeLag = TimeLag,
verbose = verbose,
simplify = simplify)
res <- SeriesAggreg2.list(TabSeries, Format, ...)
res$StateEnd <- TabSeries$StateEnd
return(res)
}
\ No newline at end of file
SeriesAggreg2 <- function(TabSeries,
Format, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE,
...) {
SeriesAggreg2 <- function(TabSeries, Format, ...) {
UseMethod("SeriesAggreg2")
}
SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, verbose = TRUE, ..., ConvertFun) {
## Arguments checks
if (!is.null(TimeFormat)) {
warning("deprecated 'TimeFormat' argument", call. = FALSE)
}
if (!is.null(NewTimeFormat)) {
if (missing(Format)) {
TimeStep <- c("hourly", "daily", "monthly", "yearly")
NewTimeFormat <- match.arg(NewTimeFormat, choices = TimeStep)
Format <- switch(NewTimeFormat,
hourly = "%Y%m%d%h",
daily = "%Y%m%d",
monthly = "%Y%m",
yearly = "%Y")
msgNewTimeFormat <- sprintf(" 'Format' automatically set to %s", sQuote(Format))
} else {
msgNewTimeFormat <- NULL
}
warning("deprecated 'NewTimeFormat' argument: please use 'Format' instead.",
msgNewTimeFormat, call. = FALSE)
}
## check TabSeries
if (!is.data.frame(TabSeries)) {
stop("'TabSeries' must be a data.frame containing the dates and data to be aggregated")
}
if (ncol(TabSeries) < 2) {
stop("'TabSeries' must contain at least two columns (including the column of dates)")
}
## check TabSeries date column
if (!inherits(TabSeries[[1L]], "POSIXt")) {
stop("'TabSeries' first column must be a vector of class 'POSIXlt' or 'POSIXct'")
}
if (inherits(TabSeries[[1L]], "POSIXlt")) {
TabSeries[[1L]] <- as.POSIXct(TabSeries[[1L]])
}
## check TabSeries other columns (boolean converted to numeric)
apply(TabSeries[, -1L, drop = FALSE], MARGIN = 2, FUN = function(iCol) {
if (!is.numeric(iCol)) {
stop("'TabSeries' columns (other than the first one) must be of numeric class")
}
})
## check Format
listFormat <- c("%Y%m%d", "%Y%m", "%Y", "%m", "%d")
Format <- gsub(pattern = "[[:punct:]]+", replacement = "%", Format)
Format <- match.arg(Format, choices = listFormat)
## check ConvertFun
listConvertFun <- c("sum", "mean")
ConvertFun <- listConvertFun[match(ConvertFun, listConvertFun)]
if (anyNA(ConvertFun)) {
stop("'ConvertFun' should be a one of 'sum' or 'mean'")
}
if (length(ConvertFun) != (ncol(TabSeries) - 1)) {
stop(
sprintf("'ConvertFun' must be of length %i (ncol(TabSeries)-1)", ncol(TabSeries) - 1)
)
}
## check YearFirstMonth
msgYearFirstMonth <- "'YearFirstMonth' should be a single vector of numeric value between 1 and 12"
YearFirstMonth <- match(YearFirstMonth, 1:12)
if (anyNA(YearFirstMonth)) {
stop(msgYearFirstMonth)
}
if (length(YearFirstMonth) != 1) {
stop(msgYearFirstMonth)
}
if (YearFirstMonth != 1 & Format != "%Y") {
warning("'YearFirstMonth' is ignored beacause Format != '%Y'")
}
## check TimeLag
msgTimeLag <- "'TimeLag' should be a single vector of a positive numeric value"
if (!is.vector(TimeLag)) {
stop(msgTimeLag)
}
if (!is.numeric(TimeLag)) {
stop(msgTimeLag)
}
if (length(TimeLag) != 1 | !any(TimeLag >= 0)) {
stop(msgTimeLag)
}
TabSeries0 <- TabSeries
colnames(TabSeries0)[1L] <- "DatesR"
TabSeries0$DatesR <- TabSeries0$DatesR + TimeLag
TabSeries2 <- TabSeries0
if (!Format %in% c("%d", "%m")) {
start <- sprintf("%i-01-01 00:00:00", as.numeric(format(TabSeries2$DatesR[1L], format = "%Y"))-1)
stop <- sprintf("%i-12-31 00:00:00", as.numeric(format(TabSeries2$DatesR[nrow(TabSeries2)], format = "%Y"))+1)
by <- ifelse(grepl("hours", format(diff(TabSeries$DatesR[1:2]))), yes = "hours", no = "days")
fakeTs <- data.frame(DatesR = seq(from = as.POSIXct(start, tz = "UTC"),
to = as.POSIXct(stop , tz = "UTC"),
by = by) + TimeLag)
TabSeries2 <- merge(fakeTs, TabSeries2, by = "DatesR", all.x = TRUE)
}
TabSeries2$DatesRini <- TabSeries2$DatesR %in% TabSeries0$DatesR
TabSeries2$Selec2 <- format(TabSeries2$DatesR, Format)
if (nchar(Format) > 2 | Format == "%Y") {
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
if (all(TabSeries2$Selec)) {
warning("the requested time 'Format' is the same as the one in 'TabSeries'. No time-step conversion was performed")
return(TabSeries)
}
if (Format == "%Y") {
yfm <- sprintf("%02.f", YearFirstMonth)
spF1 <- "%m"
spF2 <- "%Y-%m"
TabSeries2$Selec1 <- format(TabSeries2$DatesR, spF1)
TabSeries2$Selec2 <- format(TabSeries2$DatesR, spF2)
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2) & TabSeries2$Selec1 == yfm
}
TabSeries2$Fac2 <- cumsum(TabSeries2$Selec)
} else {
if (Format == "%d") {
spF2 <- "%m-%d"
TabSeries2$Selec2 <- format(TabSeries2$DatesR, spF2)
}
TabSeries2$Fac2 <- TabSeries2$Selec2
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
}
if ("mean" %in% ConvertFun) {
colTsAggregMean <- c("Fac2", colnames(TabSeries)[-1L][ConvertFun == "mean"])
tsAggregMean <- aggregate(. ~ Fac2, data = TabSeries2[, colTsAggregMean], FUN = mean, na.action = na.pass)
} else {
tsAggregMean <- data.frame(a = NA, b = NA)
}
if ("sum" %in% ConvertFun) {
colTsAggregSum <- c("Fac2", colnames(TabSeries)[-1L][ConvertFun == "sum"])
tsAggregSum <- aggregate(. ~ Fac2, data = TabSeries2[, colTsAggregSum], FUN = sum, na.action = na.pass)
} else {
tsAggregSum <- data.frame(a = NA, b = NA)
}
tsAggreg <- cbind(tsAggregMean, tsAggregSum)
tsAggreg <- tsAggreg[, !duplicated(colnames(tsAggreg))]
tsAggreg <- merge(tsAggreg, TabSeries2[, c("Fac2", "DatesR", "DatesRini", "Selec")], by = "Fac2", all.x = TRUE, all.y = FALSE)
tsAggreg <- tsAggreg[tsAggreg$Selec & tsAggreg$DatesRini, ]
tsAggreg <- tsAggreg[, colnames(TabSeries0)]
return(tsAggreg)
}
SeriesAggreg2.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, verbose = TRUE, ...) {
## Arguments checks
if (!is.null(TimeFormat)) {
warning("deprecated 'TimeFormat' argument", call. = FALSE)
}
if (!is.null(NewTimeFormat)) {
if (missing(Format)) {
TimeStep <- c("hourly", "daily", "monthly", "yearly")
NewTimeFormat <- match.arg(NewTimeFormat, choices = TimeStep)
Format <- switch(NewTimeFormat,
hourly = "%Y%m%d%h",
daily = "%Y%m%d",
monthly = "%Y%m",
yearly = "%Y")
msgNewTimeFormat <- sprintf(" 'Format' automatically set to %s", sQuote(Format))
} else {
msgNewTimeFormat <- NULL
}
warning("deprecated 'NewTimeFormat' argument: please use 'Format' instead.",
msgNewTimeFormat, call. = FALSE)
}
## check TabSeries
if (!is.data.frame(TabSeries)) {
stop("'TabSeries' must be a data.frame containing the dates and data to be aggregated")
}
if (ncol(TabSeries) < 2) {
stop("'TabSeries' must contain at least two columns (including the column of dates)")
}
## check TabSeries date column
if (!inherits(TabSeries[[1L]], "POSIXt")) {
stop("'TabSeries' first column must be a vector of class 'POSIXlt' or 'POSIXct'")
}
if (inherits(TabSeries[[1L]], "POSIXlt")) {
TabSeries[[1L]] <- as.POSIXct(TabSeries[[1L]])
}
## check TabSeries other columns (boolean converted to numeric)
apply(TabSeries[, -1L, drop = FALSE], MARGIN = 2, FUN = function(iCol) {
if (!is.numeric(iCol)) {
stop("'TabSeries' columns (other than the first one) must be of numeric class")
}
})
## check Format
listFormat <- c("%Y%m%d", "%Y%m", "%Y", "%m", "%d")
Format <- gsub(pattern = "[[:punct:]]+", replacement = "%", Format)
Format <- match.arg(Format, choices = listFormat)
## check ConvertFun
listConvertFun <- c("sum", "mean")
ConvertFun <- listConvertFun[match(ConvertFun, listConvertFun)]
if (anyNA(ConvertFun)) {
stop("'ConvertFun' should be a one of 'sum' or 'mean'")
}
if (length(ConvertFun) != (ncol(TabSeries) - 1)) {
stop(
sprintf("'ConvertFun' must be of length %i (ncol(TabSeries)-1)", ncol(TabSeries) - 1)
)
}
## check YearFirstMonth
msgYearFirstMonth <- "'YearFirstMonth' should be a single vector of numeric value between 1 and 12"
YearFirstMonth <- match(YearFirstMonth, 1:12)
if (anyNA(YearFirstMonth)) {
stop(msgYearFirstMonth)
}
if (length(YearFirstMonth) != 1) {
stop(msgYearFirstMonth)
}
if (YearFirstMonth != 1 & Format != "%Y") {
warning("'YearFirstMonth' is ignored beacause Format != '%Y'")
}
## check TimeLag
msgTimeLag <- "'TimeLag' should be a single vector of a positive numeric value"
if (!is.vector(TimeLag)) {
stop(msgTimeLag)
}
if (!is.numeric(TimeLag)) {
stop(msgTimeLag)
}
if (length(TimeLag) != 1 | !any(TimeLag >= 0)) {
stop(msgTimeLag)
}
TabSeries0 <- TabSeries
colnames(TabSeries0)[1L] <- "DatesR"
TabSeries0$DatesR <- TabSeries0$DatesR + TimeLag
TabSeries2 <- TabSeries0
if (!Format %in% c("%d", "%m")) {
start <- sprintf("%i-01-01 00:00:00", as.numeric(format(TabSeries2$DatesR[1L], format = "%Y"))-1)
stop <- sprintf("%i-12-31 00:00:00", as.numeric(format(TabSeries2$DatesR[nrow(TabSeries2)], format = "%Y"))+1)
by <- ifelse(grepl("hours", format(diff(TabSeries$DatesR[1:2]))), yes = "hours", no = "days")
fakeTs <- data.frame(DatesR = seq(from = as.POSIXct(start, tz = "UTC"),
to = as.POSIXct(stop , tz = "UTC"),
by = by) + TimeLag)
TabSeries2 <- merge(fakeTs, TabSeries2, by = "DatesR", all.x = TRUE)
}
TabSeries2$DatesRini <- TabSeries2$DatesR %in% TabSeries0$DatesR
TabSeries2$Selec2 <- format(TabSeries2$DatesR, Format)
if (nchar(Format) > 2 | Format == "%Y") {
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
if (all(TabSeries2$Selec)) {
warning("the requested time 'Format' is the same as the one in 'TabSeries'. No time-step conversion was performed")
return(TabSeries)
}
if (Format == "%Y") {
yfm <- sprintf("%02.f", YearFirstMonth)
spF1 <- "%m"
spF2 <- "%Y-%m"
TabSeries2$Selec1 <- format(TabSeries2$DatesR, spF1)
TabSeries2$Selec2 <- format(TabSeries2$DatesR, spF2)
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2) & TabSeries2$Selec1 == yfm
}
TabSeries2$Fac2 <- cumsum(TabSeries2$Selec)
} else {
if (Format == "%d") {
spF2 <- "%m-%d"
TabSeries2$Selec2 <- format(TabSeries2$DatesR, spF2)
}
TabSeries2$Fac2 <- TabSeries2$Selec2
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
}
if ("mean" %in% ConvertFun) {
colTsAggregMean <- c("Fac2", colnames(TabSeries)[-1L][ConvertFun == "mean"])
tsAggregMean <- aggregate(. ~ Fac2, data = TabSeries2[, colTsAggregMean], FUN = mean, na.action = na.pass)
} else {
tsAggregMean <- data.frame(a = NA, b = NA)
}
if ("sum" %in% ConvertFun) {
colTsAggregSum <- c("Fac2", colnames(TabSeries)[-1L][ConvertFun == "sum"])
tsAggregSum <- aggregate(. ~ Fac2, data = TabSeries2[, colTsAggregSum], FUN = sum, na.action = na.pass)
} else {
tsAggregSum <- data.frame(a = NA, b = NA)
}
tsAggreg <- cbind(tsAggregMean, tsAggregSum)
tsAggreg <- tsAggreg[, !duplicated(colnames(tsAggreg))]
tsAggreg <- merge(tsAggreg, TabSeries2[, c("Fac2", "DatesR", "DatesRini", "Selec")], by = "Fac2", all.x = TRUE, all.y = FALSE)
tsAggreg <- tsAggreg[tsAggreg$Selec & tsAggreg$DatesRini, ]
tsAggreg <- tsAggreg[, colnames(TabSeries0)]
return(tsAggreg)
}
SeriesAggreg2.default <- function(TabSeries,
Format,
TimeFormat = NULL,
NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, ..., simplify = FALSE) {
SeriesAggreg2.list <- function(TabSeries, Format, simplify = FALSE, ...) {
if (!inherits(TabSeries, c("InputsModel", "OutputsModel"))) {
stop("to be used with InputsModel', or 'OutputsModel' object")
......@@ -40,11 +35,7 @@ SeriesAggreg2.default <- function(TabSeries,
}
CemaNeigeLayersAggreg <- lapply(CemaNeigeLayers, function(iLayer) {
tmp <- cbind(TabSeries$DatesR, as.data.frame(iLayer))
res <- SeriesAggreg2(tmp, Format = Format,
TimeFormat = TimeFormat, NewTimeFormat = NewTimeFormat,
ConvertFun = .AggregConvertFun(gsub("[.].*", "", colnames(tmp)[-1L])),
YearFirstMonth = YearFirstMonth, TimeLag = TimeLag,
verbose = verbose)
res <- SeriesAggreg2(tmp, Format, ..., ConvertFun = .AggregConvertFun(gsub("[.].*", "", colnames(tmp)[-1L])))
res <- res[, -1L]
colnames(res) <- gsub(".*[.]", "", colnames(res))
res <- as.list(res)
......@@ -54,12 +45,7 @@ SeriesAggreg2.default <- function(TabSeries,
TabSeries2 <- TabSeries[1:which(names(TabSeries) %in% lastCol)]
TabSeries2 <- as.data.frame.list(TabSeries2)
NewTabSeries <- SeriesAggreg2(TabSeries = TabSeries2,
Format = Format,
TimeFormat = TimeFormat, NewTimeFormat = NewTimeFormat,
ConvertFun = .AggregConvertFun(colnames(TabSeries2)[-1L]),
YearFirstMonth = YearFirstMonth, TimeLag = TimeLag,
verbose = verbose)
NewTabSeries <- SeriesAggreg2(TabSeries = TabSeries2, Format, ..., ConvertFun = .AggregConvertFun(colnames(TabSeries2)[-1L]))
NewTabSeries$zzz <- NULL
......
......@@ -3,6 +3,7 @@
\name{SeriesAggreg2}
\alias{SeriesAggreg2}
\alias{SeriesAggreg2.list}
\alias{SeriesAggreg2.data.frame}
\alias{SeriesAggreg2.InputsModel}
\alias{SeriesAggreg2.OutputsModel}
......@@ -19,30 +20,33 @@ Warning: on the aggregated outputs, the dates correspond to the beginning of the
(e.g. for yearly time series 2005-03-01 00:00 = value for period 2005-03-01 00:00 - 2006-02-28 23:59)
}
\details{
\code{\link{SeriesAggreg2.InputsModel}} and \code{\link{SeriesAggreg2.OutputsModel}}
call \code{\link{SeriesAggreg2.list}} which itself calls \code{\link{SeriesAggreg2.data.frame}}.
So, all arguments passed to any \code{\link{SeriesAggreg2}} method will be passed to \code{\link{SeriesAggreg2.data.frame}}.
}
\usage{
\method{SeriesAggreg2}{data.frame}(TabSeries,
Format, TimeFormat, NewTimeFormat,
Format, ConvertFun, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, ..., ConvertFun)
verbose = TRUE, \dots)
\method{SeriesAggreg2}{list}(TabSeries,
Format, simplify = FALSE, \dots)
\method{SeriesAggreg2}{InputsModel}(TabSeries,
Format, TimeFormat, NewTimeFormat,
YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, ..., simplify = FALSE)
Format, \dots)
\method{SeriesAggreg2}{OutputsModel}(TabSeries,
Format, TimeFormat, NewTimeFormat,
YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, ..., simplify = FALSE)
Format, \dots)
}
\arguments{
\item{TabSeries}{[POSIXt+numeric] data.frame containing the vector of dates (POSIXt) and the time series values numeric)}
\item{...}{...}
\item{Format}{[character] output time step format (i.e. yearly times series: \code{"\%Y"}, monthly time series: \code{"\%Y\%m"}, daily time series: \code{"\%Y\%m\%d"}, monthly regimes \code{"\%m"}, daily regimes \code{"\%d"})}
\item{TimeFormat}{(deprecated) [character] input time step format (i.e. \code{"hourly"}, \code{"daily"}, \code{"monthly"} or \code{"yearly"})}
......@@ -58,6 +62,8 @@ verbose = TRUE, ..., simplify = FALSE)
\item{verbose}{(optional) [boolean] boolean indicating if the function is run in verbose mode or not, default = \code{TRUE}}
\item{simplify}{(optional) [boolean] XXXXXX, default = \code{FALSE}}
\item{\dots}{Arguments passed to \code{\link{SeriesAggreg2.list}} and then to \code{\link{SeriesAggreg2.data.frame}}}
}
......
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