refactor: Change presentation of conversion dictionary in .AggregConvertFun

Refs #41

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)