diff --git a/DESCRIPTION b/DESCRIPTION index 3b4e63b..b90ed40 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,6 +27,7 @@ Suggests: data.tree, knitr, quarto, + rsmatrix, sps, tinytest, treemap diff --git a/R/aggregate.piar_index.R b/R/aggregate.piar_index.R index 87ca0af..85f9302 100644 --- a/R/aggregate.piar_index.R +++ b/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. #' diff --git a/R/aggregation_structure-class.R b/R/aggregation_structure-class.R index 036d117..1decc7d 100644 --- a/R/aggregation_structure-class.R +++ b/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)) { diff --git a/R/aggregation_structure.R b/R/aggregation_structure.R index 507a7d2..3ea1e1a 100644 --- a/R/aggregation_structure.R +++ b/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( diff --git a/R/back_period.R b/R/back_period.R index 0317b33..353e337 100644 --- a/R/back_period.R +++ b/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)) { diff --git a/R/combine_classifications.R b/R/combine_classifications.R index e738139..e64d878 100644 --- a/R/combine_classifications.R +++ b/R/combine_classifications.R @@ -29,7 +29,7 @@ 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 ) @@ -37,7 +37,7 @@ combine_classifications <- function(..., sep = ".") { #' 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) diff --git a/R/contrib.R b/R/contrib.R index 9516924..c9eda55 100644 --- a/R/contrib.R +++ b/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( diff --git a/R/elementary_index.R b/R/elementary_index.R index 27fcf2d..72241ed 100644 --- a/R/elementary_index.R +++ b/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()) { @@ -201,8 +201,11 @@ elementary_index.numeric <- function( r <- as.numeric(r) period <- as.factor(period %||% gl(1, length(x))) ea <- as.factor(ea %||% gl(1, length(x))) + if (!is.null(product)) { + product <- as.character(product) + } - if (different_length(x, period, ea, weights)) { + if (different_length(x, period, ea, weights, product)) { stop("input vectors must be the same length") } if (any(x <= 0, na.rm = TRUE)) { @@ -214,7 +217,7 @@ elementary_index.numeric <- function( if (contrib) { if (!is.null(product)) { - names(x) <- as.character(product) + names(x) <- product } if (is.null(names(x))) { names(x) <- paste(ea, sequential_names(period, ea), sep = ".") diff --git a/R/emean.R b/R/emean.R index 4923356..2195d14 100644 --- a/R/emean.R +++ b/R/emean.R @@ -78,12 +78,12 @@ emean <- function( # length of the other. if (length(x) > length(y)) { if (length(y) > 0 && length(x) %% length(y) != 0) { - warning("length of `y` is not a multiple of length of `x`") + warning("length of `x` is not a multiple of length of `y`") y <- rep_len(y, length(x)) } } else if (length(x) < length(y)) { if (length(x) > 0 && length(y) %% length(x) != 0) { - warning("length of `x` is not a multiple of length of `y`") + warning("length of `y` is not a multiple of length of `x`") x <- rep_len(x, length(y)) } } diff --git a/R/geks_index.R b/R/geks_index.R index 5620866..99e8673 100644 --- a/R/geks_index.R +++ b/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") diff --git a/R/gmean.R b/R/gmean.R index 1a67f28..bcbeb24 100644 --- a/R/gmean.R +++ b/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, diff --git a/R/window.piar_index.R b/R/window.piar_index.R index bbb18f2..514f783 100644 --- a/R/window.piar_index.R +++ b/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 diff --git a/inst/tinytest/test-back_period.R b/inst/tinytest/test-back_period.R index cc91179..c255c65 100644 --- a/inst/tinytest/test-back_period.R +++ b/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\\)`" + ) }) diff --git a/inst/tinytest/test-emean.R b/inst/tinytest/test-emean.R index 612b0ea..f72f603 100644 --- a/inst/tinytest/test-emean.R +++ b/inst/tinytest/test-emean.R @@ -76,7 +76,7 @@ expect_error( # Recycling works expect_warning( emean(1:3, 1:5), - "length of `x` is not a multiple of length of `y`" + "length of `y` is not a multiple of length of `x`" ) expect_equal( suppressWarnings(emean(1:3, 1:5)), @@ -86,7 +86,7 @@ expect_equal(emean(1:5, numeric(0)), numeric(0)) expect_warning( emean(1:5, 1:3), - "length of `y` is not a multiple of length of `x`" + "length of `x` is not a multiple of length of `y`" ) expect_equal( suppressWarnings(emean(1:5, 1:3)), diff --git a/man/aggregate.piar_index.Rd b/man/aggregate.piar_index.Rd index f822023..d4cc5b8 100644 --- a/man/aggregate.piar_index.Rd +++ b/man/aggregate.piar_index.Rd @@ -136,9 +136,9 @@ contributions will not equal the change in the value of the index. If two aggregation structures are given then the steps above are done for each aggregation structure, with the aggregation for \code{pias} done with a -generalized mean of order \code{r} the aggregation for \code{pias2} done with a -generalized mean of order \code{-r}. The resulting indexes are combined with a -geometric mean to make a superlative quadratic mean of order \code{2*r} index. +generalized mean of order \code{order} the aggregation for \code{pias2} done with a +generalized mean of order \code{-order}. The resulting indexes are combined with a +geometric mean to make a superlative quadratic mean of order \code{2*order} index. Percent-change contributions are combined using a generalized van IJzeren decomposition; see \code{\link[=transmute_weights2]{transmute_weights2()}} for details. } diff --git a/man/contrib.Rd b/man/contrib.Rd index b5b45f6..aa2814c 100644 --- a/man/contrib.Rd +++ b/man/contrib.Rd @@ -77,8 +77,8 @@ contrib(index) 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( diff --git a/man/elementary_index.Rd b/man/elementary_index.Rd index 84e335f..ae6a92c 100644 --- a/man/elementary_index.Rd +++ b/man/elementary_index.Rd @@ -108,7 +108,7 @@ should be unique within each elementary aggregate at each time period when making contributions and, if not, are passed to \code{\link[=make.unique]{make.unique()}} with a warning. The default -(\code{r = 0} and no weights) makes Jevons elementary indexes. See chapter 8 +(\code{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). @@ -171,7 +171,7 @@ elementary_index( prices, rel ~ period + ea, weights = unsplit(cswd_weights, interaction(period, ea)), - r = 1 + order = 1 ) } \references{ diff --git a/man/geks_index.Rd b/man/geks_index.Rd index c71bb3a..7247f0c 100644 --- a/man/geks_index.Rd +++ b/man/geks_index.Rd @@ -118,8 +118,10 @@ aggregation and the construction of price indexes. \emph{Journal of Econometrics}, 161(1): 24--35. } \seealso{ +\code{\link[=splice_index]{splice_index()}} to splice the rolling-window indexes together. + \code{GEKSIndex()} in the \pkg{IndexNumR} package for an implementation of the GEKS index with more options. -\code{\link[=splice_index]{splice_index()}} to splice the rolling-window indexes together. +The \pkg{rsmatrix} package for multilateral repeat-sales indexes. } diff --git a/man/gmean.Rd b/man/gmean.Rd index 434c3a1..cfc6de2 100644 --- a/man/gmean.Rd +++ b/man/gmean.Rd @@ -28,7 +28,7 @@ Calculated a weighted generalized mean. 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 \code{x} and \code{weights} should be strictly positive +Both \code{x} and \code{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. @@ -38,7 +38,7 @@ has zeros: the generalized mean is 0 whenever the weights are strictly positive and \code{order < 0}. The analogous convention holds whenever at least one element of \code{x} is \code{Inf}: the generalized mean is \code{Inf} whenever the weights are strictly positive and \code{order > 0}. -\item Some authors let the weighs be non-negative and sum to 1. If there are +\item Some authors let the weights be non-negative and sum to 1. If there are zero weights then the corresponding element of \code{x} has no impact on the result whenever \code{x} is strictly positive. Unlike \code{\link[=weighted.mean]{weighted.mean()}}, however, diff --git a/man/window.piar_index.Rd b/man/window.piar_index.Rd index e2219be..2127cf2 100644 --- a/man/window.piar_index.Rd +++ b/man/window.piar_index.Rd @@ -21,7 +21,8 @@ is the last period of \code{x}.} \item{...}{Not currently used.} -\item{value}{\verb{[numeric > 0 | piar_index]} A numeric vector or price index.} +\item{value}{\verb{[numeric > 0 | piar_index]} A numeric vector or price index +of replacement values.} } \value{ \code{window()} extracts a price index over a window of time periods that