Nothing
#' @title Group of Concentration Measures
#'
#' @srrstats {G1.4} roxygen2 used to document functions
#'
#' @description A set of different concentration measures.
#'
#' @usage
#' concstats_comp(x, normalized = FALSE, type = c("hhi", "hhi_d", "hhi_min",
#' "dom", "sten", "all"), na.rm = TRUE, digits = NULL)
#' @srrstats {G2.0a, G2.1a, EA1.1, EA1.3} accepted as input, length and type
#' @param x A non-negative numeric vector.
#' @param normalized Logical. Argument specifying whether or not a normalized
#' value is required. Ranges from (0, 1) and often used for comparison over
#' time. Must be either \code{TRUE} or \code{FALSE}. The default
#' is \code{FALSE}.
#' @param type A character string of the measure to be calculated,
#' can be abbreviated with the first letter. Defaults to "hhi". Input is not
#' case-sensitive.
#' @param na.rm A logical vector that indicates whether \code{NA} values should
#' be excluded or not. If set to \code{FALSE} the computation yields \code{NA}
#' if vector contains \code{NA} values.
#' Must be either \code{TRUE} or \code{FALSE}. Defaults to \code{TRUE}.
#' @param digits A non-null value for digits specifies the minimum number of
#' significant digits to be printed in values. The default is \code{NULL} and
#' will use base R print option. Significant digits defaults to 7.
#' @details
#' \code{concstats_comp} is a wrapper for the proposed concentration measures
#' [concstats_hhi()], [concstats_hhi_d()], [concstats_dom()],
#' [concstats_hhi_min()], [concstats_sten()], [concstats_all_comp()].
#' If no measure is specified "hhi" will be the default.
#' \code{concstats_hhi}, can be calculated individually as a normalized
#' measure changing the default setting to \code{TRUE}.
#' \code{concstats_all_comp} computes all measures in a one step procedure.
#' For more details or references please see the help page of the respective
#' function.
#'
#' @return A single numeric measure in decimal form or `data frame`.
#' @note The vector of market shares should be in a decimal form corresponding
#' to total shares of individual firms/units. The vector should sum up to 1.
#'
#' @seealso [concstats_concstats()], [concstats_mstruct()], [concstats_inequ()]
#' @examples
#' # a vector of market shares
#' x <- c(0.35, 0.4, 0.05, 0.1, 0.06, 0.04)
#' # the Herfindahl-Hirschman index of the vector
#' concstats_comp(x, type = "hhi")
#' # individual measure
#' concstats_sten(x)
#' # complete group measures
#' concstats_comp(x, type = "all", digits = 2)
#'
#' @export concstats_comp
concstats_comp <- function(x, normalized = FALSE,
type = c("hhi", "hhi_d", "hhi_min", "dom", "sten",
"all"), na.rm = TRUE, digits = NULL) {
type <- tolower(as.character(type))
#' @srrstats {G2.4, G2.4c} explicit conversion to character via as.character()
#' @srrstats {G2.3, G2.3b, G2.4c} used `tolower()`
#' @srrstats {G2.0, G2.1}
if (!is.logical(normalized) || !length(normalized) == 1 ||
is.na(normalized)) {
warning("`normalized` in `concstats_comp` must be either TRUE or FALSE")
}
#' @srrstats {G2.3, G2.3a} Used `match.arg()`
switch(match.arg(type),
hhi = concstats_hhi(x, normalized = normalized, na.rm = na.rm),
hhi_d = concstats_hhi_d(x, na.rm = na.rm),
hhi_min = concstats_hhi_min(x, na.rm = na.rm),
dom = concstats_dom(x, na.rm = na.rm),
sten = concstats_sten(x, na.rm = na.rm),
all = concstats_all_comp(x, normalized = normalized, na.rm = na.rm,
digits = digits))
}
#' @export
#' @title Herfindahl-Hirschman Index
#' @rdname concstats_hhi
#' @param x A non-negative numeric vector.
#' @param normalized Logical. Argument specifying whether or not a normalized
#' value is required. Ranges from {0, 1} and often used for comparison over
#' time. Must be either \code{TRUE} or \code{FALSE}. The default
#' is \code{FALSE}.
#' @param na.rm A logical vector that indicates whether \code{NA} values should
#' be excluded or not. Must be either \code{TRUE} or \code{FALSE}. The default
#' is \code{TRUE}. If set to \code{FALSE} the computation yields \code{NA} if
#' \code{NA} values are present.
#' @details \code{concstats_hhi} calculates the widely used Herfindahl-Hirschman
#' Index (Herfindahl, 1950 and Hirschman, 1945). The index is calculated by
#' squaring the market share of each firm competing in the market and then
#' summing the resulting numbers.
#' @return A single numeric measure in decimal form.
#' @references Herfindahl, O. C. (1950), "Concentration in the steel industry"
#' (PhD thesis), Columbia University.
#' @references Hirschmann, A. O. (1945), "National power and structure of
#' foreign trade". Berkeley, CA: University of California Press.
#' @examples
#' # a vector of market shares
#' x <- c(0.35, 0.4, 0.05, 0.1, 0.06, 0.04)
#' concstats_hhi(x)
#' # a vector with NA values
#' x <- c(0.4, 0.2, 0.25, 0.1, 0.05, NA)
#' concstats_hhi(x, na.rm = FALSE)
#'
concstats_hhi <- function(x, normalized = FALSE, na.rm = TRUE) {
#' @srrstats {G5.8a} Zero-length data
#' @srrstats {G2.2, G2.6, G2.16} Checking class, type, NaN handling
if (!is.numeric(x)) {
stop("`x` in concstats_hhi must be a numeric vector\n",
"You have provided an object of class:", class(x)[1])
}
#' @srrstats {G2.0, G2.1}
if (!is.logical(na.rm) || !length(na.rm) == 1 || is.na(na.rm)) {
stop("`na.rm` in `concstats_hhi` must be either TRUE or FALSE")
}
if (!is.logical(normalized) || !length(normalized) == 1 || is.na(normalized))
{
stop("`normalized` in `concstats_hhi` must be either TRUE or FALSE")
}
#' @srrstats {G2.13, G2.14, G2.14a, G2.14b, G2.15} Handling of missing values
if (na.rm == TRUE) {
x <- as.numeric(x[!is.na(x)])
}
if (!na.rm && any(is.na(x))) return(NA_real_)
# check if x is a positive decimal vector
if (as.logical(all(x < 0))) {
stop("x in `concstats_hhi` must be a positive vector")
}
#' @srrstats {G2.4, G2.4b} explicit conversion to continuous via `as.numeric()`
if (sum(x, na.rm = TRUE) > 1) {
x <- as.numeric(x / sum(x, na.rm = TRUE))
} else {
x
}
#' @srrstats {G3.0, EA6.0, EA6.0e} Return values, single-valued objects.
# check sum of vector. Must sum to 1
if (!isTRUE(all.equal(sum(x), 1, tolerance = .Machine$double.eps^0.25))) {
stop("vector `x` in `concstats_hhi` does not sum to 1")
}
hhi <- as.numeric(sum(x ^ 2))
if (normalized == TRUE) hhi <- as.numeric((hhi - (1 / sum(x > 0))) /
(1 - (1 / sum(x > 0))))
return(hhi)
}
#' @export
#' @title Minimum of Herfindahl-Hirschman Index
#' @rdname concstats_hhi_min
#' @param x A non-negative numeric vector.
#' @param na.rm A logical vector that indicates whether \code{NA} values should
#' be excluded or not. Must be either \code{TRUE} or \code{FALSE}. The default
#' is \code{TRUE}.
#' If set to \code{FALSE} the computation yields \code{NA} if the vector
#' contains \code{NA} values.
#' @details Calculates the minimum of the Herfindahl-Hirschman index, that is,
#' the equivalent of all participants in the market with equal market shares.
#' @return A single numeric measure in decimal form.
#' @examples
#' # a vector of market shares
#' x <- c(0.35, 0.4, 0.05, 0.1, 0.06, 0.04)
#' concstats_hhi_min(x)
#' # a vector with NA values
#' x <- c(0.4, 0.2, 0.25, 0.1, 0.05, NA)
#' concstats_hhi_min(x, na.rm = FALSE)
#'
concstats_hhi_min <- function(x, na.rm = TRUE) {
#' @srrstats {G5.8a} Zero-length data
#' @srrstats {G2.2, G2.6, G2.16} Checking class, type, NaN handling
if (!is.numeric(x)) {
stop("`x` in concstats_hhi_min must be a numeric vector\n",
"You have provided an object of class:", class(x)[1])
}
#' @srrstats {G2.0, G2.1}
if (!is.logical(na.rm) || !length(na.rm) == 1 || is.na(na.rm)) {
stop("`na.rm` in `concstats_hhi_min` must be either TRUE or FALSE")
}
#' @srrstats {G2.13, G2.14, G2.14a, G2.14b, G2.15} Handling of missing values
if (na.rm == TRUE) {
x <- as.numeric(x[!is.na(x)])
}
if (!na.rm && any(is.na(x))) return(NA_real_)
# check if x is a positive decimal vector
if (as.logical(all(x < 0))) {
stop("x in `concstats_hhi_min` must be a positive vector")
}
#' @srrstats {G3.0, EA6.0, EA6.0e} Return values, single-valued objects.
# check sum of vector. Must sum to 1
if (!isTRUE(all.equal(sum(x), 1, tolerance = .Machine$double.eps^0.25))) {
stop("vector `x` in `concstats_hhi_min` does not sum to 1")
}
#' @srrstats {G2.4, G2.4b} explicit conversion to continuous via `as.numeric()`
if (sum(x, na.rm = TRUE) > 1) {
x <- as.numeric(x / sum(x, na.rm = TRUE))
} else {
x
}
hhi_min <- as.numeric(1 / sum(x > 0))
return(hhi_min)
}
#' @export
#' @title Dual of the Herfindahl-Hirschman Index
#' @rdname concstats_hhi_d
#' @param x A non-negative numeric vector.
#' @param na.rm A logical vector that indicates whether \code{NA} values should
#' be excluded or not. Must be either \code{TRUE} or \code{FALSE}. The default
#' is \code{TRUE}.
#' If set to \code{FALSE} the computation yields \code{NA} if the vector
#' contains \code{NA} values.
#' @details \code{concstats_hhi_d} is the dual of the HHI index, which indicates
#' the percentage which represents the fraction of the banks that do not have
#' market participation.
#' @return A single numeric measure in decimal form.
#' @references Chang, E. J., Guerra, S. M., de Souza Penaloza, R. A. & Tabak,
#' B. M. (2005) Banking concentration: the Brazilian case. \emph{In Financial
#' Stability Report}. Brasilia: Banco Central do Brasil, 4: 109-129.
#' @examples
#' # a vector of market shares
#' x <- c(0.35, 0.4, 0.05, 0.1, 0.06, 0.04)
#' concstats_hhi_d(x)
#' # a vector with NA values
#' x <- c(0.4, 0.2, 0.25, 0.1, 0.05, NA)
#' concstats_hhi_d(x, na.rm = FALSE)
#'
concstats_hhi_d <- function(x, na.rm = TRUE) {
#' @srrstats {G5.8a} Zero-length data
#' @srrstats {G2.2, G2.6, G2.16} Checking class, type, NaN handling
if (!is.numeric(x)) {
stop("`x` in concstats_hhi_d must be a numeric vector\n",
"You have provided an object of class:", class(x)[1])
}
#' @srrstats {G2.0, G2.1}
if (!is.logical(na.rm) || !length(na.rm) == 1 || is.na(na.rm)) {
stop("`na.rm` in `concstats_hhi_d` must be either TRUE or FALSE")
}
#' @srrstats {G2.13, G2.14, G2.14a, G2.14b, G2.15} Handling of missing values
if (na.rm == TRUE) {
x <- as.numeric(x[!is.na(x)])
}
if (!na.rm && any(is.na(x))) return(NA_real_)
# check if x is a positive decimal vector
if (as.logical(all(x < 0))) {
stop("x in `concstats_hhi_d` must be a positive vector")
}
#' @srrstats {G3.0, EA6.0, EA6.0e} Return values, single-valued objects.
# check sum of vector. Must sum to 1
if (!isTRUE(all.equal(sum(x), 1, tolerance = .Machine$double.eps^0.25))) {
stop("vector `x` in `concstats_hhi_d` does not sum to 1")
}
#' @srrstats {G2.4, G2.4b} explicit conversion to continuous via `as.numeric()`
if (sum(x, na.rm = TRUE) > 1) {
x <- as.numeric(x / sum(x, na.rm = TRUE))
} else {
x
}
hhi <- as.numeric(sum(x ^ 2))
hhi_d <- as.numeric(1 - 1 / (sum(x > 0) * hhi))
return(hhi_d)
}
#' @export
#' @title Dominance Index
#' @rdname concstats_dom
#' @param x A non-negative numeric vector.
#' @param na.rm A logical vector that indicates whether \code{NA} values should
#' be excluded or not. Must be either \code{TRUE} or \code{FALSE}. The default
#' is \code{TRUE}.
#' If set to \code{FALSE} the computation yields \code{NA} if the vector
#' contains \code{NA} values.
#' @details
#' \code{concstats_dom} calculates a dominance index, which measures the
#' concentration within the Herfindahl-Hirschman index, that is, the
#' concentration within the concentration.
#' @return A single numeric measure in decimal form.
#' @references Garcia Alba Idunate, P. (1994). "Un Indice de dominancia para el
#' analisis de la estructura de los mercados". \emph{El Trimestre Economico},
#' 61: 499-524.
#' @examples
#' # a vector of market shares
#' x <- c(0.35, 0.4, 0.05, 0.1, 0.06, 0.04)
#' concstats_dom(x)
#' # a vector with NA values
#' x <- c(0.4, 0.2, 0.25, 0.1, 0.05, NA)
#' concstats_dom(x, na.rm = FALSE)
#'
concstats_dom <- function(x, na.rm = TRUE) {
#' @srrstats {G5.8a} Zero-length data
#' @srrstats {G2.2, G2.6, G2.16} Checking class, type, NaN handling
if (!is.numeric(x)) {
stop("`x` in concstats_dom must be a numeric vector\n",
"You have provided an object of class:", class(x)[1])
}
#' @srrstats {G2.0, G2.1}
if (!is.logical(na.rm) || !length(na.rm) == 1 || is.na(na.rm)) {
stop("`na.rm` in `concstats_dom` must be either TRUE or FALSE")
}
#' @srrstats {G2.13, G2.14, G2.14a, G2.14b, G2.15} Handling of missing values
if (na.rm == TRUE) {
x <- as.numeric(x[!is.na(x)])
}
if (!na.rm && any(is.na(x))) return(NA_real_)
# check if x is a positive decimal vector
if (as.logical(all(x < 0))) {
stop("x in `concstats_dom` must be a positive vector")
}
#' @srrstats {G3.0, EA6.0, EA6.0e} Return values, single-valued objects.
# check sum of vector. Must sum to 1
if (!isTRUE(all.equal(sum(x), 1, tolerance = .Machine$double.eps^0.25))) {
stop("vector `x` in `concstats_dom` does not sum to 1")
}
#' @srrstats {G2.4, G2.4b} explicit conversion to continuous via `as.numeric()`
if (sum(x, na.rm = TRUE) > 1) {
x <- as.numeric(x / sum(x, na.rm = TRUE))
} else {
x
}
hhi_1 <- x ^ 2
hhi <- sum(x ^ 2)
dom <- (hhi_1 / hhi) ^ 2
dom <- as.numeric(sum(dom))
return(dom)
}
#' @export
#' @title Stenbacka Index
#' @rdname concstats_sten
#' @param x A non-negative numeric vector.
#' @param na.rm A logical vector that indicates whether \code{NA} values should
#' be excluded or not. Must be either \code{TRUE} or \code{FALSE}. The default
#' is \code{TRUE}.
#' If set to \code{FALSE} the computation yields \code{NA} if \code{NA} values
#' are present.
#' @details
#' \code{concstats_sten} calculates the Stenbacka index,
#' which indicates the market share of a dominant position.
#' @return A single numeric measure in decimal form.
#' @references Melnik, A., Shy, Oz, Stenbacka, R., (2008), "Assessing market
#' dominance", \emph{Journal of Economic Behavior and Organization},
#' 68: pp. 63-72.
#' @examples
#' # a vector of market shares
#' x <- c(0.35, 0.4, 0.05, 0.1, 0.06, 0.04)
#' concstats_sten(x)
#' # a vector with NA values
#' x <- c(0.4, 0.2, 0.25, 0.1, 0.05, NA)
#' concstats_sten(x, na.rm = FALSE)
concstats_sten <- function(x, na.rm = TRUE) {
#' @srrstats {G5.8a} Zero-length data
#' @srrstats {G2.2, G2.6, G2.16} Checking class, type, NaN handling
if (!is.numeric(x)) {
stop("`x` in concstats_sten must be a numeric vector\n",
"You have provided an object of class:", class(x)[1])
}
#' @srrstats {G2.0, G2.1}
if (!is.logical(na.rm) || !length(na.rm) == 1 || is.na(na.rm)) {
stop("`na.rm` in `concstats_sten` must be either TRUE or FALSE")
}
#' @srrstats {G2.13, G2.14, G2.14a, G2.14b, G2.15} Handling of missing values
if (na.rm == TRUE) {
x <- as.numeric(x[!is.na(x)])
}
if (!na.rm && any(is.na(x))) return(NA_real_)
# check if x is a positive decimal vector
if (as.logical(all(x < 0))) {
stop("x in `concstats_sten` must be a positive vector")
}
#' @srrstats {G3.0, EA6.0, EA6.0e} Return values, single-valued objects.
# check sum of vector. Must sum to 1
if (!isTRUE(all.equal(sum(x), 1, tolerance = .Machine$double.eps^0.25))) {
stop("vector `x` in `concstats_sten` does not sum to 1")
}
#' @srrstats {G2.4, G2.4b} explicit conversion to continuous via `as.numeric()`
if (sum(x, na.rm = TRUE) > 1) {
x <- as.numeric(x / sum(x, na.rm = TRUE))
} else {
x
}
x <- as.numeric(stats::na.omit(x))
x <- sort(x, decreasing = TRUE)
sten1 <- x[1]
sten2 <- x[2]
sten <- as.numeric(0.5 * (1 - 1 * (sten1 ^ 2 - sten2 ^ 2)) * 100)
return(sten)
}
#' @export
#' @title A wrapper for the proposed concentration measures
#' @rdname concstats_all_comp
#' @param x A non-negative numeric vector.
#' @param normalized Logical. Argument specifying whether or not a normalized
#' value is required. Must be either \code{TRUE} or \code{FALSE}. Defaults to
#' \code{FALSE}.
#' @param na.rm A logical vector that indicates whether \code{NA} values should
#' be excluded or not. Must be either \code{TRUE} or \code{FALSE}. The default
#' is \code{TRUE}.
#' If set to \code{FALSE} the computation yields \code{NA} if \code{NA} values
#' are present.
#' @param digits A non-null value for digits specifies the minimum number of
#' significant digits to be printed in values. The default is \code{NULL} and
#' will use base R print option. Significant digits defaults to 7.
#' @details
#' \code{concstats_all_comp} returns all proposed group measures in a one step
#' procedure with default settings if not otherwise specified.
#' @return A `data.frame`.
#' @seealso [concstats_all_mstruct()], [concstats_all_inequ()]
#' @examples
#' # a vector of market shares
#' x <- c(0.35, 0.4, 0.05, 0.1, 0.06, 0.04)
#' concstats_all_comp(x, digits = 2)
#' @srrstats {EA2.6}
concstats_all_comp <- function(x, normalized = FALSE, na.rm = TRUE,
digits = NULL ) {
#' @srrstats {G5.8a} Zero-length data
#' @srrstats {G2.2, G2.6, G2.16} Checking class, type, NaN handling
if (!is.numeric(x)) {
stop("`x` in concstats_all_comp must be a numeric vector\n",
"You have provided an object of class:", class(x)[1])
}
#' @srrstats {G2.0, G2.1}
if (!is.logical(na.rm) || !length(na.rm) == 1 || is.na(na.rm)) {
stop("`na.rm` in `concstats_all_comp` must be either TRUE or FALSE")
}
if (!is.logical(normalized) || !length(normalized) == 1 || is.na(normalized))
{
stop("`normalized` in `concstats_all_comp` must be either TRUE or
FALSE")
}
#' @srrstats {G2.13, G2.14, G2.14a, G2.14b, G2.15} Handling of missing values
if (na.rm == TRUE) {
x <- as.numeric(x[!is.na(x)])
}
if (!na.rm && any(is.na(x))) return(NA_real_)
# check if x is a positive decimal vector
if (as.logical(all(x < 0))) {
stop("x in `concstats_all_comp` must be a positive vector")
}
#' @srrstats {G3.0, EA6.0, EA6.0e} Return values, single-valued objects.
# check sum of vector. Must sum to 1
if (!isTRUE(all.equal(sum(x), 1, tolerance = .Machine$double.eps^0.25))) {
stop("vector `x` in `concstats_all_comp` does not sum to 1")
}
#' @srrstats {G2.4, G2.4b} explicit conversion to continuous via `as.numeric()`
if (sum(x, na.rm = TRUE) > 1) {
x <- as.numeric(x / sum(x, na.rm = TRUE))
} else {
x
}
x <- as.numeric(stats::na.omit(x))
hhi <- concstats_hhi(x, normalized = normalized, na.rm = TRUE)
hhi_d <- concstats_hhi_d(x, na.rm = TRUE)
hhi_min <- concstats_hhi_min(x, na.rm = TRUE)
dom <- concstats_dom(x, na.rm = TRUE)
sten <- concstats_sten(x, na.rm = TRUE)
#' @srrstats {EA4.0, EA4.1, EA4.2, EA5.2, EA5.4} Numeric control of
#' screen-based output.
results_comp <- data.frame(Measure = c("HHI", "HHI(min)", "HHI(dual)",
"Dominance", "Stenbacka(%)"),
Value = as.numeric(format(c(hhi, hhi_min, hhi_d,
dom, sten),
scientific = FALSE,
digits = digits,
justify = "right")))
return(results_comp)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.