---
title: "Adjusting annual weights"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Adjusting annual weights}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

Making a monthly or quarterly Lowe index with annual expenditure or revenue
weights requires adjusting these weights so that the implicit annual quantity vector
is used as the fixed basket when making the index with the usual two-step procedure. This
can be done by price updating the annual weights to the base period of the index,
and it serves as a good example of extending the functions in this package.

Let's start by making some annual weights and quarterly indexes for a year.

```{r}
set.seed(54321)

library(piar)

# Make an aggregation structure.
pias <- data.frame(
  level1 = rep(1, 12),
  level2 = rep(c(11, 12, 13), each = 4),
  level3 = rep(c(111, 112, 121, 122, 131, 132), each = 2),
  ea = sprintf("B%02d", 1:12),
  weight = 1:12
) |>
  as_aggregation_structure()

pias

# Make elemental indexes over 4 quarters.
elementals <- matrix(
  runif(12 * 4, 0.4, 1.2),
  nrow = 12,
  dimnames = list(sprintf("B%02d", 1:12), paste0("Q", 1:4))
) |>
  as_index()

elementals
```

Adjusting the weights is simple when there are no missing elemental indexes: the weight
for each elemental aggregate is just divided by the average (fixed-base) index
for each quarter.

```{r}
weights(pias) / rowMeans(as.matrix(chain(elementals)))
```

The procedure is more complicated with missing elemental indexes
as reaggregating these indexes with the newly adjusted weights will generally result
in different imputations for the missing elemental indexes, which in turn gives a
different adjustment for the weights. In practice this procedure is done a few times
until the index values converge to a fixed point. The following function shows how
to do this adjustment using the tools in this package.

```{r}
# Function to adjust annual weights.
adjust_weights <- function(index,
                           pias,
                           tol = .Machine$double.eps^0.5,
                           max_iter = 100) {
  adj_pias <- pias
  for (i in seq_len(max_iter)) {
    # Parentally impute missing elemental indexes.
    agg_index <- aggregate(index, adj_pias, na.rm = TRUE, contrib = FALSE)
    elementals <- chain(agg_index[levels(pias)[[nlevels(pias)]]])
    # Compute annual elemental indexes.
    pb <- rowMeans(as.matrix(elementals))
    # Stop if average price-update weights are within tolerance of original
    # weights; adjust otherwise.
    if (max(abs(pb * weights(adj_pias) - weights(pias))) < tol) {
      message(gettextf("Converged after %d iterations", i - 1))
      return(adj_pias)
    } else {
      weights(adj_pias) <- weights(pias) / pb
    }
  }
  warning("weights adjustment did not converge")
  adj_pias
}
```

```{r}
elementals[11:12] <- NA

adjust_weights(elementals, pias)
```