En raison du déménagement des baies serveurs, les services gitlab.irstea.fr et mattermost.irstea.fr seront interrompus le samedi 2 octobre 2021 au matin. Ils devraient revenir à la normale dans la journée.

Commit 61eef10e authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

Merge branch '39-set-as-data-frame-method-for-prepgr-calgr-and-simgr-classes' into 'dev'

Resolve "Set as.data.frame method for 'PrepGR', 'CalGR' and 'SimGR' classes"

Closes #39

See merge request !16
parents 4ff6b939 7b1de2e5
Pipeline #23867 passed with stage
in 5 minutes and 36 seconds
......@@ -2,7 +2,7 @@ Package: airGRteaching
Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
Version: 0.2.11
Date: 2021-06-04
Date: 2021-06-07
Authors@R: c(
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
person("Laurent", "Coron", role = c("aut"), comment = c(ORCID = "0000-0002-1503-6204")),
......
......@@ -4,7 +4,9 @@
#####################################
## S3 methods ##
#####################################
S3method(as.data.frame, airGRt)
S3method(as.data.frame, PrepGR)
S3method(as.data.frame, CalGR)
S3method(as.data.frame, SimGR)
S3method(dyplot, default)
S3method(dyplot, PrepGR)
S3method(dyplot, CalGR)
......@@ -46,4 +48,4 @@ importFrom(shinyjs, useShinyjs)
importFrom(shinyjs, enable)
importFrom(shinyjs, disable)
import(markdown)
importFrom(plotrix, boxed.labels)
\ No newline at end of file
importFrom(plotrix, boxed.labels)
......@@ -4,12 +4,18 @@
### 0.2.11 Release Notes (2021-06-04)
### 0.2.11 Release Notes (2021-06-07)
#### Bug fixes
- Fix `ShinyGR()` when the date column of `ObsDF` has another name as 'DatesR'. ([#38](https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/-/issues/38))
#### User-visible changes
- The `as.data.frame` S3 methods have been set for classes `PrepGR`, `CalGR` and `SimGR`. ([#39](https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/-/issues/39))
- The useless `airGRt` class and the `as.data.frame.airGRt` S3 method no longer exist ([#39](https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/-/issues/39))
____________________________________________________________________________________
......@@ -23,7 +29,7 @@ ________________________________________________________________________________
#### Bug fixes
- Fix `plot.PrepGR()` when all `Qobs` are missing. The function now displays an empty plot for the observed discharges. ([#35](https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/-/issues/35))
- Fix `plot.PrepGR()` when all `Qobs` are missing. The function now displays an empty plot for the observed discharges ([#35](https://gitlab.irstea.fr/HYCAR-Hydro/airgrteaching/-/issues/35))
#### User-visible changes
......
......@@ -80,7 +80,7 @@ CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
TypeModel = PrepGR$TypeModel, CalCrit = CalCrit,
PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"),
Run = CalPer))
class(CalGR) <- c("CalGR", "GR", "airGRt")
class(CalGR) <- c("CalGR", "GR")
return(CalGR)
}
......@@ -67,7 +67,7 @@ PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q
PrepGR <- list(InputsModel = MOD_obs, Qobs = ObsDF$Qobs, TypeModel = TypeModel)
class(PrepGR) <- c("PrepGR", "GR", "airGRt")
class(PrepGR) <- c("PrepGR", "GR")
return(PrepGR)
}
......@@ -103,7 +103,7 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2",
CalCrit = CalGR$CalCrit, EffCrit = CRT,
PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"),
Run = SimPer))
class(SimGR) <- c("SimGR", "GR", "airGRt")
class(SimGR) <- c("SimGR", "GR")
return(SimGR)
}
as.data.frame.PrepGR <- function(x, row.names = NULL, ...) {
# if (!(inherits(x, "PrepGR"))) {
# stop("'InputsCrit' must be of class 'PrepGR'")
# }
TMGR <- .TypeModelGR(x)
myGR <- list()
myGR$FracSolid <- NA
myGR$TempMean <- NA
if (TMGR$CemaNeige) {
PrecipSol <- rowMeans(as.data.frame(x$InputsModel$LayerPrecip) * as.data.frame(x$InputsModel$LayerFracSolidPrecip), na.rm = TRUE)
PrecipSim <- rowMeans(as.data.frame(x$InputsModel$LayerPrecip), na.rm = TRUE)
FracSolid <- PrecipSol / PrecipSim
FracSolid <- ifelse(is.na(FracSolid) & PrecipSol == 0 & PrecipSim == 0, 0, FracSolid)
myGR$FracSolid <- FracSolid
TempMean <- rowMeans(as.data.frame(x$InputsModel$LayerTempMean), na.rm = TRUE)
myGR$TempMean <- TempMean
}
myGR$DatesR <- x$InputsModel$DatesR
myGR$PotEvap <- x$InputsModel$PotEvap
myGR$Precip <- x$InputsModel$Precip
myGR$Qobs <- x$Qobs
myGR$Qsim <- NA
TabSim <- data.frame(Dates = myGR$DatesR,
PotEvap = myGR$PotEvap,
PrecipObs = myGR$Precip,
PrecipFracSolid_CemaNeige = myGR$FracSolid,
TempMeanSim_CemaNeige = myGR$TempMean,
Qobs = myGR$Qobs,
Qsim = myGR$Qsim)
as.data.frame(x = TabSim, row.names = row.names, ...)
}
as.data.frame.CalGR <- function(x, row.names = NULL, ...) {
# if (inherits(x, "CalGR") | inherits(x, "SimGR"))) {
# stop("'InputsCrit' must be of class 'CalGR', 'SimGR'")
# }
TMGR <- .TypeModelGR(x)
myGR <- list()
myGR$FracSolid <- NA
myGR$TempMean <- NA
if (TMGR$CemaNeige) {
PrecipSol <- rowMeans(sapply(x$OutputsModel$CemaNeigeLayers, "[[", "Psol"), na.rm = TRUE)
PrecipSim <- rowMeans(sapply(x$OutputsModel$CemaNeigeLayers, "[[", "Pliq"), na.rm = TRUE) + PrecipSol
FracSolid <- PrecipSol / PrecipSim
FracSolid <- ifelse(is.na(FracSolid) & PrecipSol == 0 & PrecipSim == 0, 0, FracSolid)
myGR$FracSolid <- FracSolid
TempMean <- rowMeans(sapply(x$OutputsModel$CemaNeigeLayers, "[[", "Temp"), na.rm = TRUE)
myGR$TempMean <- TempMean
}
myGR$DatesR <- x$OutputsModel$DatesR
myGR$PotEvap <- x$OutputsModel$PotEvap
myGR$Precip <- x$OutputsModel$Precip
myGR$Qobs <- x$Qobs
myGR$Qsim <- x$OutputsModel$Qsim
TabSim <- data.frame(Dates = myGR$DatesR,
PotEvap = myGR$PotEvap,
PrecipObs = myGR$Precip,
PrecipFracSolid_CemaNeige = myGR$FracSolid,
TempMeanSim_CemaNeige = myGR$TempMean,
Qobs = myGR$Qobs,
Qsim = myGR$Qsim)
as.data.frame(x = TabSim, row.names = row.names, ...)
}
as.data.frame.SimGR <- as.data.frame.CalGR
as.data.frame.airGRt <- function(x, row.names = NULL, ...) {
if (!(inherits(x, "PrepGR") | inherits(x, "CalGR") | inherits(x, "SimGR"))) {
stop("'InputsCrit' must be of class 'PrepGR', 'CalGR', 'SimGR'")
}
TMGR <- .TypeModelGR(x)
myGR <- list()
myGR$FracSolid <- NA
myGR$TempMean <- NA
if (inherits(x, "PrepGR")) {
if (TMGR$CemaNeige) {
PrecipSol <- rowMeans(as.data.frame(x$InputsModel$LayerPrecip) * as.data.frame(x$InputsModel$LayerFracSolidPrecip), na.rm = TRUE)
PrecipSim <- rowMeans(as.data.frame(x$InputsModel$LayerPrecip), na.rm = TRUE)
FracSolid <- PrecipSol / PrecipSim
FracSolid <- ifelse(is.na(FracSolid) & PrecipSol == 0 & PrecipSim == 0, 0, FracSolid)
myGR$FracSolid <- FracSolid
TempMean <- rowMeans(as.data.frame(x$InputsModel$LayerTempMean), na.rm = TRUE)
myGR$TempMean <- TempMean
}
myGR$DatesR <- x$InputsModel$DatesR
myGR$PotEvap <- x$InputsModel$PotEvap
myGR$Precip <- x$InputsModel$Precip
myGR$Qobs <- x$Qobs
myGR$Qsim <- NA
}
if (inherits(x, "CalGR") | inherits(x, "SimGR")) {
if (TMGR$CemaNeige) {
PrecipSol <- rowMeans(sapply(x$OutputsModel$CemaNeigeLayers, "[[", "Psol"), na.rm = TRUE)
PrecipSim <- rowMeans(sapply(x$OutputsModel$CemaNeigeLayers, "[[", "Pliq"), na.rm = TRUE) + PrecipSol
FracSolid <- PrecipSol / PrecipSim
FracSolid <- ifelse(is.na(FracSolid) & PrecipSol == 0 & PrecipSim == 0, 0, FracSolid)
myGR$FracSolid <- FracSolid
TempMean <- rowMeans(sapply(x$OutputsModel$CemaNeigeLayers, "[[", "Temp"), na.rm = TRUE)
myGR$TempMean <- TempMean
}
myGR$DatesR <- x$OutputsModel$DatesR
myGR$PotEvap <- x$OutputsModel$PotEvap
myGR$Precip <- x$OutputsModel$Precip
myGR$Qobs <- x$Qobs
myGR$Qsim <- x$OutputsModel$Qsim
}
TabSim <- data.frame(Dates = myGR$DatesR,
PotEvap = myGR$PotEvap,
PrecipObs = myGR$Precip,
PrecipFracSolid_CemaNeige = myGR$FracSolid,
TempMeanSim_CemaNeige = myGR$TempMean,
Qobs = myGR$Qobs,
Qsim = myGR$Qsim)
as.data.frame(x = TabSim, row.names = row.names, ...)
}
\encoding{UTF-8}
\name{as.data.frame}
\alias{as.data.frame.airGRt}
\alias{as.data.frame.PrepGR}
\alias{as.data.frame.CalGR}
\alias{as.data.frame.SimGR}
\alias{as.data.frame}
......@@ -11,12 +13,16 @@
\usage{
\method{as.data.frame}{airGRt}(x, row.names = NULL, ...)
\method{as.data.frame}{PrepGR}(x, row.names = NULL, ...)
\method{as.data.frame}{CalGR}(x, row.names = NULL, ...)
\method{as.data.frame}{SimGR}(x, row.names = NULL, ...)
}
\arguments{
\item{x}{[object of class \emph{airGRt}] typically an object of class \code{\link{PrepGR}}, \code{\link{CalGR}} or \code{\link{SimGR}}}
\item{x}{[\code{\link{PrepGR}}], [\code{\link{CalGR}}] or [\code{\link{SimGR}}] objects}
\item{row.names}{\code{NULL} or a character vector giving the row names for the data.frame. Missing values are not allowed}
\item{...}{additional arguments to be passed to or from methods}
}
......
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