Commit f60e0203 authored by Dorchies David's avatar Dorchies David
Browse files

refactor: Change presentation of conversion dictionary in .AggregConvertFun

Refs #41
parent 70e1f185
Pipeline #17708 passed with stages
in 11 minutes and 51 seconds
......@@ -18,17 +18,18 @@
## =================================================================================
.AggregConvertFun <- function(Outputs) {
Table <- list(
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"),
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")
Table <- rbind(
data.frame(ConvertFun = "mean",
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) {
iRes <- Table$ConvertFun[Table$Outputs == iOutputs]
# iRes <- Table$ConvertFun[pmatch(iOutputs, Table$Outputs)]
iRes <- ifelse(any(is.na(iRes)), NA, iRes)
})
return(res)
......@@ -41,10 +42,10 @@
## =================================================================================
.FortranOutputs <- function(GR = NULL, isCN = FALSE) {
outGR <- NULL
outCN <- NULL
if (is.null(GR)) {
GR <- ""
}
......@@ -62,7 +63,7 @@
"AE", "EI", "ES",
"Perc", "PR",
"Q9", "Q1",
"Rout", "Exch",
"Rout", "Exch",
"AExch1", "AExch2",
"AExch", "QR",
"QD",
......@@ -72,7 +73,7 @@
"AE",
"Perc", "PR",
"Q9", "Q1",
"Rout", "Exch",
"Rout", "Exch",
"AExch1", "AExch2",
"AExch", "QR",
"QD",
......@@ -90,14 +91,14 @@
"Qsim")
}
if (isCN) {
outCN <- c("Pliq", "Psol",
"SnowPack", "ThermalState", "Gratio",
"PotMelt", "Melt", "PliqAndMelt", "Temp",
outCN <- c("Pliq", "Psol",
"SnowPack", "ThermalState", "Gratio",
"PotMelt", "Melt", "PliqAndMelt", "Temp",
"Gthreshold", "Glocalmax")
}
res <- list(GR = outGR, CN = outCN)
}
......@@ -107,7 +108,7 @@
## =================================================================================
.ErrorCrit <- function(InputsCrit, Crit, OutputsModel, warnings) {
## Arguments check
if (!inherits(InputsCrit, "InputsCrit")) {
stop("'InputsCrit' must be of class 'InputsCrit'", call. = FALSE)
......@@ -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)
}
}
## Initialisation
CritName <- NA
CritVar <- InputsCrit$VarObs
......@@ -147,8 +148,8 @@
CritBestValue <- +1
Multiplier <- -1
}
## Data preparation
VarObs <- InputsCrit$Obs
VarObs[!InputsCrit$BoolCrit] <- NA
......@@ -162,8 +163,8 @@
VarSim <- rowMeans(sapply(OutputsModel$CemaNeigeLayers[InputsCrit$idLayer], FUN = "[[", "SnowPack"))
}
VarSim[!InputsCrit$BoolCrit] <- NA
## Data transformation
if (InputsCrit$transfo %in% c("log", "inv") & is.null(InputsCrit$epsilon) & warnings) {
if (any(VarObs %in% 0)) {
......@@ -171,7 +172,7 @@
}
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)
}
}
}
if ("epsilon" %in% names(InputsCrit) & !is.null(InputsCrit$epsilon) & !(InputsCrit$transfo == "boxcox")) {
VarObs <- VarObs + InputsCrit$epsilon
......@@ -206,15 +207,15 @@
VarObs <- VarObs^transfoPow
VarSim <- VarSim^transfoPow
}
## TS_ignore
TS_ignore <- !is.finite(VarObs) | !is.finite(VarSim) | !InputsCrit$BoolCrit
Ind_TS_ignore <- which(TS_ignore)
if (length(Ind_TS_ignore) == 0) {
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
} else {
CritCompute <- TRUE
......@@ -234,16 +235,16 @@
if (sum(!TS_ignore) < WarningTS & warnings) {
warning("\t criterion computed on less than ", WarningTS, " time-steps", call. = FALSE)
}
## Outputs
OutputsCritCheck <- list(WarningTS = WarningTS,
VarObs = VarObs,
VarSim = VarSim,
CritBestValue = CritBestValue,
Multiplier = Multiplier,
CritName = CritName,
CritVar = CritVar,
VarObs = VarObs,
VarSim = VarSim,
CritBestValue = CritBestValue,
Multiplier = Multiplier,
CritName = CritName,
CritVar = CritVar,
CritCompute = CritCompute,
TS_ignore = TS_ignore,
Ind_TS_ignore = Ind_TS_ignore)
......
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