#' Aggregate a price index over subperiods
#'
#' Aggregate an index over subperiods by taking the (usually arithmetic) mean
#' of index values over consecutive windows of subperiods.
#'
#' The `mean()` method constructs a set of non-overlapping windows of
#' length `window`, starting in the first period of the index, and takes
#' the mean of each index value in these windows for each level of the index.
#' The last window is discarded if it is incomplete (with a warning), so that
#' index values are
#' always averaged over `window` periods. The names for the first time
#' period in each window form the new names for the aggregated time periods.
#'
#' Percent-change contributions are aggregated if `contrib = TRUE` following the
#' same approach as [`aggregate()`][aggregate.piar_index].
#'
#' An optional vector of weights can be specified when aggregating index values
#' over subperiods, which is often useful when aggregating a Paasche index; see
#' section 4.3 of Balk (2008) for details.
#'
#' @name mean.piar_index
#' @aliases mean.piar_index
#' @family index methods
#' @export
#'
#' @param x `[piar_index]` A price index, as made by,
#'   e.g., [elementary_index()].
#' @param weights `[numeric >= 0]` A numeric vector of weights for the index
#'   values in `x`, or
#'   something that can be coerced into one. The
#'   default is equal weights. It is usually easiest to specify these weights as
#'   a matrix with a row for each index value in `x` and a column for each
#'   time period.
#' @param window `[integer(1) > 0]` A positive integer giving the size of the
#'   window used to
#'   average index values across subperiods. The default averages over all
#'   periods in `x`. Non-integers are truncated towards 0.
#' @param na.rm `[logical(1)]` Should missing values be removed? By default,
#'   missing values
#'   are not removed. Setting `na.rm = TRUE` is equivalent to overall-mean
#'   imputation.
#' @param order `[numeric(1)]` Order of the generalized mean to aggregate
#'   index values. 0 for a
#'   geometric index (the default for making elementary indexes), 1 for an
#'   arithmetic index (the default for aggregating elementary indexes and
#'   averaging indexes over subperiods), or -1 for a harmonic index (usually for
#'   a Paasche index). Other values are possible; see
#'   [gmean()] for details.
#' @param contrib `[logical(1)]` Aggregate percent-change contributions in `x`?
#'   By default contributions are aggregated.
#' @param ... Not currently used.
#' @param duplicate_contrib `[character(1)]` The method to deal with duplicate
#'   product contributions. Either `"make.unique"` to make duplicate product
#'   names unique with [make.unique()] or `"sum"` to add contributions for the
#'   same products across subperiods (the default).
#' @param r Deprecated.
#'
#' @returns
#' A price index, averaged over subperiods, that inherits from the same
#' class as `x`.
#'
#' @references
#' Balk, B. M. (2008). *Price and Quantity Index Numbers*.
#' Cambridge University Press.
#'
#' @examples
#' index <- as_index(matrix(c(1:12, 12:1), 2, byrow = TRUE), chainable = FALSE)
#'
#' # Turn a monthly index into a quarterly index.
#' mean(index, window = 3)
mean.chainable_piar_index <- function(
  x,
  ...,
  weights = NULL,
  window = NULL,
  na.rm = FALSE,
  contrib = TRUE,
  order = 1,
  r = order,
  duplicate_contrib = c("sum", "make.unique")
) {
  chkDots(...)
  if ("r" %in% names(sys.call())) {
    warning("`r` is deprecated and will be removed; use `order` instead")
  }
  mean_index(
    x,
    weights,
    window = window,
    na.rm = na.rm,
    contrib = contrib,
    order = r,
    chainable = TRUE,
    duplicate_contrib = match.arg(duplicate_contrib)
  )
}

#' @rdname mean.piar_index
#' @export
mean.direct_piar_index <- function(
  x,
  ...,
  weights = NULL,
  window = NULL,
  na.rm = FALSE,
  contrib = TRUE,
  order = 1,
  r = order,
  duplicate_contrib = c("sum", "make.unique")
) {
  chkDots(...)
  if ("r" %in% names(sys.call())) {
    warning("`r` is deprecated and will be removed; use `order` instead")
  }
  mean_index(
    x,
    weights,
    window = window,
    na.rm = na.rm,
    contrib = contrib,
    order = r,
    chainable = FALSE,
    duplicate_contrib = match.arg(duplicate_contrib)
  )
}

#' Internal function to aggregate over subperiods
#' @noRd
mean_index <- function(
  x,
  weights,
  window,
  na.rm,
  contrib,
  order,
  chainable,
  duplicate_contrib
) {
  if (!is.null(weights)) {
    weights <- as.numeric(weights)
    if (any(weights < 0, na.rm = TRUE)) {
      stop("all elements of `weights` must be non-negative")
    }
    if (length(weights) != ntime(x) * nlevels(x)) {
      stop("`weights` must have a value for each index value in 'x'")
    }
    dim(weights) <- c(nlevels(x), ntime(x))
  }

  order <- as.numeric(order)
  window <- as.integer(window %||% ntime(x))
  if (window < 1L) {
    stop("`window` must be a positive integer")
  }
  if (window > ntime(x)) {
    stop("`x` must have at least `window` time periods")
  }

  # Get the starting location for each window.
  if (ntime(x) %% window != 0) {
    warning("`window` is not a multiple of the number of time periods in `x`")
  }
  len <- ntime(x) %/% window
  loc <- seq.int(1L, by = window, length.out = len)
  periods <- x$time[loc]

  has_contrib <- !is.null(x$contrib) && contrib
  # Loop over each window and calculate the mean for each level.
  res <- contrib <- vector("list", length(periods))
  rows <- seq_len(nlevels(x))
  w <- list(NULL)
  for (i in seq_along(loc)) {
    j <- seq(loc[i], length.out = window)
    rel <- split_rows(x$index[, j, drop = FALSE], rows)
    if (!is.null(weights)) {
      w <- split_rows(weights[, j, drop = FALSE], rows)
    }
    res[[i]] <- mapply(gmean, rel, w, order, na.rm = na.rm, USE.NAMES = FALSE)
    if (has_contrib) {
      con <- split_rows(x$contrib[, j, drop = FALSE], rows)
      contrib[[i]] <- mapply(
        aggregate_contrib,
        con,
        rel,
        w,
        order,
        res[[i]],
        duplicate_contrib,
        SIMPLIFY = FALSE,
        USE.NAMES = FALSE
      )
    }
  }

  piar_index(
    do.call(cbind, res),
    do.call(cbind, contrib),
    x$levels,
    periods,
    chainable = chainable
  )
}
