---
title: "Banded tables and concentration: from '6 to 10' to a Gini"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Banded tables and concentration: from '6 to 10' to a Gini}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
# the vignette runs in full in GitHub CI and for the package tarball (NOT_CRAN), on r-universe
# (MY_UNIVERSE), on the package website (IN_PKGDOWN) and in an interactive session; when CRAN
# re-builds it in its check, none of these is set and only this chunk runs
if (!interactive() && !any(nzchar(Sys.getenv(c("NOT_CRAN", "MY_UNIVERSE", "IN_PKGDOWN"))))) {
  knitr::knit_exit()
}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(rmoriebricklayer)
```

Published frequency tables band their values: "1", "2 to 5", "6 to 10", "Greater than 10".
To compute anything about the underlying distribution, the bands have to be parsed, given
representative values, and expanded into per-unit values, and the result has to be checked
against the one assumption that cannot be verified: what the open top band contains.

## Parsing band labels

```{r banded-tables-and-concentration-parse}
prsbands(c("1", "2 to 5", "6 to 10", "Greater than 10"))
prsbands(c("18 to 24", "25 to 49", "50+"))
```

An unrecognised label is reported as unparsed, never guessed at:

```{r banded-tables-and-concentration-parse-bad}
prsbands(c("3", "unknown", "not stated"))
```

## Representative values

Each band needs one value to stand for its members: the midpoint by default, or the lower
or upper edge, or the geometric mean for skewed quantities. The open top band has no upper
edge, so a cap or a factor on its lower edge is supplied explicitly:

```{r banded-tables-and-concentration-values}
b <- prsbands(c("1", "2 to 5", "6 to 10", "Greater than 10"))
bandvals(b, rule = "midpoint", openupcap = 20)
bandvals(b, rule = "geometric", openupcap = 20)
```

## Expanding to per-unit values

With counts per band, `expbands()` returns one value per unit, ready for any statistic:

```{r banded-tables-and-concentration-expand}
x <- expbands(c("1", "2 to 5", "Greater than 5"), cnts = c(10, 4, 2),
                  openupcap = 12)
table(x)
ginicoef(x)
```

## Concentration

The **Gini coefficient** measures how unequally a total is spread across units: 0 when
every unit holds the same, approaching 1 when one unit holds everything. `topshr()`
reports what the most frequent few account for, and `lorenzc()` gives the curve behind the
Gini.

```{r banded-tables-and-concentration-gini}
ginicoef(rep(1, 10))             # no concentration
ginicoef(c(rep(0, 9), 1))        # one unit holds everything
1 - 1 / 10                   # the maximum for ten units

placements <- c(rep(1, 1200), rep(3, 430), rep(8, 110), rep(20, 38))
ginicoef(placements)
topshr(placements, c(0.01, 0.05, 0.1))
head(lorenzc(placements))
```

Here the top 1% of people account for a disproportionate share of placements: the
substantive finding a banded table hides.

## The assumption you cannot check: sensitivity to the open band

Everything above depends on what the "Greater than 10" band is taken to contain. If the
statistic barely moves as that assumption varies, it has been measured; if it swings, it
has not, and the honest report says so. `bandsens()` recomputes a statistic over a
range of caps:

```{r banded-tables-and-concentration-sens}
counts <- c(1200, 430, 110, 38)
bandsens(b, counts)
bandsens(b, counts, stat = mean)
```

## Heavy tails

When the open band holds a long tail, the question is how heavy. The Hill estimator gives
the tail index of a power law; for counts, the exact discrete likelihood matters, because
the continuous closed form is badly biased at a threshold of one:

```{r banded-tables-and-concentration-hill}
k <- 1:10000
p <- k^(-2.5) / sum(k^(-2.5))
set.seed(2)
z <- sample(k, 5000, replace = TRUE, prob = p)
c(exact = round(hilltlidx(z, xmin = 1)$alpha, 2),
  approx = round(hilltlidx(z, xmin = 1, approx = TRUE)$alpha, 2))
```

A short tail still returns an estimate, marked as not to be leaned on:

```{r banded-tables-and-concentration-hill-short}
short <- hilltlidx(c(3, 4, 5, 9), xmin = 3)
c(alpha = round(short$alpha, 2), n = short$ntl, reliable = short$reliable)
```

## Workflow

1. `prsbands()`; stop if anything is unparsed.
2. `bandvals()` or `expbands()` with an explicit cap for the open band.
3. The statistic: `ginicoef()`, `topshr()`, `lorenzc()`, `hilltlidx()`.
4. `bandsens()` over the cap, and report the range, not the point.


## How unevenly a population is spread

Concentration measures apply to any non-negative counts. With the 2021 Census counts of
First Nations people by province and territory (bundled with the package), the Gini
coefficient and top shares say how concentrated the population is in a few jurisdictions:

```{r banded-tables-and-concentration-indigenous-concentration}
cp <- indiex("censuspop")
tot <- cp[cp$GEO_LEVEL != "Country" & cp$AGE_GROUP == "Total - Age groups" &
            cp$RESIDENCE == "Total - Residence on or off reserve" &
            grepl("^Total - Average age", cp$CHARACTERISTIC_NAME), ]
ginicoef(tot$FIRST_NATIONS)
topshr(tot$FIRST_NATIONS, fracs = c(0.25, 0.5))
```

## The bands and the curve in a picture

The left panel shows the banded counts as published. The right panel draws the Lorenz curve of
the placements with `plotlrnz()`: the further it bows below the diagonal, the more unevenly the
population is spread.

```{r banded-tables-and-concentration-bands-lorenz-plot, fig.width = 8, fig.height = 4}
op <- par(mfrow = c(1, 2))
barplot(counts, names.arg = b$label, col = blpal()[2], main = "Counts by band", ylab = "count")
plotlrnz(placements, main = "Concentration of placements")
par(op)
```