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
2 merge requests!17CRAN v0.2.11,!16Resolve "Set as.data.frame method for 'PrepGR', 'CalGR' and 'SimGR' classes"
Pipeline #23867 passed with stage
in 5 minutes and 36 seconds
Showing with 106 additions and 66 deletions
+106 -66
...@@ -2,7 +2,7 @@ Package: airGRteaching ...@@ -2,7 +2,7 @@ Package: airGRteaching
Type: Package Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included) Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
Version: 0.2.11 Version: 0.2.11
Date: 2021-06-04 Date: 2021-06-07
Authors@R: c( Authors@R: c(
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"), 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")), person("Laurent", "Coron", role = c("aut"), comment = c(ORCID = "0000-0002-1503-6204")),
......
...@@ -4,7 +4,9 @@ ...@@ -4,7 +4,9 @@
##################################### #####################################
## S3 methods ## ## 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, default)
S3method(dyplot, PrepGR) S3method(dyplot, PrepGR)
S3method(dyplot, CalGR) S3method(dyplot, CalGR)
...@@ -46,4 +48,4 @@ importFrom(shinyjs, useShinyjs) ...@@ -46,4 +48,4 @@ importFrom(shinyjs, useShinyjs)
importFrom(shinyjs, enable) importFrom(shinyjs, enable)
importFrom(shinyjs, disable) importFrom(shinyjs, disable)
import(markdown) import(markdown)
importFrom(plotrix, boxed.labels) importFrom(plotrix, boxed.labels)
\ No newline at end of file
...@@ -4,12 +4,18 @@ ...@@ -4,12 +4,18 @@
### 0.2.11 Release Notes (2021-06-04) ### 0.2.11 Release Notes (2021-06-07)
#### Bug fixes #### 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)) - 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 @@ ________________________________________________________________________________ ...@@ -23,7 +29,7 @@ ________________________________________________________________________________
#### Bug fixes #### 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 #### User-visible changes
......
...@@ -80,7 +80,7 @@ CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"), ...@@ -80,7 +80,7 @@ CalGR <- function(PrepGR, CalCrit = c("NSE", "KGE", "KGE2", "RMSE"),
TypeModel = PrepGR$TypeModel, CalCrit = CalCrit, TypeModel = PrepGR$TypeModel, CalCrit = CalCrit,
PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"), PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"),
Run = CalPer)) Run = CalPer))
class(CalGR) <- c("CalGR", "GR", "airGRt") class(CalGR) <- c("CalGR", "GR")
return(CalGR) return(CalGR)
} }
...@@ -67,7 +67,7 @@ PrepGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Q ...@@ -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) PrepGR <- list(InputsModel = MOD_obs, Qobs = ObsDF$Qobs, TypeModel = TypeModel)
class(PrepGR) <- c("PrepGR", "GR", "airGRt") class(PrepGR) <- c("PrepGR", "GR")
return(PrepGR) return(PrepGR)
} }
...@@ -103,7 +103,7 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2", ...@@ -103,7 +103,7 @@ SimGR <- function(PrepGR, CalGR = NULL, Param, EffCrit = c("NSE", "KGE", "KGE2",
CalCrit = CalGR$CalCrit, EffCrit = CRT, CalCrit = CalGR$CalCrit, EffCrit = CRT,
PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"), PeriodModel = list(WarmUp = as.POSIXct(PrepGR$InputsModel$DatesR[range(MOD_opt$IndPeriod_WarmUp)], tz = "UTC"),
Run = SimPer)) Run = SimPer))
class(SimGR) <- c("SimGR", "GR", "airGRt") class(SimGR) <- c("SimGR", "GR")
return(SimGR) 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} \encoding{UTF-8}
\name{as.data.frame} \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} \alias{as.data.frame}
...@@ -11,12 +13,16 @@ ...@@ -11,12 +13,16 @@
\usage{ \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{ \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{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} \item{...}{additional arguments to be passed to or from methods}
} }
......
Supports Markdown
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