Added more tests for splice_index()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gpindex
 Title: Generalized Price and Quantity Indexes
-Version: 0.6.0.9015
+Version: 0.6.0.9016
 Authors@R: c(
     person("Steve", "Martin", role = c("aut", "cre", "cph"),
     email = "[email protected]",

R/splice.R

@@ -6,9 +6,8 @@
 #' 
 #' @param x A list of equal-length numeric vectors giving the period-over-period
 #' indexes for each window.
-#' @param periods A vector (usually numeric) used to subscript each element of 
-#' `x` and give the splice points for each window. The default splices on each
-#' point in the window.
+#' @param periods An integer vector giving the splice points for each window.
+#' The default splices on each point in the window.
 #' @param initial A numeric vector giving an initial period-over-period index
 #' series onto which the elements of `x` are spliced. The default uses the
 #' first element of `x`.
@@ -43,6 +42,11 @@
 #' 
 #' splice_index(x, 1)
 #' 
+#' # Splicing on the published series preserves the within-window
+#' # movement of the index series
+#' 
+#' splice_index(x, 1, published = TRUE)
+#' 
 #' @family price index functions
 #' @export
 splice_index <- function(x, periods = NULL, initial = NULL, published = FALSE) {
@@ -68,6 +72,8 @@ splice_index <- function(x, periods = NULL, initial = NULL, published = FALSE) {
 
   if (is.null(periods)) {
     periods <- seq_len(n)
+  } else {
+    periods <- as.integer(periods)
   }
 
   y <- lapply(x, \(z) rev(cumprod(rev(z)))[periods])

tests/Examples/gpindex-Ex.Rout.save

@@ -506,7 +506,7 @@ Warning in back_period(period) :
 > # ... or use a mean splice
 > 
 > splice_index(tg)
-[1] 1.391443 1.801142 2.228836 2.688842
+[1] 1.391443 1.801142 2.228836 2.687826
 > 
 > #---- Missing data ----
 > 
@@ -1418,7 +1418,7 @@ t5   1.6720 1.0712    1.2477             0.9801 1.1850  1.2540  1.2678 0.9770
 > # Mean splice
 > 
 > splice_index(x)
-[1] 1.100000 0.990000 1.188000 1.686819 1.306793
+[1] 1.100000 0.990000 1.188000 1.686819 1.284405
 > 
 > # Movement splice
 > 
@@ -1428,6 +1428,12 @@ t5   1.6720 1.0712    1.2477             0.9801 1.1850  1.2540  1.2678 0.9770
 > # Window splice
 > 
 > splice_index(x, 1)
+[1] 1.10000 0.99000 1.18800 1.60160 1.18976
+> 
+> # Splicing on the published series preserves the within-window
+> # movement of the index series
+> 
+> splice_index(x, 1, published = TRUE)
 [1] 1.10000 0.99000 1.18800 1.60160 1.33848
 > 
 > 
@@ -1555,7 +1561,7 @@ t5   1.6720 1.0712    1.2477             0.9801 1.1850  1.2540  1.2678 0.9770
 > cleanEx()
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  0.095 0.023 0.118 0 0 
+Time elapsed:  0.105 0.012 0.117 0 0 
 > grDevices::dev.off()
 null device 
           1 

tests/testthat/test-geks.R

@@ -172,6 +172,35 @@ test_that("geks agrees with IndexNumR", {
   )
 })
 
+test_that("geks works with different splices", {
+  expect_equal(
+    splice_index(
+      with(dat, tornqvist_geks(price, quantity, period, product, window = 7))
+    ),
+    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)
+  )
+  expect_equal(
+    splice_index(
+      with(dat, fisher_geks(price, quantity, period, product, window = 3)),
+      periods = 1
+    ),
+    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)
+  )
+  expect_equal(
+    splice_index(
+      with(dat, jevons_geks(price, quantity, period, product, window = 6)),
+      periods = 3
+    ),
+    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_that("geks works as a quantity index", {
   expect_equal(
     with(

tests/testthat/test-splice.R

@@ -35,6 +35,21 @@ test_that("result length is correct", {
   )
 })
 
+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]]))