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 1 P1 B1 1 18 1 18
## 2 1 P2 B1 2 17 2 17
## 3 1 P3 B1 3 16 3 16
## 4 1 P4 B2 4 15 4 15
## 5 1 P5 B2 5 14 5 14
## 6 1 P6 B2 6 13 6 13Basic 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.548485The 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 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.547408Weights 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.549081The 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 are 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.556014Making 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.556046Aggregating 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")## time
## product 1 2 3
## B1.1 0 1.1024526 0.2899319
## B1.2 0 1.0256151 0.2530718
## B1.3 0 0.9487724 0.2162114We 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")## time
## product 1 2 3
## 1 0 1.1124046 0.2937263
## 2 0 1.0256134 0.2530717
## 3 0 0.9388222 0.2124170Aggregating 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)
)
}