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 |
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.
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").
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.
# ---- 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)
)
}