From a2592d9e18e42b13e0c80b720a22a6c3313e8979 Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.fr>
Date: Fri, 26 Mar 2021 14:27:50 +0100
Subject: [PATCH] feat(Utils): add tools to manage model prameters and time
steps - FeatModelsGR.csv: model features - .FeatModels: return a table with
model features - .GetFeatModel: get model features Refs #106
---
NAMESPACE | 1 +
R/Utils.R | 41 ++++++++++++++++++++++++++++
inst/modelsFeatures/FeatModelsGR.csv | 14 ++++++++++
3 files changed, 56 insertions(+)
create mode 100644 inst/modelsFeatures/FeatModelsGR.csv
diff --git a/NAMESPACE b/NAMESPACE
index c98743b3..9cf8783b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -66,6 +66,7 @@ export(TransfoParam_GR5J)
export(TransfoParam_GR6J)
export(TransfoParam_Lag)
export(.ErrorCrit)
+export(.FeatModels)
#####################################
diff --git a/R/Utils.R b/R/Utils.R
index 79bc41e5..248a0f19 100644
--- a/R/Utils.R
+++ b/R/Utils.R
@@ -13,6 +13,47 @@
+## =================================================================================
+## function to extract model features
+## =================================================================================
+
+## table of feature models
+.FeatModels <- function() {
+ path <- system.file("modelsFeatures/FeatModelsGR.csv", package = "airGR")
+ read.table(path, header = TRUE, sep = ";")
+}
+
+
+## function to extract model features
+.GetFeatModel <- function(FUN_MOD) {
+ FeatMod <- .FeatModels()
+ FUN_MOD <- match.fun(FUN_MOD)
+ NameFunMod <- ifelse(test = FeatMod$Class %in% "GR",
+ yes = paste("RunModel", FeatMod$NameMod, sep = "_"),
+ no = FeatMod$NameMod)
+ FunMod <- lapply(NameFunMod, FUN = get)
+ IdMod <- which(sapply(FunMod, FUN = function(x) identical(FUN_MOD, x)))
+ if (length(IdMod) < 1) {
+ stop("'FUN_MOD' must be one of ", paste(NameFunMod, collapse = ", "))
+ } else {
+ res <- as.list(FeatMod[IdMod, ])
+ res$NameFunMod <- NameFunMod[IdMod]
+ res$TimeStep <- switch(res$TimeUnit,
+ hourly = 1,
+ daily = 24,
+ monthly = 28:31,
+ yearly = 365:366)
+ res$TimeStep <- res$TimeStep * 3600
+ res$Class <- c(res$TimeUnit, res$Class)
+ if (grepl("CemaNeige", res$NameFunMod)) {
+ res$Class <- c(res$Class, "CemaNeige")
+ }
+ return(res)
+ }
+}
+
+
+
## =================================================================================
## function to manage Fortran outputs
## =================================================================================
diff --git a/inst/modelsFeatures/FeatModelsGR.csv b/inst/modelsFeatures/FeatModelsGR.csv
new file mode 100644
index 00000000..482f6b13
--- /dev/null
+++ b/inst/modelsFeatures/FeatModelsGR.csv
@@ -0,0 +1,14 @@
+CodeMod;NameMod;NbParam;TimeUnit;Id;Class;Pkg
+GR1A;GR1A;1;yearly;NA;GR;airGR
+GR2M;GR2M;2;monthly;NA;GR;airGR
+GR4J;GR4J;4;daily;NA;GR;airGR
+GR5J;GR5J;5;daily;NA;GR;airGR
+GR6J;GR6J;6;daily;NA;GR;airGR
+GR4H;GR4H;4;hourly;NA;GR;airGR
+GR5H;GR5H;5;hourly;NA;GR;airGR
+CemaNeige;CemaNeige;2;NA;NA;GR;airGR
+CemaNeigeGR4J;CemaNeigeGR4J;6;daily;NA;GR;airGR
+CemaNeigeGR5J;CemaNeigeGR5J;7;daily;NA;GR;airGR
+CemaNeigeGR6J;CemaNeigeGR6J;8;daily;NA;GR;airGR
+CemaNeigeGR4H;CemaNeigeGR4H;6;hourly;NA;GR;airGR
+CemaNeigeGR5H;CemaNeigeGR5H;7;hourly;NA;GR;airGR
--
GitLab