#' Outlier detection for price relatives
#'
#' Standard cutoff-based methods for detecting outliers with price relatives.
#'
#' This function constructs an interval of the form \eqn{[b_l(x) -
#' c_l \times l(x), b_u(x) + c_u \times u(x)]}{[bl(x) - cl * l(x), bu(x) + cu *
#' u(x)]} and assigns a value in `x` as `TRUE` if that value does not
#' belong to the interval, `FALSE` otherwise. The different methods differ in
#' how they construct the values \eqn{b_l(x)}{bl(x)}, \eqn{b_u(x)}{bu(x)},
#' \eqn{l(x)}, and \eqn{u(x)}. Any missing values in `x` are ignored when
#' calculating the interval, but will return `NA`.
#'
#' The quartile method and Tukey algorithm are described in paragraphs 5.113 to
#' 5.135 of the CPI manual (2020).
#' The resistant fences method is an alternative to the quartile method, and is
#' described by Rais (2008) and Hutton (2008). The Kimber method is yet another
#' alternative. Quantile-based methods often
#' identify price relatives as outliers because the distribution is
#' concentrated around 1; setting `scale > 0` puts a floor on the minimum
#' dispersion between quantiles as a fraction of the median. See the references
#' for more details.
# nolint start
#'
#' |                  | \eqn{b_l(x)}{bl(x)} | \eqn{b_u(x)}{bu(x)} | \eqn{l(x)}            | \eqn{u(x)}            |
#' | ---              | --                  | ---                 | ---                   | ---                   |
#' | Quartile         | \eqn{Q_2(x)}        | \eqn{Q_2(x)}        | \eqn{Q_2(x) - Q_1(x)} | \eqn{Q_3(x) - Q_2(x)} |
#' | Resistant fences | \eqn{Q_1(x)}        | \eqn{Q_3(x)}        | \eqn{Q_3(x) - Q_1(x)} | \eqn{Q_3(x) - Q_1(x)} |
#' | Kimber           | \eqn{Q_1(x)}        | \eqn{Q_3(x)}        | \eqn{Q_2(x) - Q_1(x)} | \eqn{Q_3(x) - Q_2(x)} |
#'
# nolint end
#' The robust Z-score is the usual method to identify relatives in the
#' (asymmetric) tails of the distribution, simply replacing the mean with the
#' median, and the standard deviation with the median absolute deviation.
#'
#' These methods often assume that price relatives are symmetrically
#' distributed (if not Gaussian). As the distribution of price relatives often
#' has a long right tail, the natural logarithm can be used to transform price
#' relative before identifying outliers (sometimes under the assumption that
#' price relatives are distributed log-normal). The Hidiroglou-Berthelot
#' transformation is another approach, described in the CPI manual (par.
#' 5.124). (Sometimes the transformed price relatives are multiplied by
#' \eqn{\max(p_1, p_0)^u}{max(p1, p0)^u}, for some
#' \eqn{0 \le u \le 1}{0 <= u <= 1}, so that products with a larger price
#' get flagged as outliers (par. 5.128).)
#'
#' @export
#'
#' @param x `[numeric > 0]` A numeric vector, usually of price relatives.
#'   These can be made with, e.g., [back_period()].
#' @param upper,lower `[numeric(1) > 0]` A number giving the upper and lower
#'   cutoffs for
#'   each element of `x`. By default the lower cutoff is the same as the upper
#'   cutoff
#' @param method `[character(1)]` The outlier detection method, one of
#'   `"quartile"` (the default), `"resistant-fences"`, `"kimber"`, `"robust-z"`,
#'   or `"tukey"`.
#' @param scale `[0 <= numeric(1) <= 1]` A number between 0 and 1 giving the
#'   scale factor for the
#'   median to establish the minimum dispersion between quartiles for each
#'   element of `x`. The default does not set a minimum dispersion.
#' @param quantile_type `[integer(1)]` See [quantile()].
#'
#' @returns
#' A logical vector, the same length as `x`, that is `TRUE` if the
#' corresponding element of `x` is identified as an outlier,
#' `FALSE` otherwise.
#'
#' @seealso
#' [back_period()] for a simple utility function to turn prices
#' in a table into price relatives.
#'
#' The `HBmethod()` function in the \pkg{univOutl} package for the
#' Hidiroglou-Berthelot method for identifying outliers.
#'
#' @references
#' Hutton, H. (2008). Dynamic outlier detection in price index surveys.
#' *Proceedings of the Survey Methods Section: Statistical Society of Canada
#' Annual Meeting*.
#'
#' IMF, ILO, Eurostat, UNECE, OECD, and World Bank. (2020).
#' *Consumer Price Index Manual: Concepts and Methods*.
#' International Monetary Fund.
#'
#' Rais, S. (2008). Outlier detection for the Consumer Price Index.
#' *Proceedings of the Survey Methods Section: Statistical Society of Canada
#' Annual Meeting*.
#'
#' @examples
#' x <- c(1, 10, 15, 100)
#'
#' outliers(x, upper = 2.5, method = "quartile")
#'
#' # Always identifies fewer outliers than above.
#' outliers(x, upper = 2.5, method = "resistant-fences")
outliers <- function(
  x,
  upper,
  lower = upper,
  method = c(
    "quartile",
    "resistant-fences",
    "kimber",
    "robust-z",
    "tukey"
  ),
  scale = 0,
  quantile_type = 7
) {
  method <- match.arg(method)
  x <- as.numeric(x)
  upper <- as.numeric(upper)
  if (upper < 0) {
    stop("`upper` must be greater than 0")
  }
  lower <- as.numeric(lower)
  if (lower < 0) {
    stop("`lower` must be greater than 0")
  }
  scale <- as.numeric(scale)
  if (scale < 0 || scale > 1) {
    stop("`scale` must be between 0 and 1")
  }
  if (method %in% c("quartile", "resistant-fences", "kimber")) {
    q <- stats::quantile(
      x,
      c(0.25, 0.5, 0.75),
      names = FALSE,
      na.rm = TRUE,
      type = quantile_type
    )
    if (method == "quartile") {
      u <- q[2L] + upper * pmax.int(q[3L] - q[2L], abs(scale * q[2L]))
      l <- q[2L] - lower * pmax.int(q[2L] - q[1L], abs(scale * q[2L]))
    } else if (method == "resistant-fences") {
      iqr <- pmax.int(q[3L] - q[1L], abs(scale * q[2L]))
      u <- q[3L] + upper * iqr
      l <- q[1L] - lower * iqr
    } else {
      u <- q[3L] + upper * pmax.int(q[3L] - q[2L], abs(scale * q[2L]))
      l <- q[1L] - lower * pmax.int(q[2L] - q[1L], abs(scale * q[2L]))
    }
  } else if (method == "robust-z") {
    med <- stats::quantile(
      x,
      0.5,
      names = FALSE,
      na.rm = TRUE,
      type = quantile_type
    )
    s <- pmax.int(stats::mad(x, med, na.rm = TRUE), abs(scale * med))
    u <- med + upper * s
    l <- med - lower * s
  } else if (method == "tukey") {
    q <- stats::quantile(
      x,
      c(0.05, 0.95),
      names = FALSE,
      na.rm = TRUE,
      type = quantile_type
    )
    tail <- x < q[1L] | x > q[2L]
    ts <- x[x != 1 & !tail]
    if (length(ts) == 0L) {
      return(tail)
    }
    # In some versions m is the median.
    m <- mean(ts, na.rm = TRUE)
    u <- min(m + upper * (mean(ts[ts >= m], na.rm = TRUE) - m), q[2L])
    l <- max(m - lower * (m - mean(ts[ts <= m], na.rm = TRUE)), q[1L])
  }
  x > u | x < l
}

#' HB transform
#' @rdname outliers
#' @export
hb_transform <- function(x) {
  x <- as.numeric(x)
  med <- stats::median(x, na.rm = TRUE)
  res <- 1 - med / x
  gemed <- which(x >= med)
  res[gemed] <- x[gemed] / med - 1
  res
}
