tests/testthat/test-weights.R

In marberts/gpindex: Generalized Price and Quantity Indexes

set.seed(4321)
x <- rnorm(15)^2
xna <- replace(x, 2, NA)
w <- runif(15, 0, 2)
f <- factor(sample(letters[1:3], 15, TRUE))

test_that("weights transmute correctly", {
  expect_equal(transmute_weights(2, 2)(x), rep(1 / 15, length(x)))
  expect_equal(transmute_weights(2, 2)(c(1:3, NA)), c(1, 1, 1, NA) / 3)
  expect_equal(
    transmute_weights(0, 0)(xna, w),
    scale_weights(replace(w, 2, NA))
  )
  expect_equal(transmute_weights(2, 1)(c(1, NA)), c(1, NA))
  expect_equal(transmute_weights(-1, 1)(x, w), scale_weights(w / x))
  expect_equal(transmute_weights(1, -1)(xna, w), scale_weights(w * xna))
  # Used to give negative weights.
  expect_equal(transmute_weights(-1, 1)(1:3 / 2, 1:3 / 6), rep(1 / 3, 3))
  expect_equal(
    transmute_weights(7, -3)(x, transmute_weights(-3, 7)(x, w)),
    scale_weights(w)
  )
  expect_equal(
    grouped(transmute_weights(1, 2))(x, w, group = f),
    unsplit(Map(transmute_weights(1, 2), split(x, f), split(w, f)), f)
  )
  
  expect_error(transmute_weights(1, 1)(1:5, 1:4))
  expect_error(transmute_weights(1, 2)(1:5, 1:4))
})

test_that("contributions work correctly", {
  expect_equal(arithmetic_contributions(1:4), c(0, 0.25, 0.5, 0.75))
  expect_equal(harmonic_contributions(1:4), c(0, 0.24, 0.32, 0.36))
  expect_equal(geometric_contributions(c(1, 4)), c(0, 1))
  expect_equal(sum(contributions(-3.75)(x, w)),
               generalized_mean(-3.75)(x, w) - 1)
  expect_equal(sum(contributions(3.75)(xna, w), na.rm = TRUE),
               generalized_mean(3.75)(xna, w, na.rm = TRUE) - 1)
  expect_equal(
    as.numeric(tapply(grouped(geometric_contributions)(x, group = f), f, sum)),
    as.numeric(tapply(x, f, geometric_mean) - 1)
  )
})

test_that("weights factor correctly", {
  expect_equal(factor_weights(0)(c(1, NA)), c(1, NA))
  expect_equal(factor_weights(0)(x), rep(1, length(x)))
  expect_equal(factor_weights(0)(x, w), w)
  expect_equal(update_weights(xna, w), xna * w)
  expect_equal(grouped(update_weights)(x, w, group = f), x * w)
  
  expect_error(factor_weights(2)(1:5, 1:4))
  expect_error(factor_weights(0)(1:5, 1:4))
})

test_that("weights scale correctly", {
  expect_equal(sum(scale_weights(w)), 1)
  expect_equal(scale_weights(c(1:2, NA)), c(1:2, NA) / 3)
})

test_that("nested contributions work correctly", {
  expect_equal(
    sum(nested_contributions(3, c(-1, 2), c(0.75, 0.25))(x)),
    generalized_mean(3)(
      c(harmonic_mean(x), generalized_mean(2)(x)),
      c(0.75, 0.25)
    ) - 1
  )
  expect_equal(
    sum(nested_contributions2(3, c(-1, 2), c(0.75, 0.25))(x)),
    generalized_mean(3)(
      c(harmonic_mean(x), generalized_mean(2)(x)),
      c(0.75, 0.25)
    ) - 1
  )

  expect_equal(
    sum(nested_contributions(0, c(1, -1), c(0.5, 0.5))(x)),
    prod(sqrt(c(harmonic_mean(x), arithmetic_mean(x)))) - 1
  )
  expect_equal(
    nested_contributions(1, c(0, -1), c(1, 2))(xna, x, w),
    nested_contributions2(1, c(0, -1), c(1, 2))(xna, x, w)
  )

  expect_equal(
    sum(nested_contributions(1, c(0, -1), c(1, 2))(xna, x, w), na.rm = TRUE),
    nested_mean(1, c(0, -1), c(1, 2))(xna, x, w, na.rm = TRUE) - 1
  )

  expect_equal(
    sum(nested_contributions(0, c(3, -2))(x, w, xna), na.rm = TRUE),
    nested_mean(0, c(3, -2))(x, w, xna, na.rm = TRUE) - 1
  )

  expect_equal(
    sum(nested_contributions2(0, c(3, -2))(x, w, xna), na.rm = TRUE),
    nested_mean(0, c(3, -2))(x, w, xna, na.rm = TRUE) - 1
  )

  expect_equal(fisher_contributions(1:2, c(NA, NA)),
               fisher_contributions2(1:2, c(NA, NA)))

  expect_equal(fisher_contributions(1:2, c(NA, NA)),
               harmonic_contributions(1:2))

  expect_equal(nested_contributions(3, c(-1, 2), c(0.75, NA))(x),
               nested_contributions2(3, c(-1, 2), c(0.75, NA))(x))

  expect_equal(nested_contributions(3, c(-1, 2), c(0.75, NA))(x),
               harmonic_contributions(x))

  expect_equal(nested_contributions(3, c(2, -1), c(NA, 0.75))(x, w2 = xna),
               nested_contributions2(3, c(2, -1), c(NA, 0.75))(x, w2 = xna))

  expect_equal(nested_contributions(3, c(2, -1), c(NA, 0.75))(x, w2 = xna),
               harmonic_contributions(x, xna))

  expect_equal(nested_contributions(3, c(-1, 2), c(NA, NA))(x),
               rep(NA_real_, length(x)))

  expect_equal(nested_contributions2(3, c(-1, 2), c(NA, NA))(x),
               rep(NA_real_, length(x)))
})