Version 0.10.0

DESCRIPTION

@@ -27,6 +27,7 @@ Suggests:
     data.tree,
     knitr,
     quarto,
+    rsmatrix,
     sps,
     tinytest,
     treemap

R/aggregate.piar_index.R

@@ -49,9 +49,9 @@
 #'
 #' If two aggregation structures are given then the steps above are done for
 #' each aggregation structure, with the aggregation for `pias` done with a
-#' generalized mean of order `r` the aggregation for `pias2` done with a
-#' generalized mean of order `-r`. The resulting indexes are combined with a
-#' geometric mean to make a superlative quadratic mean of order `2*r` index.
+#' generalized mean of order `order` the aggregation for `pias2` done with a
+#' generalized mean of order `-order`. The resulting indexes are combined with a
+#' geometric mean to make a superlative quadratic mean of order `2*order` index.
 #' Percent-change contributions are combined using a generalized van IJzeren
 #' decomposition; see [`transmute_weights2()`] for details.
 #'

R/aggregation_structure-class.R

@@ -22,6 +22,9 @@ piar_aggregation_structure <- function(child, parent, levels, weights) {
 }
 
 #---- Validator ----
+# The first two validators are not extensively used and duplicate checking
+# already done by aggregation_structure(). They're here in case a validator
+# is needed in the future.
 validate_pias_levels <- function(x) {
   lev <- unlist(x$levels, use.names = FALSE)
   if (missing_names(lev)) {

R/aggregation_structure.R

@@ -124,7 +124,7 @@ aggregation_structure <- function(x, weights = NULL) {
   }
   upper <- x[-len] # nodes above eas
   lower <- x[-1L] # nodes below initial nodes
-  child <- parent <- vector("list", len)[-1L]
+  child <- parent <- vector("list", length(upper))
   # Produce a list for each level with all the parent and child nodes.
   for (i in seq_along(upper)) {
     child[[i]] <- lapply(

R/back_period.R

@@ -66,9 +66,6 @@ back_period <- function(
     x[c(rep.int(1L, offset), seq_len(length(x) - offset))]
   }
   offset <- as.integer(offset)
-  if (offset < 0L || offset > length(period)) {
-    stop("`offset` must be a positive integer less than the length of `period`")
-  }
   period <- as.factor(period)
   product <- as.factor(product %||% gl(1, length(period)))
   attributes(product) <- NULL # matching is faster on factor codes
@@ -80,6 +77,9 @@ back_period <- function(
   if (nlevels(period) == 0L) {
     return(rep.int(NA_integer_, length(period)))
   }
+  if (offset < 0L || offset > nlevels(period)) {
+    stop("`offset` must be a positive integer less than `nlevels(period)`")
+  }
 
   product <- split(product, period)
   if (duplicate_products(product)) {

R/combine_classifications.R

@@ -29,15 +29,15 @@
 combine_classifications <- function(..., sep = ".") {
   dots <- lapply(list(...), \(x) lapply(x, as.character))
   Reduce(
-    \(x, y) combine_classifications_(x, y, sep = sep),
+    \(x, y) .combine_classifications(x, y, sep = sep),
     dots,
     simplify = FALSE
   )
 }
 
 #' Combine classifications (internal)
 #' @noRd
-combine_classifications_ <- function(x, y, sep) {
+.combine_classifications <- function(x, y, sep) {
   lx <- lengths(x)
   if (length(lx) == 0L) {
     return(y)

R/contrib.R

@@ -56,8 +56,8 @@
 #' contrib2DF(index)
 #'
 #' # Calculate EA contributions for the chained index.
-#' arithmetic_contributions <- function(x, w, r = 1) {
-#'   (x - 1) * transmute_weights(x, w, r, to = 1)
+#' arithmetic_contributions <- function(x, w, order = 1) {
+#'   (x - 1) * transmute_weights(x, w, order, to = 1)
 #' }
 #'
 #' arithmetic_contributions(

R/elementary_index.R

@@ -14,7 +14,7 @@
 #' be unique within each elementary aggregate at each time period when making
 #' contributions and, if not, are
 #' passed to [make.unique()] with a warning. The default
-#' (\code{r = 0} and no weights) makes Jevons elementary indexes. See chapter 8
+#' (`order = 0` and no weights) makes Jevons elementary indexes. See chapter 8
 #' (pp. 175--190) of the CPI manual (2020) for more detail about making
 #' elementary indexes, or chapter 9 of the PPI manual (2004), and chapter 5 of
 #' Balk (2008).
@@ -161,7 +161,7 @@
 #'   prices,
 #'   rel ~ period + ea,
 #'   weights = unsplit(cswd_weights, interaction(period, ea)),
-#'   r = 1
+#'   order = 1
 #' )
 elementary_index <- function(x, ...) {
   if ("r" %in% ...names()) {

R/geks_index.R

@@ -53,10 +53,12 @@
 #' subtle implications for a multilateral index.
 #'
 #' @seealso
+#' [`splice_index()`] to splice the rolling-window indexes together.
+#'
 #' `GEKSIndex()` in the \pkg{IndexNumR} package for an implementation of the
 #' GEKS index with more options.
 #'
-#' [`splice_index()`] to splice the rolling-window indexes together.
+#' The \pkg{rsmatrix} package for multilateral repeat-sales indexes.
 #'
 #' @references
 #' Balk, B. M. (2008). *Price and Quantity Index Numbers*.
@@ -125,8 +127,8 @@ geks_index <- function(
   }
 
   window <- as.integer(window)
-  if (length(window) > 1L || window < 2L) {
-    stop("`window` must be a integer greater than or equal to 2")
+  if (window < 2L) {
+    stop("`window` must be greater than or equal to 2")
   }
   if (window > nlevels(period)) {
     stop(
@@ -136,8 +138,8 @@ geks_index <- function(
   }
 
   n <- as.integer(n)
-  if (length(n) > 1L || n < 1L) {
-    stop("`n` must be an integer greater than or equal to 1")
+  if (n < 1L) {
+    stop("`n` must be greater than or equal to 1")
   }
   if (n > window - 1L) {
     stop("`n` must be less than or equal to `window` minus 1")

R/gmean.R

@@ -5,7 +5,7 @@
 #' The generalized mean is also called the power mean, Hölder mean, or \eqn{l_p}
 #' mean; see Bullen (2003, p. 175) for details.
 #'
-#' Both `x` and `weights` should be strictly positive
+#' Both `x` and `weights` are usually strictly positive
 #' (and finite), especially for the purpose of making a price index. This is not
 #' enforced, but the results may not make sense if the generalized mean is not
 #' defined. There are two exceptions to this.
@@ -15,7 +15,7 @@
 #' one element of `x` is `Inf`: the generalized mean is `Inf` whenever the
 #' weights are strictly positive and `order > 0`.
 #'
-#' 2. Some authors let the weighs be non-negative and sum to 1. If there are
+#' 2. Some authors let the weights be non-negative and sum to 1. If there are
 #' zero weights then the corresponding element
 #' of `x` has no impact on the result whenever `x` is strictly
 #' positive. Unlike [weighted.mean()], however,

R/window.piar_index.R

@@ -9,7 +9,8 @@
 #' @param end `[character(1)]` The time period to end the window. The default
 #'   is the last period of `x`.
 #' @param ... Not currently used.
-#' @param value `[numeric > 0 | piar_index]` A numeric vector or price index.
+#' @param value `[numeric > 0 | piar_index]` A numeric vector or price index
+#'   of replacement values.
 #'
 #' @returns
 #' `window()` extracts a price index over a window of time periods that

inst/tinytest/test-back_period.R

@@ -83,6 +83,16 @@ local({
 
 # Warnings and errors.
 local({
-  expect_warning(back_period(c(1, 1, 2, 3)))
-  expect_error(back_period(1:5, 1:4))
+  expect_warning(
+    back_period(c(1, 1, 2, 3)),
+    "there are duplicated period-product pairs"
+  )
+  expect_error(
+    back_period(1:5, 1:4),
+    "`period` and `product` must be the same length"
+  )
+  expect_error(
+    back_period(c(1, 1, 2, 2), c(1, 2, 1, 2), offset = 3),
+    "`offset` must be a positive integer less than `nlevels\\(period\\)`"
+  )
 })