diff --git a/DESCRIPTION b/DESCRIPTION index 7dfe54c..f228b6e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: gpindex Title: Generalized Price and Quantity Indexes -Version: 0.6.0.9006 +Version: 0.6.0.9008 Authors@R: c( person("Steve", "Martin", role = c("aut", "cre", "cph"), email = "marberts@protonmail.com", diff --git a/R/geks.R b/R/geks.R index cc88ba8..ddf7ddb 100644 --- a/R/geks.R +++ b/R/geks.R @@ -109,16 +109,36 @@ geks_matrix <- function(index, p, q, product, n, nper, window, na.rm) { #' *Journal of Econometrics*, 161(1): 24--35. #' #' @examples -#' price <- 1:6 -#' quantity <- 6:1 -#' period <- rep(1:3, 2) -#' product <- rep(letters[1:2], each = 3) +#' price <- 1:10 +#' quantity <- 10:1 +#' period <- rep(1:5, 2) +#' product <- rep(letters[1:2], each = 5) #' -#' tornqvist_geks(price, quantity, period, product) +#' cumprod(tornqvist_geks(price, quantity, period, product)[[1]]) #' -#' tornqvist_geks(price, quantity, period, product, window = 2) +#' # Calculate the index over a rolling window +#' (tg <- tornqvist_geks(price, quantity, period, product, window = 3)) +#' +#' # Use a movement splice to combine the indexes in each window +#' cumprod(c(tg[[1]], sapply(tg[-1], \(x) x[length(x)]))) +#' +#' # ... or use a mean splice +#' mean_splice <- function(x, init) { +#' offset <- length(init) +#' x <- lapply(x, \(z) rev(cumprod(rev(z)))) +#' res <- numeric(offset + length(x)) +#' res[seq_len(init)] <- init +#' for (i in seq_along(x)) { +#' res[i + offset] <- geometric_mean( +#' x[[i]] * res[seq(to = i + offset - 1, length.out = length(x[[i]]))] +#' ) +#' } +#' res +#' } +#' +#' mean_splice(tg[-1], cumprod(tg[[1]])) #' -#' # Missing data +#' #---- Missing data ---- #' #' quantity[2] <- NA #' @@ -131,7 +151,8 @@ geks_matrix <- function(index, p, q, product, n, nper, window, na.rm) { #' fg <- geks(balanced(fisher_index)) #' fg(price, quantity, period, product, na.rm = TRUE) #' -#' # Make a Jevons GEKS index +#' #---- Make a Jevons GEKS index ---- +#' #' jevons_geks <- geks(\(p1, p0, ..., na.rm) jevons_index(p1, p0, na.rm)) #' jevons_geks(price, quantity, period, product) #' diff --git a/R/means.R b/R/means.R index a84c4d0..8a69276 100644 --- a/R/means.R +++ b/R/means.R @@ -676,18 +676,9 @@ contraharmonic_mean <- lehmer_mean(2) #' # A function to make the superlative quadratic mean price index by #' # Diewert (1976) as a product of generalized means #' -#' quadratic_mean_index <- function(x, w0, w1, r) { -#' x <- sqrt(x) -#' generalized_mean(r)(x, w0) * generalized_mean(-r)(x, w1) -#' } -#' -#' quadratic_mean_index(x, w1, w2, 2) -#' -#' # Same as the nested generalized mean (with the order halved) -#' -#' quadratic_mean_index2 <- function(r) nested_mean(0, c(r / 2, -r / 2)) +#' quadratic_mean_index <- function(r) nested_mean(0, c(r / 2, -r / 2)) #' -#' quadratic_mean_index2(2)(x, w1, w2) +#' quadratic_mean_index(2)(x, w1, w2) #' #' # The arithmetic AG mean index by Lent and Dorfman (2009) #' @@ -705,7 +696,7 @@ contraharmonic_mean <- lehmer_mean(2) #' q1 <- quantity6[[2]] #' q0 <- quantity6[[1]] #' -#' walsh <- quadratic_mean_index2(1) +#' walsh <- quadratic_mean_index(1) #' #' sum(p1 * q1) / sum(p0 * q0) / walsh(q1 / q0, p0 * q0, p1 * q1) #' @@ -715,6 +706,11 @@ contraharmonic_mean <- lehmer_mean(2) #' # quadratic mean price index of order 1 #' #' walsh(p1 / p0, p0 * q0, p1 * q1) +#' +#' # That requires using the average value share as weights +#' +#' walsh_weights <- sqrt(scale_weights(p0 * q0) * scale_weights(p1 * q1)) +#' walsh(p1 / p0, walsh_weights, walsh_weights) #' #' #---- Missing values ---- #' diff --git a/man/geks.Rd b/man/geks.Rd index 43d3601..ff384af 100644 --- a/man/geks.Rd +++ b/man/geks.Rd @@ -96,16 +96,36 @@ bilateral index, however, duplicated period-product pairs can have more subtle implications for a multilateral index. } \examples{ -price <- 1:6 -quantity <- 6:1 -period <- rep(1:3, 2) -product <- rep(letters[1:2], each = 3) - -tornqvist_geks(price, quantity, period, product) +price <- 1:10 +quantity <- 10:1 +period <- rep(1:5, 2) +product <- rep(letters[1:2], each = 5) + +cumprod(tornqvist_geks(price, quantity, period, product)[[1]]) + +# Calculate the index over a rolling window +(tg <- tornqvist_geks(price, quantity, period, product, window = 3)) + +# Use a movement splice to combine the indexes in each window +cumprod(c(tg[[1]], sapply(tg[-1], \(x) x[length(x)]))) + +# ... or use a mean splice +mean_splice <- function(x, init) { + offset <- length(init) + x <- lapply(x, \(z) rev(cumprod(rev(z)))) + res <- numeric(offset + length(x)) + res[seq_len(init)] <- init + for (i in seq_along(x)) { + res[i + offset] <- geometric_mean( + x[[i]] * res[seq(to = i + offset - 1, length.out = length(x[[i]]))] + ) + } + res +} -tornqvist_geks(price, quantity, period, product, window = 2) +mean_splice(tg[-1], cumprod(tg[[1]])) -# Missing data +#---- Missing data ---- quantity[2] <- NA @@ -118,7 +138,8 @@ fisher_geks(price, quantity, period, product, na.rm = TRUE) fg <- geks(balanced(fisher_index)) fg(price, quantity, period, product, na.rm = TRUE) -# Make a Jevons GEKS index +#---- Make a Jevons GEKS index ---- + jevons_geks <- geks(\(p1, p0, ..., na.rm) jevons_index(p1, p0, na.rm)) jevons_geks(price, quantity, period, product) diff --git a/man/nested_mean.Rd b/man/nested_mean.Rd index 21bc998..27d10ae 100644 --- a/man/nested_mean.Rd +++ b/man/nested_mean.Rd @@ -62,18 +62,9 @@ w2 <- 7:9 # A function to make the superlative quadratic mean price index by # Diewert (1976) as a product of generalized means -quadratic_mean_index <- function(x, w0, w1, r) { - x <- sqrt(x) - generalized_mean(r)(x, w0) * generalized_mean(-r)(x, w1) -} - -quadratic_mean_index(x, w1, w2, 2) - -# Same as the nested generalized mean (with the order halved) +quadratic_mean_index <- function(r) nested_mean(0, c(r / 2, -r / 2)) -quadratic_mean_index2 <- function(r) nested_mean(0, c(r / 2, -r / 2)) - -quadratic_mean_index2(2)(x, w1, w2) +quadratic_mean_index(2)(x, w1, w2) # The arithmetic AG mean index by Lent and Dorfman (2009) @@ -91,7 +82,7 @@ p0 <- price6[[1]] q1 <- quantity6[[2]] q0 <- quantity6[[1]] -walsh <- quadratic_mean_index2(1) +walsh <- quadratic_mean_index(1) sum(p1 * q1) / sum(p0 * q0) / walsh(q1 / q0, p0 * q0, p1 * q1) @@ -102,6 +93,11 @@ sum(p1 * sqrt(q1 * q0)) / sum(p0 * sqrt(q1 * q0)) walsh(p1 / p0, p0 * q0, p1 * q1) +# That requires using the average value share as weights + +walsh_weights <- sqrt(scale_weights(p0 * q0) * scale_weights(p1 * q1)) +walsh(p1 / p0, walsh_weights, walsh_weights) + #---- Missing values ---- x[1] <- NA diff --git a/tests/Examples/gpindex-Ex.Rout.save b/tests/Examples/gpindex-Ex.Rout.save index 8dc3d49..0039acc 100644 --- a/tests/Examples/gpindex-Ex.Rout.save +++ b/tests/Examples/gpindex-Ex.Rout.save @@ -473,28 +473,56 @@ Warning in back_period(period) : > > ### ** Examples > -> price <- 1:6 -> quantity <- 6:1 -> period <- rep(1:3, 2) -> product <- rep(letters[1:2], each = 3) +> price <- 1:10 +> quantity <- 10:1 +> period <- rep(1:5, 2) +> product <- rep(letters[1:2], each = 5) > -> tornqvist_geks(price, quantity, period, product) -[[1]] - 2 3 -1.530869 1.376227 - +> cumprod(tornqvist_geks(price, quantity, period, product)[[1]]) + 2 3 4 5 +1.413257 1.835676 2.284565 2.789856 > -> tornqvist_geks(price, quantity, period, product, window = 2) +> # Calculate the index over a rolling window +> (tg <- tornqvist_geks(price, quantity, period, product, window = 3)) [[1]] - 2 -1.520408 + 2 3 +1.391443 1.294442 [[2]] - 3 -1.366822 + 3 4 +1.292486 1.238393 + +[[3]] + 4 5 +1.238417 1.205921 > -> # Missing data +> # Use a movement splice to combine the indexes in each window +> cumprod(c(tg[[1]], sapply(tg[-1], \(x) x[length(x)]))) + 2 3 4 5 +1.391443 1.801142 2.230521 2.689833 +> +> # ... or use a mean splice +> mean_splice <- function(x, init) { ++ offset <- length(init) ++ x <- lapply(x, \(z) rev(cumprod(rev(z)))) ++ res <- numeric(offset + length(x)) ++ res[seq_len(init)] <- init ++ for (i in seq_along(x)) { ++ res[i + offset] <- geometric_mean( ++ x[[i]] * res[seq(to = i + offset - 1, length.out = length(x[[i]]))] ++ ) ++ } ++ res ++ } +> +> mean_splice(tg[-1], cumprod(tg[[1]])) +Warning in seq_len(init) : first element used of 'length.out' argument +Warning in res[seq_len(init)] <- init : + number of items to replace is not a multiple of replacement length +[1] 1.391443 0.000000 0.000000 0.000000 +> +> #---- Missing data ---- > > quantity[2] <- NA > @@ -502,8 +530,8 @@ Warning in back_period(period) : > > fisher_geks(price, quantity, period, product, na.rm = TRUE) [[1]] - 2 3 -1.455853 1.370478 + 2 3 4 5 +1.438137 1.234230 1.234212 1.216746 > > # Remove records with any missing data @@ -511,16 +539,17 @@ Warning in back_period(period) : > fg <- geks(balanced(fisher_index)) > fg(price, quantity, period, product, na.rm = TRUE) [[1]] - 2 3 -1.403078 1.346954 + 2 3 4 5 +1.501481 1.148250 1.219688 1.199513 > -> # Make a Jevons GEKS index +> #---- Make a Jevons GEKS index ---- +> > jevons_geks <- geks(\(p1, p0, ..., na.rm) jevons_index(p1, p0, na.rm)) > jevons_geks(price, quantity, period, product) [[1]] - 2 3 -1.581139 1.341641 + 2 3 4 5 +1.527525 1.309307 1.224745 1.178511 > > @@ -962,19 +991,9 @@ Warning in back_period(period) : > # A function to make the superlative quadratic mean price index by > # Diewert (1976) as a product of generalized means > -> quadratic_mean_index <- function(x, w0, w1, r) { -+ x <- sqrt(x) -+ generalized_mean(r)(x, w0) * generalized_mean(-r)(x, w1) -+ } -> -> quadratic_mean_index(x, w1, w2, 2) -[1] 1.912366 -> -> # Same as the nested generalized mean (with the order halved) -> -> quadratic_mean_index2 <- function(r) nested_mean(0, c(r / 2, -r / 2)) +> quadratic_mean_index <- function(r) nested_mean(0, c(r / 2, -r / 2)) > -> quadratic_mean_index2(2)(x, w1, w2) +> quadratic_mean_index(2)(x, w1, w2) [1] 1.912366 > > # The arithmetic AG mean index by Lent and Dorfman (2009) @@ -994,7 +1013,7 @@ Warning in back_period(period) : > q1 <- quantity6[[2]] > q0 <- quantity6[[1]] > -> walsh <- quadratic_mean_index2(1) +> walsh <- quadratic_mean_index(1) > > sum(p1 * q1) / sum(p0 * q0) / walsh(q1 / q0, p0 * q0, p1 * q1) [1] 1.401718 @@ -1008,6 +1027,12 @@ Warning in back_period(period) : > walsh(p1 / p0, p0 * q0, p1 * q1) [1] 1.401534 > +> # That requires using the average value share as weights +> +> walsh_weights <- sqrt(scale_weights(p0 * q0) * scale_weights(p1 * q1)) +> walsh(p1 / p0, walsh_weights, walsh_weights) +[1] 1.401718 +> > #---- Missing values ---- > > x[1] <- NA @@ -1511,7 +1536,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.335 0.025 0.361 0 0 +Time elapsed: 0.35 0.044 0.445 0 0 > grDevices::dev.off() null device 1