tests/testthat/test-splice.R

In marberts/gpindex: Generalized Price and Quantity Indexes

x <- list(1:3, 3:5, 5:7)

test_that("key splice methods works", {
  # Movement splice.
  expect_equal(splice_index(x, 3), c(1, 2, 6, 30, 210))
  expect_equal(splice_index(x, 3, published = TRUE), c(1, 2, 6, 30, 210))
  # Window splice.
  expect_equal(splice_index(x, 1), c(1, 2, 6, 60, 630))
  expect_equal(splice_index(x, 1, published = TRUE), c(1, 2, 6, 60, 420))
  # Mean splice.
  expect_equal(
    splice_index(x),
    c(1, 2, 6, geometric_mean(c(60, 40, 30)),
      geometric_mean(rev(cumprod(rev(5:7))) * 3:5 * c(1, 2, 6)))
  )
  expect_equal(
    splice_index(x, published = TRUE),
    c(1, 2, 6, geometric_mean(c(60, 40, 30)),
      geometric_mean(c(420, 252, 7 * geometric_mean(c(60, 40, 30)))))
  )
})

test_that("result length is correct", {
  expect_equal(
    splice_index(x[-1], 3, c(1, 1, 1, 1, 2, 3)),
    c(1, 1, 1, 1, 2, 6, 30, 210)
  )
  expect_equal(
    splice_index(x[-1], 1, c(1, 1, 1, 1, 2, 3)),
    c(1, 1, 1, 1, 2, 6, 60, 630)
  )
  expect_equal(
    splice_index(x[-1], 1, c(1, 1, 1, 1, 2, 3), published = TRUE),
    c(1, 1, 1, 1, 2, 6, 60, 420)
  )
})

test_that("period subscripting works", {
  expect_equal(
    splice_index(x[-1], rep(3, 10), c(1, 1, 1, 1, 2, 3)),
    c(1, 1, 1, 1, 2, 6, 30, 210)
  )
  expect_equal(
    splice_index(x[-1], 4, c(1, 1, 1, 1, 2, 3)),
    c(1, 1, 1, 1, 2, 6, NA, NA)
  )
  expect_equal(
    splice_index(x[-1], -(2:3), c(1, 1, 1, 1, 2, 3), published = TRUE),
    c(1, 1, 1, 1, 2, 6, 60, 420)
  )
})

test_that("splicing is invariant", {
  # Movement
  expect_equal(splice_index(x, 3), splice_index(x[-1], 3, x[[1]]))
  expect_equal(splice_index(x, 3), splice_index(x[-(1:2)], 3, c(1, 2, 3, 5)))
  # Window
  expect_equal(splice_index(x, 1), splice_index(x[-1], 1, x[[1]]))
  expect_equal(
    splice_index(x, 1, published = TRUE),
    splice_index(x[-(1:2)], 1, c(1, 2, 3, 10), published = TRUE)
  )
  # Mean
  expect_equal(splice_index(x), splice_index(x[-1], initial = x[[1]]))
  expect_equal(
    splice_index(x, published = TRUE),
    splice_index(
      x[-(1:2)],
      initial = c(1, 2, 3, geometric_mean(c(10, 40 / 6, 5))),
      published = TRUE
    )
  )
})

test_that("NAs return NA", {
  expect_equal(splice_index(x, c(1, NA, 4)), c(1, 2, 6, NA, NA))
  x[[2]][2] <- NA
  expect_equal(splice_index(x), c(1, 2, 6, NA, NA))
  expect_equal(splice_index(x, 3), c(1, 2, 6, 30, 210))
})

test_that("corner cases work", {
  expect_equal(splice_index(list()), numeric(0))
  expect_equal(splice_index(list(), initial = 1:5), cumprod(1:5))
  expect_equal(splice_index(list(1:5)), cumprod(1:5))
  expect_equal(splice_index(list(1, 2, 3, 4, 5)), cumprod(1:5))
})

test_that("errors work", {
  expect_error(splice_index(list(1:3, 1:2)))
  expect_error(splice_index(list(1:3, 1:3), initial = 1:2))
})

test_that("splicing is the same as chaining", {
  x <- as.list(1:5)
  expect_equal(splice_index(x), cumprod(1:5))
  expect_equal(splice_index(x, initial = 1:3), cumprod(c(1:3, 1:5)))
  expect_equal(splice_index(x, published = TRUE), cumprod(1:5))
})

test_that("splicing keeps names", {
  x <- list(1:3, c(a = 1, b = 2, c = 3), z = c(1:2, c = 3))
  expect_identical(names(splice_index(x)), c("", "", "", "c", "z.c"))
})