# Index-number formulas

Price indexes based on a generalized mean of price relatives constitute a large family of bilateral index-number formulas that are consistent in aggregation, and any index based on the generalized mean can be used to make and aggregate elementary indexes. See the last section for a comprehensive list. To see how to make superlative indexes as well, let’s start with a simple dataset of prices and quantities for two businesses over three periods. We’ll be making extensive use of the lower-level math functions in this package; see the help pages for these functions to get more detail and `vignette("decomposing-indexes")` for the theoretical background.

    library(piar)

    prices <- data.frame(
      period = rep(1:3, each = 6),
      product = paste0("P", 1:6),
      business = rep(c("B1", "B2"), each = 3),
      price = 1:18,
      quantity = 18:1
    )

    prices[c("back_price", "back_quantity")] <-
      prices[back_period(prices$period, prices$product), c("price", "quantity")]

    head(prices)

period | product | business | price | quantity | back_price | back_quantity
--- | --- | --- | --- | --- | --- | ---
1 | P1 | B1 | 1 | 18 | 1 | 18
1 | P2 | B1 | 2 | 17 | 2 | 17
1 | P3 | B1 | 3 | 16 | 3 | 16
1 | P4 | B2 | 4 | 15 | 4 | 15
1 | P5 | B2 | 5 | 14 | 5 | 14
1 | P6 | B2 | 6 | 13 | 6 | 13

## Basic indexes

As seen in `vignette("piar")`, by default the `elementary_index()` function calculates a Jevons index (equally-weighted geometric mean of price relatives). Although this is the standard index-number formula for making elementary indexes, many other types of index-numbers are possible. Among the unweighted index-number formulas, the Carli index (equally-weighted arithmetic mean of price relatives) is the historical competitor to the Jevons, and requires specifying the order of the generalized mean `order = 1` when calling `elementary_index()`. An order of 1 corresponds to an arithmetic mean.

    prices |>
      elementary_index(price / back_price ~ period + business, order = 1)

    #> Period-over-period price index for 2 levels over 3 time periods
    #>       time
    #> levels 1        2        3
    #>     B1 1 4.666667 1.757937
    #>     B2 1 2.233333 1.548485

The Coggeshall index (equally-weighted harmonic mean of price relatives) is another competitor to the Jevons, but is seldom used in practice. Despite it being more exotic, it is just as easy to make by specifying an `order = -1`.

    prices |>
      elementary_index(price / back_price ~ period + business, order = -1)

    #> Period-over-period price index for 2 levels over 3 time periods
    #>       time
    #> levels 1        2        3
    #>     B1 1 4.131148 1.754499
    #>     B2 1 2.214765 1.547408

Weights can be added to make, for example, elementary indexes using the geometric Laspeyres formula.

    prices |>
      elementary_index(
        price / back_price ~ period + business,
        weights = back_price * back_quantity
      )

    #> Period-over-period price index for 2 levels over 3 time periods
    #>       time
    #> levels 1        2        3
    #>     B1 1 3.853330 1.754015
    #>     B2 1 2.202496 1.549081

The type of mean used to aggregate elementary indexes can be controlled in the same way in the call to `aggregate()`. The default makes an arithmetic index, but any type of generalized-mean index is possible.

## Superlative indexes

Many superlative indexes can be made by supplying unequal and time-varying weights when making the elementary indexes, usually from information about quantities. The Törnqvist index is a popular superlative index-number formula, using average period-over-period value shares as the weights in a geometric mean. As `elementary_index()` makes a geometric index by default, all that is needed to make a Törnqvist index is the weights.

    period_by_business <- interaction(prices$period, prices$business)

    tornqvist_weights <- split(prices, ~period_by_business) |>
      lapply(\(df) {
        0.5 * scale_weights(df$price * df$quantity) +
          0.5 * scale_weights(df$back_price * df$back_quantity)
      }) |>
      unsplit(period_by_business)

    prices |>
      elementary_index(
        price / back_price ~ period + business,
        weights = tornqvist_weights
      )

    #> Period-over-period price index for 2 levels over 3 time periods
    #>       time
    #> levels 1        2        3
    #>     B1 1 4.087422 1.759213
    #>     B2 1 2.215995 1.556014

Making a Fisher index is more complex because it does not belong to the generalized-mean family. Despite this, it is possible to make weights to represent a Fisher index as a generalized mean of any order.

    fisher_weights <- split(prices, ~period_by_business) |>
      lapply(\(df) {
        transmute_weights2(
          df$price / df$back_price,
          list(df$back_price * df$back_quantity, df$price * df$quantity),
          to = 0
        )
      }) |>
      unsplit(period_by_business)

    prices |>
      elementary_index(
        price / back_price ~ period + business,
        weights = fisher_weights
      )

    #> Period-over-period price index for 2 levels over 3 time periods
    #>       time
    #> levels 1        2        3
    #>     B1 1 4.076840 1.759215
    #>     B2 1 2.215934 1.556046

Aggregating with a superlative index is more complex, and is the subject of `vignette("superlative-aggregation")`.

## Product contributions

As shown in `vignette("contributions")`, supplying `contrib = TRUE` in the call to `elementary_index()` makes percent-change product contributions for each index value. The method used in this package is flexible and works well for a variety of different index-number formulas, but does not include all methods found in the literature. (See the help page for `elementary_index()`, and the references therein, for more detail about the exact methods.)

Let’s extend the previous example by calculating product contributions for the Fisher index using the default method.

    fisher_index <- prices |>
      elementary_index(
        price / back_price ~ period + business,
        weights = fisher_weights,
        contrib = TRUE
      )

    contrib(fisher_index, "B1")

| 1 | 2 | 3
--- | --- | --- | ---
B1.1 | 0.000 | 1.102 | 0.290
B1.2 | 0.000 | 1.026 | 0.253
B1.3 | 0.000 | 0.949 | 0.216

We can change the method used to make contributions for, say, business `B1` by making a function to compute contributions according to a different method

    diewert_contributions <- function(p1, p0, q1, q0) {
      rel <- p1 / p0
      v0 <- scale_weights(p0 * q0)
      v1 <- scale_weights(p0 * q1)
      laspeyres <- gmean(rel, v0)
      fisher <- nested_gmean(rel, list(v0, v1), order = c(1, 1))

      (v0 + laspeyres * v1) / (1 + fisher) * (rel - 1)
    }

and using this function to replace the contributions for business `B1`.

    contrib(fisher_index, "B1") <- subset(prices, business == "B1") |>
      split(~period) |>
      sapply(
        \(df) {
          diewert_contributions(
            df$price,
            df$back_price,
            df$quantity,
            df$back_quantity
          )
        }
      )

    contrib(fisher_index, "B1")

1 | 2 | 3
--- | --- | ---
0.000 | 1.112 | 0.294
0.000 | 1.026 | 0.253
0.000 | 0.939 | 0.212

Aggregating the elementary indexes will then consistently aggregate the contributions for both businesses, even though they use different methods.

## Indexes based on generalized means

    # ---- Arithmetic mean ----
    # Carli
    carli <- \(p1, p0, q1, q0) gmean(p1 / p0)

    # Dutot
    dutot <- \(p1, p0, q1, q0) gmean(p1 / p0, p0)

    # Laspeyres
    laspeyres <- \(p1, p0, q1, q0) gmean(p1 / p0, p0 * q0)

    # Palgrave
    palgrave <- \(p1, p0, q1, q0) gmean(p1 / p0, p1 * q1)

    # Walsh-1
    walsh1 <- \(p1, p0, q1, q0) gmean(p1 / p0, p0 * sqrt(q0 * q1))

    # Marshall-Edgeworth
    marshall_edgeworth <- \(p1, p0, q1, q0) gmean(p1 / p0, p0 * (q0 * q1))

    # Geay-Khamis
    geary_khamis <- \(p1, p0, q1, q0) gmean(p1 / p0, p0 / (1 / q0 + 1 / q1))

    # Hybrid CSWD
    hybrid_cswd <- \(p1, p0, q1, q0) gmean(p1 / p0, sqrt(p0 / p1))

    # Martini
    martini <- \(p1, p0, q1, q0, a) gmean(p1 / p0, p0 * q0 * (q1 / p0)^a)

    # ---- Geometric mean ----
    # Jevons
    jevons <- \(p1, p0, q1, q0) gmean(p1 / p0, order = 0)

    # Geometric Laspeyres (Jöhr)
    geo_laspeyres <- \(p1, p0, q1, q0) gmean(p1 / p0, p0 * q0, order = 0)

    # Geometric Paasche
    geo_paasche <- \(p1, p0, q1, q0) gmean(p1 / p0, p1 * q1, order = 0)

    # Walsh-2
    walsh2 <- \(p1, p0, q1, q0) gmean(p1 / p0, sqrt(p0 * p1 * q0 * q1), order = 0)

    # Theil
    theil <- \(p1, p0, q1, q0) {
      w0 <- scale_weights(p0 * q0)
      w1 <- scale_weights(p1 * q1)
      gmean(p1 / p0, ((w0 + w1) / 2 * w0 * w1)^(1 / 3), order = 0)
    }

    # Rao
    rao <- \(p1, p0, q1, q0) {
      w0 <- scale_weights(p0 * q0)
      w1 <- scale_weights(p1 * q1)
      gmean(p1 / p0, w0 * w1 / (w0 + w1), order = 0)
    }

    # Sato-Vartia
    sato_vartia <- function(p1, p0, q1, q0) {
      v0 <- scale_weights(p0 * q0)
      v1 <- scale_weights(p1 * q1)
      gmean(p1 / p0, emean(v0, v1), order = 0)
    }

    # ---- Harmonic mean ----
    # Coggeshall
    coggeshall <- \(p1, p0, q1, q0) gmean(p1 / p0, order = -1)

    # Paasche
    paasche <- \(p1, p0, q1, q0) gmean(p1 / p0, p1 * q1, order = -1)

    # Harmonic Laspeyres
    harm_laspeyres <- \(p1, p0, q1, q0) gmean(p1 / p0, p0 * q0, order = -1)

    # ---- Generalized mean ----
    # Lloyd-Moulton
    lloyd_moulton <- \(p1, p0, q1, q0, sigma) {
      gmean(p1 / p0, p0 * q0, order = 1 - sigma)
    }

    # ---- Nested means ----
    # Drobisch (Sidgwick)
    drobisch <- \(p1, p0, q1, q0) {
      nested_gmean(p1 / p0, list(p0 * q0, p1 * q1), outer_order = 1)
    }

    # Unnamed
    unnamed <- \(p1, p0, q1, q0) {
      nested_gmean(
        p1 / p0,
        list(p0 * q0, p1 * q1),
        order = c(1, 1),
        outer_order = 1
      )
    }

    # Törnqvist-Theil
    tornqvist <- \(p1, p0, q1, q0) {
      nested_gmean(
        p1 / p0,
        list(p0 * q0, p1 * q1),
        order = c(0, 0)
      )
    }

    # Fisher
    fisher <- \(p1, p0, q1, q0) nested_gmean(p1 / p0, list(p0 * q0, p1 * q1))

    # CSWD
    cswd <- \(p1, p0, q1, q0) nested_gmean(p1 / p0)

    # Balk-Walsh
    balk_walsh <- \(p1, p0, q1, q0) nested_gmean(p1 / p0, order = c(0.5, -0.5))

    # Geometric AG mean
    ag_mean <- \(p1, p0, q1, q0, elasticity) {
      nested_gmean(
        p1 / p0,
        list(p0 * q0, p0 * q0),
        order = c(0, 1),
        outer_weights = c(elasticity, 1 - elasticity)
      )
    }