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 Package: airGR
Type: Package Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.8.13 Version: 1.6.8.14
Date: 2020-11-24 Date: 2020-11-24
Authors@R: c( Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
...@@ -8,11 +8,11 @@ useDynLib(airGR, .registration = TRUE) ...@@ -8,11 +8,11 @@ useDynLib(airGR, .registration = TRUE)
##################################### #####################################
## S3 methods ## ## S3 methods ##
##################################### #####################################
S3method("plot", "OutputsModel") S3method(plot, OutputsModel)
S3method("SeriesAggreg", "data.frame") S3method(SeriesAggreg, data.frame)
S3method("SeriesAggreg", "list") S3method(SeriesAggreg, list)
S3method("SeriesAggreg", "InputsModel") S3method(SeriesAggreg, InputsModel)
S3method("SeriesAggreg", "OutputsModel") S3method(SeriesAggreg, OutputsModel)
...@@ -51,10 +51,6 @@ export(RunModel_GR5J) ...@@ -51,10 +51,6 @@ export(RunModel_GR5J)
export(RunModel_GR6J) export(RunModel_GR6J)
export(RunModel_Lag) export(RunModel_Lag)
export(SeriesAggreg) export(SeriesAggreg)
export(SeriesAggreg.list)
export(SeriesAggreg.data.frame)
export(SeriesAggreg.InputsModel)
export(SeriesAggreg.OutputsModel)
export(TransfoParam) export(TransfoParam)
export(TransfoParam_CemaNeige) export(TransfoParam_CemaNeige)
export(TransfoParam_CemaNeigeHyst) export(TransfoParam_CemaNeigeHyst)
...@@ -66,7 +62,7 @@ export(TransfoParam_GR4J) ...@@ -66,7 +62,7 @@ export(TransfoParam_GR4J)
export(TransfoParam_GR5J) export(TransfoParam_GR5J)
export(TransfoParam_GR6J) export(TransfoParam_GR6J)
export(TransfoParam_Lag) export(TransfoParam_Lag)
export(plot.OutputsModel) export(plot)
exportPattern(".FortranOutputs") exportPattern(".FortranOutputs")
exportPattern(".ErrorCrit") exportPattern(".ErrorCrit")
......
SeriesAggreg.InputsModel <- function(TabSeries, Format, ...) { SeriesAggreg.InputsModel <- function(TabSeries, ...) {
if (!inherits(TabSeries, "InputsModel")) { if (!inherits(TabSeries, "InputsModel")) {
stop("to be used with 'InputsModel' object") stop("to be used with 'InputsModel' object")
} }
res <- SeriesAggreg.list(TabSeries, ...)
res <- SeriesAggreg.list(TabSeries = TabSeries, Format, ...)
if (inherits(TabSeries, "CemaNeige")) { if (inherits(TabSeries, "CemaNeige")) {
res$ZLayers <- TabSeries$ZLayers res$ZLayers <- TabSeries$ZLayers
......
SeriesAggreg.OutputsModel <- function(TabSeries, Format, ...) { SeriesAggreg.OutputsModel <- function(TabSeries, ...) {
if (!inherits(TabSeries, "OutputsModel")) { if (!inherits(TabSeries, "OutputsModel")) {
stop("to be used with 'OutputsModel' object") stop("to be used with 'OutputsModel' object")
} }
res <- SeriesAggreg.list(TabSeries, Format, ...) res <- SeriesAggreg.list(TabSeries, ...)
res$StateEnd <- TabSeries$StateEnd res$StateEnd <- TabSeries$StateEnd
......
SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat = NULL, NewTimeFormat = NULL, SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, verbose = TRUE, ...) { YearFirstMonth = 1, TimeLag = 0, ...) {
## Arguments checks ## Arguments checks
if (!is.null(TimeFormat)) { if (!is.null(TimeFormat)) {
warning("deprecated 'TimeFormat' argument", call. = FALSE) warning("deprecated 'TimeFormat' argument", call. = FALSE)
} }
if (!is.null(NewTimeFormat)) { if (missing(Format)) {
if (missing(Format)) { Format <- getSeriesAggregFormat(NewTimeFormat)
TimeStep <- c("hourly", "daily", "monthly", "yearly") } else if (!is.null(NewTimeFormat)) {
NewTimeFormat <- match.arg(NewTimeFormat, choices = TimeStep) warning("deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
Format <- switch(NewTimeFormat, call. = FALSE)
hourly = "%Y%m%d%h", }
daily = "%Y%m%d", if (is.null(Format)) {
monthly = "%Y%m", stop("argument 'Format' is missing")
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 ## check TabSeries
if (!is.data.frame(TabSeries)) { if (!is.data.frame(TabSeries)) {
stop("'TabSeries' must be a data.frame containing the dates and data to be aggregated") 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 = ...@@ -66,7 +60,7 @@ SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat =
stop(msgYearFirstMonth) stop(msgYearFirstMonth)
} }
if (YearFirstMonth != 1 & Format != "%Y") { if (YearFirstMonth != 1 & Format != "%Y") {
warning("'YearFirstMonth' is ignored beacause Format != '%Y'") warning("'YearFirstMonth' is ignored because Format != '%Y'")
} }
## check TimeLag ## check TimeLag
msgTimeLag <- "'TimeLag' should be a single vector of a positive numeric value" msgTimeLag <- "'TimeLag' should be a single vector of a positive numeric value"
...@@ -101,7 +95,8 @@ SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat = ...@@ -101,7 +95,8 @@ SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat =
TabSeries2$Selec2 <- format(TabSeries2$DatesR, Format) TabSeries2$Selec2 <- format(TabSeries2$DatesR, Format)
if (nchar(Format) > 2 | Format == "%Y") { if (nchar(Format) > 2 | Format == "%Y") {
# Compute aggregation
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2) TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
if (all(TabSeries2$Selec)) { if (all(TabSeries2$Selec)) {
warning("the requested time 'Format' is the same as the one in 'TabSeries'. No time-step conversion was performed") 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 = ...@@ -117,6 +112,7 @@ SeriesAggreg.data.frame <- function(TabSeries, Format, ConvertFun, TimeFormat =
} }
TabSeries2$Fac2 <- cumsum(TabSeries2$Selec) TabSeries2$Fac2 <- cumsum(TabSeries2$Selec)
} else { } else {
# Compute regime
if (Format == "%d") { if (Format == "%d") {
spF2 <- "%m-%d" spF2 <- "%m-%d"
TabSeries2$Selec2 <- format(TabSeries2$DatesR, spF2) 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"))) { if (!is.list(TabSeries)) {
stop("to be used with InputsModel', or 'OutputsModel' object") 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")) { if (!inherits(TabSeries, "GR") & inherits(TabSeries, "CemaNeige")) {
ClassTabSeries <- class(TabSeries) ClassTabSeries <- class(TabSeries)
zzz <- list(zzz = rep(NaN, length(TabSeries$DatesR))) zzz <- list(zzz = rep(NaN, length(TabSeries$DatesR)))
...@@ -56,6 +64,7 @@ SeriesAggreg.list <- function(TabSeries, Format, simplify = FALSE, ...) { ...@@ -56,6 +64,7 @@ SeriesAggreg.list <- function(TabSeries, Format, simplify = FALSE, ...) {
} else { } else {
res <- list() res <- list()
ClassFormat <- switch(substr(Format, start = nchar(Format), stop = nchar(Format)), ClassFormat <- switch(substr(Format, start = nchar(Format), stop = nchar(Format)),
h = "hourly", h = "hourly",
d = "daily", 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 ...@@ -30,17 +30,14 @@ Warning: on the aggregated outputs, the dates correspond to the beginning of the
\usage{ \usage{
\method{SeriesAggreg}{data.frame}(TabSeries, \method{SeriesAggreg}{data.frame}(TabSeries,
Format, ConvertFun, TimeFormat = NULL, NewTimeFormat = NULL, Format, ConvertFun, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, YearFirstMonth = 1, TimeLag = 0, \dots)
verbose = TRUE, \dots)
\method{SeriesAggreg}{list}(TabSeries, \method{SeriesAggreg}{list}(TabSeries,
Format, simplify = FALSE, \dots) Format, simplify = FALSE, NewTimeFormat = NULL, \dots)
\method{SeriesAggreg}{InputsModel}(TabSeries, \method{SeriesAggreg}{InputsModel}(TabSeries, \dots)
Format, \dots)
\method{SeriesAggreg}{OutputsModel}(TabSeries, \method{SeriesAggreg}{OutputsModel}(TabSeries, \dots)
Format, \dots)
} }
...@@ -59,9 +56,7 @@ Format, \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{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] 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{simplify}{(optional) [boolean] XXXXXX, default = \code{FALSE}}
\item{\dots}{Arguments passed to \code{\link{SeriesAggreg.list}} and then to \code{\link{SeriesAggreg.data.frame}}} \item{\dots}{Arguments passed to \code{\link{SeriesAggreg.list}} and then to \code{\link{SeriesAggreg.data.frame}}}
} }
......
context("SeriesAggreg") context("SeriesAggreg")
## load catchment data
data(L0123002)
test_that("No warning with InputsModel Cemaneige'", { test_that("No warning with InputsModel Cemaneige'", {
## load of catchment data
data(L0123002)
## preparation of the InputsModel object ## preparation of the InputsModel object
InputsModel <- CreateInputsModel(FUN_MOD = RunModel_CemaNeige, DatesR = BasinObs$DatesR, InputsModel <-
Precip = BasinObs$P,TempMean = BasinObs$T, CreateInputsModel(
ZInputs = BasinInfo$HypsoData[51], HypsoData=BasinInfo$HypsoData, FUN_MOD = RunModel_CemaNeige,
NLayers = 5) DatesR = BasinObs$DatesR,
expect_warning( Precip = BasinObs$P,
SeriesAggreg(InputsModel, "%m"), TempMean = BasinObs$T,
regexp = NA) 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