Skip to content
GitLab
Commit f60e0203 authored by Dorchies David's avatar Dorchies David
Browse files

refactor: Change presentation of conversion dictionary in .AggregConvertFun 

Refs #41
parent 70e1f185
dev 115-add-pcict-date-format-managment 118-plot-outputsmodel-remove-case-sensitivity-to-the-which-argument 136-decreased-performance-of-calibration-execution-time 161-runmodel_lag-proposal-for-a-better-transformation-and-screening-of-the-parameters 165-add-missing-isintstore-argument-in-createcaliboptions 171-check-error-direct-call-of-as-data-frame-posixct-is-deprecated-use-as-data-frame-vector-or-as 191-speed-up-runmodel_lag-when-it-is-used-alone 33-merge-airgr-and-airgrplus-functions 96-parallelize-the-grid-screening-step-during-calibration master rmOptions CRAN_v1.7.6 CRAN_v1.7.5 CRAN_v1.7.4 CRAN_v1.7.3 CRAN_v1.7.2 CRAN_v1.7.1 CRAN_v1.7.0 CRAN_v1.6.12 CRAN_v1.6.11 CRAN_v1.6.10.4 CRAN_v1.6.9.27 CRAN_v1.6.9.24 CRAN_v1.6.9.23 CRAN_v1.6.9.21
2 merge requests!26CRAN v1.6.9.21,!12New series aggreg
Pipeline #17708 passed with stages
in 11 minutes and 51 seconds
Hide whitespace changes
Inline Side-by-side
Showing
with 37 additions and 36 deletions
+37 -36
R/Utils.R
+ 37
− 36
View file @ f60e0203
...@@ -18,17 +18,18 @@ ...@@ -18,17 +18,18 @@
## ================================================================================= ## =================================================================================
.AggregConvertFun <- function(Outputs) { .AggregConvertFun <- function(Outputs) {
Table <- list( Table <- rbind(
Outputs = c("zzz", "PotEvap", "Precip", "Prod", "Pn", "Ps", "AE", "Perc", "PR", "Q9", "Q1", "Rout", "Exch", "AExch1", "AExch2", "AExch", "QR", "QRExp", "Exp", "QD", "Qsim", "Pliq", "Psol", "SnowPack", "ThermalState", "Gratio", "PotMelt", "Melt", "PliqAndMelt", "Temp", "Gthreshold", "Glocalmax", "LayerPrecip", "LayerTempMean", "LayerFracSolidPrecip"), data.frame(ConvertFun = "mean",
ConvertFun = c("sum", "sum", "sum", "mean", "sum", "sum", "sum", "sum", "sum", "sum", "sum", "mean", "sum", "sum", "sum", "sum", "sum", "sum", "mean", "sum", "sum", "sum", "sum", "mean", "mean", "mean", "sum", "sum", "sum", "mean", "mean", "mean", "sum", "mean", "sum") Outputs = c("Prod","Rout","Exp","SnowPack","ThermalState",
"Gratio","Temp","Gthreshold","Glocalmax","LayerTempMean")),
data.frame(ConvertFun = "sum",
Outputs = c("zzz","PotEvap","Precip","Pn","Ps","AE","Perc","PR","Q9",
"Q1","Exch","AExch1","AExch2","AExch","QR","QRExp",
"QD","Qsim","Pliq","Psol","PotMelt","Melt","PliqAndMelt",
"LayerPrecip","LayerFracSolidPrecip"))
) )
if (length(Table$Outputs) != length(Table$ConvertFun)) {
stop("'.AggregConvertFun' is out of order")
}
match.arg(Outputs, choices = Table$Outputs, several.ok = TRUE)
res <- sapply(Outputs, function(iOutputs) { res <- sapply(Outputs, function(iOutputs) {
iRes <- Table$ConvertFun[Table$Outputs == iOutputs] iRes <- Table$ConvertFun[Table$Outputs == iOutputs]
# iRes <- Table$ConvertFun[pmatch(iOutputs, Table$Outputs)]
iRes <- ifelse(any(is.na(iRes)), NA, iRes) iRes <- ifelse(any(is.na(iRes)), NA, iRes)
}) })
return(res) return(res)
...@@ -41,10 +42,10 @@ ...@@ -41,10 +42,10 @@
## ================================================================================= ## =================================================================================
.FortranOutputs <- function(GR = NULL, isCN = FALSE) { .FortranOutputs <- function(GR = NULL, isCN = FALSE) {
outGR <- NULL outGR <- NULL
outCN <- NULL outCN <- NULL
if (is.null(GR)) { if (is.null(GR)) {
GR <- "" GR <- ""
} }
...@@ -62,7 +63,7 @@ ...@@ -62,7 +63,7 @@
"AE", "EI", "ES", "AE", "EI", "ES",
"Perc", "PR", "Perc", "PR",
"Q9", "Q1", "Q9", "Q1",
"Rout", "Exch", "Rout", "Exch",
"AExch1", "AExch2", "AExch1", "AExch2",
"AExch", "QR", "AExch", "QR",
"QD", "QD",
...@@ -72,7 +73,7 @@ ...@@ -72,7 +73,7 @@
"AE", "AE",
"Perc", "PR", "Perc", "PR",
"Q9", "Q1", "Q9", "Q1",
"Rout", "Exch", "Rout", "Exch",
"AExch1", "AExch2", "AExch1", "AExch2",
"AExch", "QR", "AExch", "QR",
"QD", "QD",
...@@ -90,14 +91,14 @@ ...@@ -90,14 +91,14 @@
"Qsim") "Qsim")
} }
if (isCN) { if (isCN) {
outCN <- c("Pliq", "Psol", outCN <- c("Pliq", "Psol",
"SnowPack", "ThermalState", "Gratio", "SnowPack", "ThermalState", "Gratio",
"PotMelt", "Melt", "PliqAndMelt", "Temp", "PotMelt", "Melt", "PliqAndMelt", "Temp",
"Gthreshold", "Glocalmax") "Gthreshold", "Glocalmax")
} }
res <- list(GR = outGR, CN = outCN) res <- list(GR = outGR, CN = outCN)
} }
...@@ -107,7 +108,7 @@ ...@@ -107,7 +108,7 @@
## ================================================================================= ## =================================================================================
.ErrorCrit <- function(InputsCrit, Crit, OutputsModel, warnings) { .ErrorCrit <- function(InputsCrit, Crit, OutputsModel, warnings) {
## Arguments check ## Arguments check
if (!inherits(InputsCrit, "InputsCrit")) { if (!inherits(InputsCrit, "InputsCrit")) {
stop("'InputsCrit' must be of class 'InputsCrit'", call. = FALSE) stop("'InputsCrit' must be of class 'InputsCrit'", call. = FALSE)
...@@ -119,8 +120,8 @@ ...@@ -119,8 +120,8 @@
stop(paste0("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' or 'Compo' with ", Crit), call. = FALSE) stop(paste0("'InputsCrit' must be of class 'Single'. Use the 'ErrorCrit' function on objects of class 'Multi' or 'Compo' with ", Crit), call. = FALSE)
} }
} }
## Initialisation ## Initialisation
CritName <- NA CritName <- NA
CritVar <- InputsCrit$VarObs CritVar <- InputsCrit$VarObs
...@@ -147,8 +148,8 @@ ...@@ -147,8 +148,8 @@
CritBestValue <- +1 CritBestValue <- +1
Multiplier <- -1 Multiplier <- -1
} }
## Data preparation ## Data preparation
VarObs <- InputsCrit$Obs VarObs <- InputsCrit$Obs
VarObs[!InputsCrit$BoolCrit] <- NA VarObs[!InputsCrit$BoolCrit] <- NA
...@@ -162,8 +163,8 @@ ...@@ -162,8 +163,8 @@
VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack")) VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack"))
} }
VarSim[!InputsCrit$BoolCrit] <- NA VarSim[!InputsCrit$BoolCrit] <- NA
## Data transformation ## Data transformation
if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) { if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) {
if (any(VarObs %in% 0)) { if (any(VarObs %in% 0)) {
...@@ -171,7 +172,7 @@ ...@@ -171,7 +172,7 @@
} }
if (any(VarSim %in% 0)) { if (any(VarSim %in% 0)) {
warning("zeroes detected in 'Qsim': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE) warning("zeroes detected in 'Qsim': the corresponding time-steps will be excluded from the criteria computation if the epsilon argument of 'CreateInputsCrit' = NULL", call. = FALSE)
} }
} }
if ("epsilon" %in% names(InputsCrit) & !is.null(InputsCrit$epsilon) & !(InputsCrit$transfo == "boxcox")) { if ("epsilon" %in% names(InputsCrit) & !is.null(InputsCrit$epsilon) & !(InputsCrit$transfo == "boxcox")) {
VarObs <- VarObs + InputsCrit$epsilon VarObs <- VarObs + InputsCrit$epsilon
...@@ -206,15 +207,15 @@ ...@@ -206,15 +207,15 @@
VarObs <- VarObs^transfoPow VarObs <- VarObs^transfoPow
VarSim <- VarSim^transfoPow VarSim <- VarSim^transfoPow
} }
## TS_ignore ## TS_ignore
TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit
Ind_TS_ignore <- which(TS_ignore) Ind_TS_ignore <- which(TS_ignore)
if (length(Ind_TS_ignore) == 0) { if (length(Ind_TS_ignore) == 0) {
Ind_TS_ignore <- NULL Ind_TS_ignore <- NULL
} }
if (sum(!TS_ignore) == 0 | (sum(!TS_ignore) == 1 & Crit %in% c("KGE", "KGE2"))) { if (sum(!TS_ignore) == 0 | (sum(!TS_ignore) == 1 & Crit %in% c("KGE", "KGE2"))) {
CritCompute <- FALSE CritCompute <- FALSE
} else { } else {
CritCompute <- TRUE CritCompute <- TRUE
...@@ -234,16 +235,16 @@ ...@@ -234,16 +235,16 @@
if (sum(!TS_ignore) < WarningTS & warnings) { if (sum(!TS_ignore) < WarningTS & warnings) {
warning("\t criterion computed on less than ", WarningTS, " time-steps", call. = FALSE) warning("\t criterion computed on less than ", WarningTS, " time-steps", call. = FALSE)
} }
## Outputs ## Outputs
OutputsCritCheck <- list(WarningTS = WarningTS, OutputsCritCheck <- list(WarningTS = WarningTS,
VarObs = VarObs, VarObs = VarObs,
VarSim = VarSim, VarSim = VarSim,
CritBestValue = CritBestValue, CritBestValue = CritBestValue,
Multiplier = Multiplier, Multiplier = Multiplier,
CritName = CritName, CritName = CritName,
CritVar = CritVar, CritVar = CritVar,
CritCompute = CritCompute, CritCompute = CritCompute,
TS_ignore = TS_ignore, TS_ignore = TS_ignore,
Ind_TS_ignore = Ind_TS_ignore) Ind_TS_ignore = Ind_TS_ignore)
......
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