test-known-values.R
In piar: Price Index Aggregation

#---- Compare results from piar with known values ----
# Matched sample index
ms_compare <- '"business","level","period","index","weight"
"99",4,202001,100,2463
"99",44,202001,100,1511
"99",45,202001,100,952
"B1",44,202001,100,553
"B2",44,202001,100,646
"B3",44,202001,100,312
"B4",45,202001,100,622
"B5",45,202001,100,330
"99",4,202002,130.072391107879,2463
"99",44,202002,130.072391107879,1511
"99",45,202002,130.072391107879,952
"B1",44,202002,89.4909688013136,553
"B2",44,202002,130.072391107879,646
"B3",44,202002,202.000360773041,312
"B4",45,202002,130.072391107879,622
"B5",45,202002,130.072391107879,330
"99",4,202003,86.7572212018498,3203.68299298706
"99",44,202003,86.7572212018498,1965.39382964005
"99",45,202003,86.7572212018498,1238.28916334701
"B1",44,202003,29.9162892822837,494.885057471264
"B2",44,202003,17.7722681519892,840.267646556897
"B3",44,202003,330.33835909201,630.241125611888
"B4",45,202003,86.7572212018498,809.050272691007
"B5",45,202003,86.7572212018498,429.238890656
"99",4,202004,194.002034724665,2136.83035820156
"99",44,202004,66.0876113541715,1310.90161235995
"99",45,202004,397.025872658294,825.92874584161
"B1",44,202004,22.7888361551669,165.437079731029
"B2",44,202004,49.2372928695834,114.80885226185
"B3",44,202004,177.720715283958,1030.65568036707
"B4",45,202004,397.025872658294,539.629915875505
"B5",45,202004,397.025872658294,286.298829966104'

ms_compare <- read.csv(text = ms_compare)

test_that("matched-sample index works", {
  pias <- with(
    ms_weights,
    aggregation_structure(
      c(expand_classification(classification), list(business)),
      weight
    )
  )

  sp <- shadow_price(ms_prices, price ~ period + product + business, pias = pias)

  rel <- price_relative(ms_prices, sp ~ period + product)

  epr <- elemental_index(ms_prices, rel ~ period + business, na.rm = TRUE)

  index <- aggregate(epr, pias, na.rm = TRUE)

  expect_equal(as.numeric(as.matrix(chain(index))), ms_compare$index / 100)
})

# Fixed sample index
fs_data <- '"level","period","index","weight"
1,202001,100,1414
11,202001,100,327
12,202001,100,1052
13,202001,100,35
111,202001,100,300
112,202001,100,27
121,202001,100,310
122,202001,100,742
131,202001,100,35
1,202002,91.0103876717451,1414
11,202002,99.8447454604818,327
12,202002,89.2590945944688,1052
13,202002,61.1111111111111,35
111,202002,98.406374501992,300
112,202002,115.826644999257,27
121,202002,89.2590945944688,310
122,202002,89.2590945944688,742
131,202002,61.1111111111111,35
1,202003,202.720228734347,1286.88688167848
11,202003,58.0604309998486,326.492317655775
12,202003,251.004254588165,939.005675133811
13,202003,102.97619047619,21.3888888888889
111,202003,57.2240080373539,295.219123505976
112,202003,67.3540194720112,31.2731941497993
121,202003,251.004254588165,276.703193242853
122,202003,251.004254588165,662.302481890958
131,202003,102.97619047619,21.3888888888889
1,202004,457.399532517888,2866.46403430367
11,202004,115.268030978454,189.857609369505
12,202004,571.234009665623,2640.56475826749
13,202004,232.346133774375,36.0416666666667
111,202004,113.607471001692,171.672024112062
112,202004,133.718697386926,18.185585257443
121,202004,268.529892765512,778.113189223311
122,202004,697.700689233055,1862.45156904418
131,202004,232.346133774375,36.0416666666667'

fs_compare <- read.csv(text = fs_data)

test_that("fixed-sample index works", {
  # Reallocate the weights
  weights <- fs_prices[1:11, c(2:3, 5)]
  weights$weight <- with(
    weights,
    ave(weight, classification, FUN = gpindex::scale_weights) *
      fs_weights$weight[match(classification, fs_weights$classification)]
  )

  pias <- with(
    weights,
    aggregation_structure(
      c(expand_classification(classification), list(business)),
      weight
    )
  )

  rel <- price_relative(fs_prices, price ~ period + business)

  epr <- elemental_index(fs_prices, rel ~ period + business)

  index <- aggregate(epr, pias, na.rm = TRUE)

  expect_equal(as.numeric(as.matrix(chain(index)[1:9, ])),
               fs_compare$index / 100)
})