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

v1.6.8.14: refactor deprecated NewTimeFormat argument handling

Refs #41
parent 2829a5a2
Pipeline #17935 passed with stages
in 11 minutes and 19 seconds
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.8.13
Version: 1.6.8.14
Date: 2020-11-24
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
......@@ -8,11 +8,11 @@ useDynLib(airGR, .registration = TRUE)
#####################################
## S3 methods ##
#####################################
S3method("plot", "OutputsModel")
S3method("SeriesAggreg", "data.frame")
S3method("SeriesAggreg", "list")
S3method("SeriesAggreg", "InputsModel")
S3method("SeriesAggreg", "OutputsModel")
S3method(plot, OutputsModel)
S3method(SeriesAggreg, data.frame)
S3method(SeriesAggreg, list)
S3method(SeriesAggreg, InputsModel)
S3method(SeriesAggreg, OutputsModel)
......@@ -51,10 +51,6 @@ export(RunModel_GR5J)
export(RunModel_GR6J)
export(RunModel_Lag)
export(SeriesAggreg)
export(SeriesAggreg.list)
export(SeriesAggreg.data.frame)
export(SeriesAggreg.InputsModel)
export(SeriesAggreg.OutputsModel)
export(TransfoParam)
export(TransfoParam_CemaNeige)
export(TransfoParam_CemaNeigeHyst)
......@@ -66,7 +62,7 @@ export(TransfoParam_GR4J)
export(TransfoParam_GR5J)
export(TransfoParam_GR6J)
export(TransfoParam_Lag)
export(plot.OutputsModel)
export(plot)
exportPattern(".FortranOutputs")
exportPattern(".ErrorCrit")
......
SeriesAggreg.InputsModel <- function(TabSeries, Format, ...) {
SeriesAggreg.InputsModel <- function(TabSeries, ...) {
if (!inherits(TabSeries, "InputsModel")) {
stop("to be used with 'InputsModel' object")
}
res <- SeriesAggreg.list(TabSeries = TabSeries, Format, ...)
res <- SeriesAggreg.list(TabSeries, ...)
if (inherits(TabSeries, "CemaNeige")) {
res$ZLayers <- TabSeries$ZLayers
......
SeriesAggreg.OutputsModel <- function(TabSeries, Format, ...) {
SeriesAggreg.OutputsModel <- function(TabSeries, ...) {
if (!inherits(TabSeries, "OutputsModel")) {
stop("to be used with 'OutputsModel' object")
}
res <- SeriesAggreg.list(TabSeries, Format, ...)
res <- SeriesAggreg.list(TabSeries, ...)
res$StateEnd <- TabSeries$StateEnd
......
SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, verbose = TRUE, ...) {
YearFirstMonth = 1, TimeLag = 0, ...) {
## 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
Format <- getSeriesAggregFormat(NewTimeFormat)
} else if (!is.null(NewTimeFormat)) {
warning("deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
call. = FALSE)
}
warning("deprecated 'NewTimeFormat' argument: please use 'Format' instead.",
msgNewTimeFormat, call. = FALSE)
if (is.null(Format)) {
stop("argument 'Format' is missing")
}
## check TabSeries
if (!is.data.frame(TabSeries)) {
stop("'TabSeries' must be a data.frame containing the dates and data to be aggregated")
......@@ -66,7 +60,7 @@ SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat =
stop(msgYearFirstMonth)
}
if (YearFirstMonth != 1 & Format != "%Y") {
warning("'YearFirstMonth' is ignored beacause Format != '%Y'")
warning("'YearFirstMonth' is ignored because Format != '%Y'")
}
## check TimeLag
msgTimeLag <- "'TimeLag' should be a single vector of a positive numeric value"
......@@ -102,6 +96,7 @@ SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat =
TabSeries2$Selec2 <- format(TabSeries2$DatesR, Format)
if (nchar(Format) > 2 | Format == "%Y") {
# Compute aggregation
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")
......@@ -117,6 +112,7 @@ SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat =
}
TabSeries2$Fac2 <- cumsum(TabSeries2$Selec)
} else {
# Compute regime
if (Format == "%d") {
spF2 <- "%m-%d"
TabSeries2$Selec2 <- format(TabSeries2$DatesR, spF2)
......
SeriesAggreg.list <- function(TabSeries, Format, simplify = FALSE, ...) {
SeriesAggreg.list <- function(TabSeries, Format, simplify = FALSE, NewTimeFormat = NULL, ...) {
if (!inherits(TabSeries, c("InputsModel", "OutputsModel"))) {
stop("to be used with InputsModel', or 'OutputsModel' object")
if (!is.list(TabSeries)) {
stop("to be used with a list")
}
if(missing(Format)) {
Format <- getSeriesAggregFormat(NewTimeFormat)
} else if (!is.null(NewTimeFormat)) {
warning("deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
call. = FALSE)
}
# Search for input date time series
if (!inherits(TabSeries, "GR") & inherits(TabSeries, "CemaNeige")) {
ClassTabSeries <- class(TabSeries)
zzz <- list(zzz = rep(NaN, length(TabSeries$DatesR)))
......@@ -56,6 +64,7 @@ SeriesAggreg.list <- function(TabSeries, Format, simplify = FALSE, ...) {
} else {
res <- list()
ClassFormat <- switch(substr(Format, start = nchar(Format), stop = nchar(Format)),
h = "hourly",
d = "daily",
......
getSeriesAggregFormat <- function(NewTimeFormat) {
errNewTimeFormat = FALSE
if (missing(NewTimeFormat)) {
errNewTimeFormat = TRUE
} else if (is.null(NewTimeFormat)) {
errNewTimeFormat = TRUE
}
if (errNewTimeFormat) {
stop("Argument `Format` is missing")
}
if (!is.null(NewTimeFormat)) {
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))
warning(
"deprecated 'NewTimeFormat' argument: please use 'Format' instead.",
msgNewTimeFormat,
call. = FALSE
)
return(Format)
}
return(NULL)
}
\ No newline at end of file
......@@ -30,17 +30,14 @@ Warning: on the aggregated outputs, the dates correspond to the beginning of the
\usage{
\method{SeriesAggreg}{data.frame}(TabSeries,
Format, ConvertFun, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, \dots)
YearFirstMonth = 1, TimeLag = 0, \dots)
\method{SeriesAggreg}{list}(TabSeries,
Format, simplify = FALSE, \dots)
Format, simplify = FALSE, NewTimeFormat = NULL, \dots)
\method{SeriesAggreg}{InputsModel}(TabSeries,
Format, \dots)
\method{SeriesAggreg}{InputsModel}(TabSeries, \dots)
\method{SeriesAggreg}{OutputsModel}(TabSeries,
Format, \dots)
\method{SeriesAggreg}{OutputsModel}(TabSeries, \dots)
}
......@@ -59,9 +56,7 @@ Format, \dots)
\item{TimeLag}{(optional) [numeric] numeric indicating a time lag (in seconds) for the time series aggregation (especially useful to aggregate hourly time series into daily time series)}
\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{simplify}{(optional) [boolean] if set to \code{TRUE}, a \code{\link{data.frame}} is returned instead of a \code{\link{list}}. Embedded lists are then ignored. Default = \code{FALSE}}
\item{\dots}{Arguments passed to \code{\link{SeriesAggreg.list}} and then to \code{\link{SeriesAggreg.data.frame}}}
}
......
context("SeriesAggreg")
## load catchment data
data(L0123002)
test_that("No warning with InputsModel Cemaneige'", {
## load of catchment data
data(L0123002)
## preparation of the InputsModel object
InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeige, DatesR = BasinObs$DatesR,
Precip = BasinObs$P,TempMean = BasinObs$T,
ZInputs = BasinInfo$HypsoData[51], HypsoData=BasinInfo$HypsoData,
NLayers = 5)
expect_warning(
SeriesAggreg(InputsModel, "%m"),
InputsModel <-
CreateInputsModel(
FUN_MOD = RunModel_CemaNeige,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
TempMean = BasinObs$T,
ZInputs = BasinInfo$HypsoData[51],
HypsoData = BasinInfo$HypsoData,
NLayers = 5
)
# Expect no warning: https://stackoverflow.com/a/33638939/5300212
expect_warning(SeriesAggreg(InputsModel, "%m"),
regexp = NA)
})
test_that("Warning: deprecated 'TimeFormat' argument", {
InputsModel <-
CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E
)
expect_warning(SeriesAggreg(InputsModel, Format = "%Y%m", TimeFormat = "daily"),
regexp = "deprecated 'TimeFormat' argument")
})
test_that("Warning: deprecated 'NewTimeFormat' argument: please use 'Format' instead",
{
InputsModel <-
CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E
)
expect_warning(SeriesAggreg(InputsModel, NewTimeFormat = "monthly"),
regexp = "deprecated 'NewTimeFormat' argument: please use 'Format' instead")
})
test_that("Warning: deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
{
InputsModel <-
CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E
)
expect_warning(SeriesAggreg(InputsModel, Format = "%Y%m", NewTimeFormat = "monthly"),
regexp = "deprecated 'NewTimeFormat' argument: 'Format' argument is used instead")
})
test_that("Check SeriesAggreg output values on yearly aggregation", {
TabSeries <- data.frame(
DatesR = BasinObs$DatesR,
P = BasinObs$P,
E = BasinObs$E,
Qmm = BasinObs$Qmm
)
GoodValues <- apply(
BasinObs[BasinObs$DatesR >= "1984-09-01" & BasinObs$DatesR < "1985-09-01",
c("P", "E", "Qmm")], 2, sum)
TestedValues <- unlist(SeriesAggreg(TabSeries,
Format = "%Y",
ConvertFun = rep("sum", 3),
YearFirstMonth = 9)[1, c("P", "E", "Qmm")])
expect_equal(GoodValues, TestedValues)
})
  • @david.dorchies, I think it is not a bad idea to export the following functions, in order to allow the user to easily access the codes:

    • plot.OutputsModel()
    • SeriesAggreg.data.frame()

    and to keep private only the functions :

    • SeriesAggreg.InputsModel()
    • SeriesAggreg.list()
    • SeriesAggreg.OutputsModel()
  • I took a look at the plot methods and maybe you're finally right...

    > methods("plot")
     [1] plot.acf*           plot.data.frame*    plot.decomposed.ts* plot.default        plot.dendrogram*   
     [6] plot.density*       plot.ecdf           plot.factor*        plot.formula*       plot.function      
    [11] plot.hclust*        plot.histogram*     plot.HoltWinters*   plot.isoreg*        plot.lm*           
    [16] plot.medpolish*     plot.mlm*           plot.OutputsModel*  plot.ppr*           plot.prcomp*       
    [21] plot.princomp*      plot.profile.nls*   plot.raster*        plot.spec*          plot.stepfun       
    [26] plot.stl*           plot.table*         plot.ts             plot.tskernel*      plot.TukeyHSD*     
    see '?methods' for accessing help and source code
    Edited by Delaigue Olivier
  • @david.dorchies, I think that we don't need to export the plot function (export(plot)). If I understand well, it exports a new time the plot function of the graphics package from airGR. It seems to work without this.

    > graphics::plot
    function (x, y, ...) 
    UseMethod("plot")
    <bytecode: 0x55ef72925e98>
    <environment: namespace:graphics>
    > airGR::plot
    function (x, y, ...) 
    UseMethod("plot")
    <bytecode: 0x55ef72925e98>
    <environment: namespace:graphics>
    Edited by Delaigue Olivier
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