tests/testthat/test-geks.R

In marberts/gpindex: Generalized Price and Quantity Indexes

dat <- data.frame(
  price = 1:65, quantity = 65:1, period = 1:13, product = rep(1:5, each = 13)
)
dat <- dat[c(65:60, 3:59, 1:2), ]
dat2 <- dat[-c(2:3, 7, 15, 64), ]

jevons_geks <- geks(\(p1, p0, ..., na.rm) jevons_index(p1, p0, na.rm))

test_that("geks works in corner cases", {
  expect_identical(
    fisher_geks(integer(0), numeric(0), logical(0), character(0)),
    list()
  )
  expect_identical(
    fisher_geks(integer(0), numeric(0), factor(logical(0), 1:5), character(0)),
    list(c("2" = NaN, "3" = NaN, "4" = NaN, "5" = NaN))
  )
  expect_equal(
    fisher_geks(c(1, 5, 4, 2, 3, 6, 1, 2),
                c(1, 1, 2, 2, 1, 2, 3, 1),
                c(1, 1, 1, 1, 2, 2, 2, 2),
                c("a", "b", "c", "d", "a", "b", "c", "d")),
    list(c("2" = fisher_index(c(3, 6, 1, 2),
                              c(1, 5, 4, 2),
                              c(1, 2, 3, 1),
                              c(1, 1, 2, 2))))
  )
  expect_equal(tornqvist_geks(1:2, 1:2, letters[1:2], c(1, 1)),
               list(c(b = 2)))
})

test_that("geks agrees with IndexNumR", {
  expect_equal(
    cumprod(
      as.numeric(
        unlist(with(dat, tornqvist_geks(price, quantity, period, product)))
      )
    ),
    c(1.07334245809641, 1.13758500234551, 1.19943273670278, 1.26078373138759,
      1.32242752173496, 1.38478458426165, 1.44813211799635, 1.51269173915522,
      1.57867050804161, 1.64628410287697, 1.71577307463249, 1.78741712742392)
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(with(dat, jevons_geks(price, quantity, period, product)))
      )
    ),
    c(1.18338442313092, 1.32033674805411, 1.43711591151299, 1.54248452241533,
      1.64048980305452, 1.73334427991861, 1.82239254133738, 1.90851390842145,
      1.99231538702512, 2.07423380909548, 2.15459410924166, 2.23364458259815)
  )
  test <- with(dat, fisher_geks(price, quantity, period, product, 11))
  expect_equal(
    cumprod(as.numeric(c(test[[1]], test[[2]][10], test[[3]][10]))),
    c(1.05584109330239, 1.11216779883715, 1.16904493358996, 1.22654588965604,
      1.28475480484066, 1.34376919838486, 1.40370325012859, 1.46469196029632,
      1.5268965162016, 1.59051132643364, 1.65525192178965, 1.721202953357)
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(with(dat, fisher_geks(price, quantity, period, product, n = 11)))
      )
    ),
    c(1.05374791146818, 1.1079745122232, 1.16274614004633, 1.21813825064384,
      1.27423777574742, 1.33114601874993, 1.38898229585753, 1.44788860470373,
      1.50803571488446, 1.56963124638734, 1.63293056684376)
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(with(dat, fisher_geks(price, quantity, period, product, n = 10)))
      )
    ),
    c(1.05146069583139, 1.10343861884982, 1.15600537603593, 1.20924346504472,
      1.26324902214539, 1.31813527765125, 1.37403698640446, 1.43111620765476,
      1.4895699714369, 1.54964061999289)
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(with(dat, fisher_geks(price, quantity, period, product, 2)))
      )
    ),
    c(1.05488895039924, 1.11045527234441, 1.1667173418342, 1.2236967401878,
      1.28141852837846, 1.33991159494773, 1.39920908948289, 1.45934895785986,
      1.52037460080832, 1.58233568433829, 1.64528913987317, 1.70930040456311)
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(
          with(dat, walsh_geks(price, quantity, period, product))
        )
      )
    ),
    c(1.0566699129383, 1.11378295838144, 1.17139426903106, 1.22956960896297,
      1.28838882562161, 1.34795095779689, 1.40838221049365, 1.46984928172641,
      1.53258374680655, 1.59693277586978, 1.66348762735518, 1.7335492978583)
  )
  test <- with(
    dat,
    walsh_geks(price, quantity, period, product, 10, 3)
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(
          as.numeric(c(test[[1]], test[[2]][3], test[[3]][3], test[[4]][3]))
        )
      )
    ),
    c(1.044688300757481, 1.090268005747500, 1.136945278111909,
      1.184556889920806, 1.233276530383314, 1.283484684164579)
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(
          with(
            dat2,
            geks(balanced(geometric_index("Tornqvist")))(
              price, quantity, period, product, na.rm = TRUE
            )
          )
        )
      )
    ),
    c(0.97012367078552, 1.07680890198379, 1.07558882705777, 1.12676970820557,
      1.17801945580172, 1.22966120693395, 1.28190412021848, 1.33491131065706,
      1.38883148578389, 1.40614308033419, 1.5157156152315, 1.55767693905705)
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(with(dat2, jevons_geks(price, quantity, period, product,
                                      na.rm = TRUE)))
      )
    ),
    c(0.881430091367338, 1.07738238354928, 1.04409985620757, 1.11240421520015,
      1.1762944906968, 1.23711048474119, 1.29566160297349, 1.35247476672703,
      1.40791242863053, 1.40078559388863, 1.56851442510621, 1.56825957051767)
  )
  expect_equal(
    as.numeric(
      with(
        dat2,
        geks(balanced(fisher_index))(
          price, quantity, period, product, na.rm = TRUE, n = 1
        )
      )
    ),
    1.02676364331238
  )
  expect_equal(
    cumprod(
      as.numeric(
        unlist(
          with(
            dat2,
            geks(balanced(arithmetic_index("Walsh1")))(
              price, quantity, period, product, 2, na.rm = TRUE
            )
          )
        )
      )
    ),
    c(1.03718005998263, 1.07464654973022, 1.11241262026669, 1.16674135968705,
      1.22177863428673, 1.27755224912525, 1.33409420817545, 1.39144132753221,
      1.44963608201481, 1.49468455394966, 1.53991593521434, 1.60081842092565)
  )
})

test_that("geks works with different splices", {
  expect_equal(
    splice_index(
      with(dat, tornqvist_geks(price, quantity, period, product, window = 7))
    ),
    setNames(
      c(1.06202143784605, 1.1203648908828, 1.17858384039388, 1.23760852899173,
        1.29782138422918, 1.35944797067126, 1.4190362067647, 1.48010601630221,
        1.5422495225642, 1.60541380403309, 1.66962623911985, 1.73494499443271),
      2:13
    )
  )
  expect_equal(
    splice_index(
      with(dat, fisher_geks(price, quantity, period, product, window = 3)),
      periods = 1
    ),
    setNames(
      c(1.05490954999787, 1.11049864213464, 1.16678403299157, 1.22378841881023, 
        1.28153702754999, 1.34005894105164, 1.3993875342448, 1.45956101762071,
        1.52062310501187, 1.58262383588933, 1.64562059096184, 1.70967935288461),
      2:13
    )
  )
  expect_equal(
    splice_index(
      with(dat, jevons_geks(price, quantity, period, product, window = 6)),
      periods = 3
    ),
    setNames(
      c(1.18338442313092, 1.32033674805411, 1.43711591151299, 1.54248452241533,
        1.64048980305452, 1.73334427991861, 1.82239254133738, 1.90851390842145,
        1.99231538702512, 2.07423380909548, 2.15459410924166, 2.23364458259815),
      2:13
    )
  )
})

test_that("geks works as a quantity index", {
  expect_equal(
    with(
      dat,
      geks(balanced(fisher_index))(
        price, quantity, period, product, na.rm = TRUE
      )
    ),
    with(
      dat,
      quantity_index(geks(balanced(fisher_index)))(
        period, p = quantity, product, na.rm = TRUE, q = price
      )
    )
  )
  expect_equal(
    with(
      dat2,
      geks(balanced(fisher_index))(
        price, quantity, period, product, na.rm = TRUE
      )
    ),
    with(
      dat2,
      geks(balanced(quantity_index(fisher_index)))(
        period, p = quantity, product, na.rm = TRUE, q = price
      )
    )
  )
})

test_that("'n' doesn't change the value in subsequent periods", {
  expect_equal(
    with(
      dat,
      fisher_geks(price, quantity, period, product, na.rm = TRUE, n = 7)[[1]]
    ),
    with(
      dat,
      fisher_geks(price, quantity, period, product, na.rm = TRUE)
    )[[1]][6:12]
  )
  expect_equal(
    with(
      dat2,
      fisher_geks(
        price, quantity, period, product, na.rm = TRUE, n = 7
      )[[1]][6:7]
    ),
    with(
      dat2,
      fisher_geks(price, quantity, period, product, na.rm = TRUE, n = 2)
    )[[1]]
  )
  expect_equal(
    lapply(
      with(
        dat2,
        tornqvist_geks(
          price, quantity, period, product, na.rm = TRUE, window = 9, n = 6
        )
      ), `[`, 6),
    with(
      dat2,
      tornqvist_geks(
        price, quantity, period, product, na.rm = TRUE, window = 9, n = 1
      )
    )
  )
})

test_that("errors work for geks", {
  expect_error(
    with(dat, tornqvist_geks(price, quantity, period[-1], product))
  )
  expect_error(
    with(dat, tornqvist_geks(price, quantity, period, product, n = 0))
  )
  expect_error(
    with(dat, tornqvist_geks(price, quantity, period, product, n = 13))
  )
  expect_error(
    with(dat, tornqvist_geks(price, quantity, period, product, n = 1:2))
  )
  expect_error(
    with(dat, tornqvist_geks(price, quantity, period, product, window = 1))
  )
  expect_error(
    with(dat, tornqvist_geks(price, quantity, period, product, window = 14))
  )
  expect_error(
    with(dat, tornqvist_geks(price, quantity, period, product, window = 1:2))
  )
})