Commit 70e1f185 authored by Dorchies David's avatar Dorchies David
Browse files

fix (SeriesAggreg2): irrelevant warnings with InputsModel/Cemaneige object on obsolete arguments

- Add test case
- Replace missing arguments by default NULL arguments.

Refs #41
parent 42e581c4
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.8 Version: 1.6.8.9
Date: 2020-11-20 Date: 2020-11-20
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")),
......
SeriesAggreg2.InputsModel <- function(TabSeries, SeriesAggreg2.InputsModel <- function(TabSeries,
Format, Format,
TimeFormat, TimeFormat = NULL,
NewTimeFormat, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, ..., simplify = FALSE) { verbose = TRUE, ..., simplify = FALSE) {
if (!inherits(TabSeries, "InputsModel")) { if (!inherits(TabSeries, "InputsModel")) {
stop("to be used with 'InputsModel' object") stop("to be used with 'InputsModel' object")
} }
res <- SeriesAggreg2.default(TabSeries = TabSeries, res <- SeriesAggreg2.default(TabSeries = TabSeries,
Format = Format, Format = Format,
TimeFormat = TimeFormat, TimeFormat = TimeFormat,
...@@ -16,11 +16,11 @@ SeriesAggreg2.InputsModel <- function(TabSeries, ...@@ -16,11 +16,11 @@ SeriesAggreg2.InputsModel <- function(TabSeries,
YearFirstMonth = YearFirstMonth, TimeLag = TimeLag, YearFirstMonth = YearFirstMonth, TimeLag = TimeLag,
verbose = verbose, verbose = verbose,
simplify = simplify) simplify = simplify)
if (inherits(TabSeries, "CemaNeige")) { if (inherits(TabSeries, "CemaNeige")) {
res$ZLayers <- TabSeries$ZLayers res$ZLayers <- TabSeries$ZLayers
} }
return(res) return(res)
} }
\ No newline at end of file
SeriesAggreg2 <- function(TabSeries, SeriesAggreg2 <- function(TabSeries,
Format, TimeFormat, NewTimeFormat, Format, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, verbose = TRUE,
...) { ...) {
...@@ -7,14 +7,14 @@ SeriesAggreg2 <- function(TabSeries, ...@@ -7,14 +7,14 @@ SeriesAggreg2 <- function(TabSeries,
} }
SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeFormat, SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat = NULL, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, verbose = TRUE, ..., ConvertFun) { YearFirstMonth = 1, TimeLag = 0, verbose = TRUE, ..., ConvertFun) {
## Arguments checks ## Arguments checks
if (!missing(TimeFormat)) { if (!is.null(TimeFormat)) {
warning("deprecated 'TimeFormat' argument", call. = FALSE) warning("deprecated 'TimeFormat' argument", call. = FALSE)
} }
if (!missing(NewTimeFormat)) { if (!is.null(NewTimeFormat)) {
if (missing(Format)) { if (missing(Format)) {
TimeStep <- c("hourly", "daily", "monthly", "yearly") TimeStep <- c("hourly", "daily", "monthly", "yearly")
NewTimeFormat <- match.arg(NewTimeFormat, choices = TimeStep) NewTimeFormat <- match.arg(NewTimeFormat, choices = TimeStep)
...@@ -88,14 +88,14 @@ SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeForma ...@@ -88,14 +88,14 @@ SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeForma
if (length(TimeLag) != 1 | !any(TimeLag >= 0)) { if (length(TimeLag) != 1 | !any(TimeLag >= 0)) {
stop(msgTimeLag) stop(msgTimeLag)
} }
TabSeries0 <- TabSeries TabSeries0 <- TabSeries
colnames(TabSeries0)[1L] <- "DatesR" colnames(TabSeries0)[1L] <- "DatesR"
TabSeries0$DatesR <- TabSeries0$DatesR + TimeLag TabSeries0$DatesR <- TabSeries0$DatesR + TimeLag
TabSeries2 <- TabSeries0 TabSeries2 <- TabSeries0
if (!Format %in% c("%d", "%m")) { if (!Format %in% c("%d", "%m")) {
start <- sprintf("%i-01-01 00:00:00", as.numeric(format(TabSeries2$DatesR[1L], format = "%Y"))-1) 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) stop <- sprintf("%i-12-31 00:00:00", as.numeric(format(TabSeries2$DatesR[nrow(TabSeries2)], format = "%Y"))+1)
...@@ -106,10 +106,10 @@ SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeForma ...@@ -106,10 +106,10 @@ SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeForma
TabSeries2 <- merge(fakeTs, TabSeries2, by = "DatesR", all.x = TRUE) TabSeries2 <- merge(fakeTs, TabSeries2, by = "DatesR", all.x = TRUE)
} }
TabSeries2$DatesRini <- TabSeries2$DatesR %in% TabSeries0$DatesR TabSeries2$DatesRini <- TabSeries2$DatesR %in% TabSeries0$DatesR
TabSeries2$Selec2 <- format(TabSeries2$DatesR, Format) TabSeries2$Selec2 <- format(TabSeries2$DatesR, Format)
if (nchar(Format) > 2 | Format == "%Y") { if (nchar(Format) > 2 | Format == "%Y") {
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2) TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
if (all(TabSeries2$Selec)) { if (all(TabSeries2$Selec)) {
...@@ -133,7 +133,7 @@ SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeForma ...@@ -133,7 +133,7 @@ SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeForma
TabSeries2$Fac2 <- TabSeries2$Selec2 TabSeries2$Fac2 <- TabSeries2$Selec2
TabSeries2$Selec <- !duplicated(TabSeries2$Selec2) TabSeries2$Selec <- !duplicated(TabSeries2$Selec2)
} }
if ("mean" %in% ConvertFun) { if ("mean" %in% ConvertFun) {
colTsAggregMean <- c("Fac2", colnames(TabSeries)[-1L][ConvertFun == "mean"]) colTsAggregMean <- c("Fac2", colnames(TabSeries)[-1L][ConvertFun == "mean"])
tsAggregMean <- aggregate(. ~ Fac2, data = TabSeries2[, colTsAggregMean], FUN = mean, na.action = na.pass) tsAggregMean <- aggregate(. ~ Fac2, data = TabSeries2[, colTsAggregMean], FUN = mean, na.action = na.pass)
...@@ -146,13 +146,13 @@ SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeForma ...@@ -146,13 +146,13 @@ SeriesAggreg2.data.frame <- function(TabSeries, Format, TimeFormat, NewTimeForma
} else { } else {
tsAggregSum <- data.frame(a = NA, b = NA) tsAggregSum <- data.frame(a = NA, b = NA)
} }
tsAggreg <- cbind(tsAggregMean, tsAggregSum) tsAggreg <- cbind(tsAggregMean, tsAggregSum)
tsAggreg <- tsAggreg[, !duplicated(colnames(tsAggreg))] tsAggreg <- tsAggreg[, !duplicated(colnames(tsAggreg))]
tsAggreg <- merge(tsAggreg, TabSeries2[, c("Fac2", "DatesR", "DatesRini", "Selec")], by = "Fac2", all.x = TRUE, all.y = FALSE) 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[tsAggreg$Selec & tsAggreg$DatesRini, ]
tsAggreg <- tsAggreg[, colnames(TabSeries0)] tsAggreg <- tsAggreg[, colnames(TabSeries0)]
return(tsAggreg) return(tsAggreg)
} }
SeriesAggreg2.default <- function(TabSeries, SeriesAggreg2.default <- function(TabSeries,
Format, Format,
TimeFormat, TimeFormat = NULL,
NewTimeFormat, NewTimeFormat = NULL,
YearFirstMonth = 1, TimeLag = 0, YearFirstMonth = 1, TimeLag = 0,
verbose = TRUE, ..., simplify = FALSE) { verbose = TRUE, ..., simplify = FALSE) {
if (!inherits(TabSeries, c("InputsModel", "OutputsModel"))) { if (!inherits(TabSeries, c("InputsModel", "OutputsModel"))) {
stop("to be used with InputsModel', or 'OutputsModel' object") stop("to be used with InputsModel', or 'OutputsModel' object")
} }
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)))
TabSeries <- append(TabSeries, values = zzz, after = 1) TabSeries <- append(TabSeries, values = zzz, after = 1)
class(TabSeries) <- ClassTabSeries class(TabSeries) <- ClassTabSeries
...@@ -24,7 +24,7 @@ SeriesAggreg2.default <- function(TabSeries, ...@@ -24,7 +24,7 @@ SeriesAggreg2.default <- function(TabSeries,
lastCol <- "Qsim" lastCol <- "Qsim"
} }
} }
if (inherits(TabSeries, "CemaNeige")) { if (inherits(TabSeries, "CemaNeige")) {
if (inherits(TabSeries, "InputsModel")) { if (inherits(TabSeries, "InputsModel")) {
CemaNeigeLayers <- TabSeries[grep("^Layer", names(TabSeries))] CemaNeigeLayers <- TabSeries[grep("^Layer", names(TabSeries))]
...@@ -50,8 +50,8 @@ SeriesAggreg2.default <- function(TabSeries, ...@@ -50,8 +50,8 @@ SeriesAggreg2.default <- function(TabSeries,
res <- as.list(res) res <- as.list(res)
}) })
} }
TabSeries2 <- TabSeries[1:which(names(TabSeries) %in% lastCol)] TabSeries2 <- TabSeries[1:which(names(TabSeries) %in% lastCol)]
TabSeries2 <- as.data.frame.list(TabSeries2) TabSeries2 <- as.data.frame.list(TabSeries2)
NewTabSeries <- SeriesAggreg2(TabSeries = TabSeries2, NewTabSeries <- SeriesAggreg2(TabSeries = TabSeries2,
...@@ -61,25 +61,25 @@ SeriesAggreg2.default <- function(TabSeries, ...@@ -61,25 +61,25 @@ SeriesAggreg2.default <- function(TabSeries,
YearFirstMonth = YearFirstMonth, TimeLag = TimeLag, YearFirstMonth = YearFirstMonth, TimeLag = TimeLag,
verbose = verbose) verbose = verbose)
NewTabSeries$zzz <- NULL NewTabSeries$zzz <- NULL
if (simplify) { if (simplify) {
return(NewTabSeries) return(NewTabSeries)
} 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",
m = "monthly", m = "monthly",
Y = "yearly") Y = "yearly")
## to be consistent with InputsModel class and because plot.OutputsModel use the POSIXlt class ## to be consistent with InputsModel class and because plot.OutputsModel use the POSIXlt class
NewTabSeries$DatesR <- as.POSIXlt(NewTabSeries$DatesR) NewTabSeries$DatesR <- as.POSIXlt(NewTabSeries$DatesR)
res <- as.list(NewTabSeries) res <- as.list(NewTabSeries)
if (inherits(TabSeries, "CemaNeige")) { if (inherits(TabSeries, "CemaNeige")) {
if (inherits(TabSeries, "InputsModel")) { if (inherits(TabSeries, "InputsModel")) {
res <- c(NewTabSeries, CemaNeigeLayersAggreg) res <- c(NewTabSeries, CemaNeigeLayersAggreg)
...@@ -89,10 +89,10 @@ SeriesAggreg2.default <- function(TabSeries, ...@@ -89,10 +89,10 @@ SeriesAggreg2.default <- function(TabSeries,
} }
# res <- append(res, CemaNeigeLayersAggreg, after = length(res)) # res <- append(res, CemaNeigeLayersAggreg, after = length(res))
} }
class(res) <- gsub("hourly|daily|monthly|yearly", ClassFormat, class(TabSeries)) class(res) <- gsub("hourly|daily|monthly|yearly", ClassFormat, class(TabSeries))
return(res) return(res)
} }
} }
\ No newline at end of file
context("SeriesAggreg2")
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(
SeriesAggreg2(InputsModel, "%m"),
regexp = NA)
})
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