Add coefficient of variation function

Related to #232, easystats/performance#433

Author: bwiernik

DESCRIPTION

@@ -62,7 +62,7 @@ VignetteBuilder:
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.1.9000
 Config/testthat/edition: 3
 Config/Needs/website:
     rstudio/bslib,

NAMESPACE

@@ -20,6 +20,8 @@ S3method(center,factor)
 S3method(center,grouped_df)
 S3method(center,logical)
 S3method(center,numeric)
+S3method(coef_var,default)
+S3method(coef_var,numeric)
 S3method(convert_na_to,character)
 S3method(convert_na_to,data.frame)
 S3method(convert_na_to,default)
@@ -158,13 +160,15 @@ export(center)
 export(centre)
 export(change_code)
 export(change_scale)
+export(coef_var)
 export(coerce_to_numeric)
 export(colnames_to_row)
 export(column_as_rownames)
 export(compact_character)
 export(compact_list)
 export(convert_na_to)
 export(convert_to_na)
+export(cv)
 export(data_addprefix)
 export(data_addsuffix)
 export(data_adjust)
@@ -195,6 +199,7 @@ export(degroup)
 export(demean)
 export(describe_distribution)
 export(detrend)
+export(distribution_cv)
 export(distribution_mode)
 export(empty_columns)
 export(empty_rows)

R/describe_distribution.R

@@ -517,6 +517,11 @@ print.parameters_distribution <- function(x, digits = 2, ...) {
 #' The value that appears most frequently in the provided data.
 #' The returned data structure will be the same as the entered one.
 #'
+#' @seealso For continuous variables, the
+#'   **Highest Maximum a Posteriori probability estimate (MAP)** may be
+#'   more a more useful way to estimate the most commonly-observed value
+#'   than the mode. See [bayestestR::map_estimate()].
+#'
 #' @examples
 #'
 #' distribution_mode(c(1, 2, 3, 3, 4, 5))
@@ -529,3 +534,115 @@ distribution_mode <- function(x) {
   idx <- which.max(tab)
   uniqv[idx]
 }
+
+#' Compute the coefficient of variation
+#'
+#' Compute the coefficient of variation (CV, ratio of the standard deviation to
+#' the mean, $\frac{\sigma}{\mu}$) for a set of numeric values. Can also be
+#' used to compute the CV for a fitted model.
+#'
+#' @param x A numeric vector, or a model of a supported class.
+#' @param ... Further arguments based to other methods.
+#'
+#' @return The computed coefficient of variation for `x`.
+#' @export
+#'
+#' @examples
+#' coef_var(1:10)
+#' coef_var(1:10, method = "qcd")
+#' coef_var(mu = 10, sigma = 20)
+#' coef_var(mu = 10, sigma = 20, method = "unbiased", n = 30)
+#' cv(1:10)
+coef_var <- function(x, ...) {
+  UseMethod("coef_var")
+}
+
+#' @name cv
+#' @rdname coef_var
+#' @export
+cv <- coef_var
+
+#' @name distribution_cv
+#' @rdname coef_var
+#' @export
+distribution_cv <- coef_var
+
+#' @export
+coef_var.default <- function(x, verbose = TRUE, ...) {
+  if (verbose) {
+    warning(insight::format_message(paste0("Can't compute the coefficient of variation objects of class '", class(x)[1], "'.")), call. = FALSE)
+  }
+  NULL
+}
+
+#' @param mu A numeric vector of mean values to use to compute the coefficient
+#'   of variation. If supplied, `x` is not used to compute the mean.
+#' @param sigma A numeric vector of standard deviation values to use to compute the coefficient
+#'   of variation. If supplied, `x` is not used to compute the SD.
+#' @param method Method to use to compute the CV. Can be `"standard"` to compute
+#'   by dividing the standard deviation by the mean, `"unbiased"` for the
+#'   unbiased estimator for normally distributed data, or one of two robust
+#'   alternatives: `"median_mad"` to divide the median by the [stats::mad()],
+#'   or `"qcd"` (quartile coefficient of dispersion, interquartile range divided
+#'   by the sum of the quartiles [twice the midhinge]: $\frac{Q_3 - Q_1}{Q_3 + Q_1}$).
+#' @param trim the fraction (0 to 0.5) of values to be trimmed from
+#'   each end of `x` before the mean and standard deviation (or alternatvies)
+#'   are computed. Values of `trim` outside the range of (0 to 0.5) are taken
+#'   as the nearest endpoint.
+#' @param na.rm Logical. Should `NA` values be removed before computing (`TRUE`)
+#'   or not (`FALSE`, default)?
+#' @param n If `method = "unbiased"` and both `mu` and `sigma` are provided (not
+#'   computed from `x`), what sample size to use to adjust the computed CV
+#'   for small-sample bias?
+#'
+#' @rdname coef_var
+#'
+#' @export
+coef_var.numeric <- function(x, mu = NULL, sigma = NULL, unbiased = TRUE,
+                             method = c("standard", "unbiased", "median_mad", "qcd"),
+                             trim = 0, na.rm = FALSE, n = NULL, ...) {
+  # TODO: Support weights
+  method <- match.arg(method, choices = c("standard", "unbiased", "median_mad", "qcd"))
+  if (!(is.null(mu) && is.null(sigma))) {
+    if (isTRUE(na.rm)) {
+      x <- x[!is.na(x)]
+    }
+    if (!is.numeric(trim) || length(trim) != 1L) {
+      stop("`trim` must be a single numeric value.", call. = FALSE)
+    }
+    n <- length(x)
+    if (trim > 0 && n) {
+      if (anyNA(x)) return(NA_real_)
+      if (trim >= 0.5) return(stats::median(x, na.rm = FALSE))
+      lo <- floor(n * trim) + 1
+      hi <- n + 1 - lo
+      x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
+    }
+  }
+  if (! is.null(mu)) {
+    mu <- switch(
+      method,
+      standard, unbiased = mean(x, ...),
+      median_mad = stats::median(x, ...),
+      qcd = diff(stats::quantile(x, probs = c(.25, .75), ...))
+    )
+  }
+  if (! is.null(sigma)) {
+    sigma <- switch(
+      method,
+      standard, unbiased = sd(x, ...),
+      median_mad = stats::mad(x, center = mu, ...),
+      qcd = sum(stats::quantile(x, probs = c(.25, .75), ...))
+    )
+  }
+  out <- sigma / mu
+  if (method == "unbiased") {
+    if (is.null(n)) {
+      stop(insight::format_message("A value for `n` must be provided when `method = 'unbiased'` and both `mu` and `sigma` are provided"),
+           call. = FALSE)
+    }
+    # from DescTools::CoefVar
+    out <- out * (1 - 1 / (4 * (n - 1)) + 1 / n * out^2 + 1 / (2 * (n - 1)^2))
+  }
+  return(out)
+}