UtilsSeriesAggreg.R

getSeriesAggregFormat <- function(NewTimeFormat) {
  errNewTimeFormat <- FALSE
  if (missing(NewTimeFormat)) {
    errNewTimeFormat <- TRUE
  } else if (is.null(NewTimeFormat)) {
    errNewTimeFormat <- TRUE
  }
  if (errNewTimeFormat) {
    stop("Argument `Format` is missing")
  }
  if (!is.null(NewTimeFormat)) {
    TimeStep <- c("hourly", "daily", "monthly", "yearly")
    NewTimeFormat <- match.arg(NewTimeFormat, choices = TimeStep)
    Format <- switch(NewTimeFormat,
                     hourly  = "%Y%m%d%h",
                     daily   = "%Y%m%d",
                     monthly = "%Y%m",
                     yearly  = "%Y")
    msgNewTimeFormat <- sprintf("'Format' automatically set to %s", sQuote(Format))
    warning("deprecated 'NewTimeFormat' argument: please use 'Format' instead.",
            msgNewTimeFormat,
            call. = FALSE)
    return(Format)
  }
  return(NULL)
}

getSeriesAggregClass <- function(Format) {
  Format <- substr(Format,
                   start = nchar(Format),
                   stop = nchar(Format))
  switch(Format,
         h = "hourly",
         d = "daily",
         m = "monthly",
         Y = "yearly")
}

.AggregConvertFunTable <- rbind(
  data.frame(ConvertFun = "mean",
             Outputs = c("Prod","Rout","Exp","SnowPack","ThermalState",
                         "Gratio","Temp","Gthreshold","Glocalmax","LayerTempMean", "T"),
             stringsAsFactors = FALSE), # R < 4.0 compatibility: avoids mixing numeric and factor into numeric in getAggregConvertFun()
  data.frame(ConvertFun = "sum",
             Outputs = c("PotEvap","Precip","Pn","Ps","AE","Perc","PR","Q9",
                         "Q1","Exch","AExch1","AExch2","AExch","QR","QRExp",
                         "QD","Qsim","Pliq","Psol","PotMelt","Melt","PliqAndMelt",
                         "LayerPrecip","LayerFracSolidPrecip", "Qmm", "Qls", "E", "P", "Qupstream"),
             stringsAsFactors = FALSE) # R < 4.0 compatibility: avoids mixing numeric and factor into numeric in getAggregConvertFun()
)

getAggregConvertFun <- function(Outputs) {
  res <- sapply(Outputs, function(iOutputs) {
    iRes <- .AggregConvertFunTable$ConvertFun[.AggregConvertFunTable$Outputs == iOutputs]
    iRes <- ifelse(test = any(is.na(iRes)), yes = NA, no = iRes) # R < 4.0 compatibility
  })
  if (length(res) > 0) {
    message("Variables automatically aggregated as follow:")
    widthMsg <- max(nchar(c(names(res), res)), na.rm = TRUE) + 1 + 2
    message(format(names(res)  , width = widthMsg, justify = "right"))
    message(format(shQuote(res), width = widthMsg, justify = "right"))
  }
  return(res)
}