SeriesAggreg.list.R

SeriesAggreg.list <- function(x,
                              Format,
                              ConvertFun,
                              NewTimeFormat = NULL,
                              simplify = FALSE,
                              except = NULL,
                              recursive = TRUE,
                              ...) {
  if (missing(Format)) {
    Format <- getSeriesAggregFormat(NewTimeFormat)
  } else if (!is.null(NewTimeFormat)) {
    warning("deprecated 'NewTimeFormat' argument: 'Format' argument is used instead",
            call. = FALSE)
  }

  # Determination of DatesR
  if (!is.null(x$DatesR)) {
    if (!inherits(x$DatesR, "POSIXt")) {
      stop("'x$DatesR' should be of class 'POSIXt'")
    }
    DatesR <- x$DatesR
  } else {
    # Auto-detection of POSIXt item in Tabseries
    itemPOSIXt <-
      which(sapply(x, function(x) {
        inherits(x, "POSIXt")
      }, simplify = TRUE))[1]
    if (is.na(itemPOSIXt)) {
      stop("At least one item of argument 'x' should be of class 'POSIXt'")
    }
    warning("Item 'DatesR' not found in 'x' argument: the item ",
            names(x)[itemPOSIXt],
            " has been automatically chosen")
    DatesR <- x[[names(x)[itemPOSIXt]]]
  }

  # Selection of numeric items for aggregation
  numericCols <- names(which(sapply(x, inherits, "numeric")))
  arrayCols <- names(which(sapply(x, inherits, "array")))
  numericCols <- setdiff(numericCols, arrayCols)
  if (!is.null(except)) {
    if (!inherits(except, "character")) {
      stop("Argument 'except' should be a 'character'")
    }
    numericCols <- setdiff(numericCols, except)
  }

  cols <- x[numericCols]
  lengthCols <- sapply(cols, length, simplify = TRUE)
  if (any(lengthCols != length(DatesR))) {
    sErr <- paste0(names(lengthCols)[lengthCols != length(DatesR)],
                   " (", lengthCols[lengthCols != length(DatesR)], ")",
                   collapse = ", ")
    warning("The length of the following `numeric` items in 'x' ",
            "is different than the length of 'DatesR (",
            length(DatesR),
            ")': they will be ignored in the aggregation: ",
            sErr)
    cols <- cols[lengthCols == length(DatesR)]
  }
  dfOut <- NULL
  if (length(cols)) {
    ConvertFun2 <- getAggregConvertFun(names(cols))
    if (is.null(recursive)) {
      if (missing(ConvertFun)) {
        stop("'ConvertFun' argument should provided if 'recursive = NULL'")
      } else if (!is.na(ConvertFun)) {
        ConvertFun2 <- rep(ConvertFun, length(cols))
      }
    }