diff --git a/R/Utils.R b/R/Utils.R index b90f8af5f89a3226c8c81530362949fb2c0b3a8e..4a0d5065c330cd89b87880e7f6fc89ac6e1e5251 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -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)