feat: Consistent use of order

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: piar
 Title: Price Index Aggregation
-Version: 0.9.0.9005
+Version: 0.9.0.9006
 Authors@R: c(
     person("Steve", "Martin", role = c("aut", "cre", "cph"),
            email = "marberts@protonmail.com",

NEWS.md

@@ -2,17 +2,21 @@
 
 ## Significant changes
 
-- Many functions from `{gpindex}` are now part of `{piar}`. This gives a somewhat
+- Many functions from `{gpindex}` are now part of this package. This gives a somewhat
 more consistent experience and allows for improvements that would be difficult with
 two separate packages. In particular:
 
     - A new function `outliers()` to find extreme price relatives.
 
-    - Functions for multilateral indexes.
+    - Functions for multilateral GEKS indexes.
 
     - Core mathematical machinery used to aggregate indexes and make product contributions.
 
     - A new vignette outlining some theory that unlies how indexes are calculated.
+
+- The argument `r` in `elementary_index()`, `aggregate()`, `mean()`, `update()`,
+and `impute_prices()` is deprecated and will be removed in a future version.
+Use `order` instead.
 
 ## Improvements
 

R/aggregate.piar_index.R

@@ -71,8 +71,8 @@
 #' @param na.rm `[logical(1)]` Should missing values be removed? By default,
 #'   missing values are not removed. Setting `na.rm = TRUE` is equivalent to
 #'   overall mean imputation.
-#' @param r `[numeric(1)]` Order of the generalized mean to aggregate index
-#'   values. 0 for a
+#' @param order,r `[numeric(1)]` Order of the generalized mean to aggregate
+#'   index values. 0 for a
 #'   geometric index (the default for making elementary indexes), 1 for an
 #'   arithmetic index (the default for aggregating elementary indexes and
 #'   averaging indexes over subperiods), or -1 for a harmonic index (usually for
@@ -149,19 +149,23 @@ aggregate.chainable_piar_index <- function(
   pias2 = NULL,
   na.rm = FALSE,
   contrib = TRUE,
-  r = 1,
+  order = 1,
+  r = order,
   include_ea = TRUE,
   duplicate_contrib = c("sum", "make.unique"),
   impute_rules = NULL
 ) {
+  if ("r" %in% names(sys.call())) {
+    warning("`r` is deprecated and will be removed; use `order` instead")
+  }
   chkDots(...)
   aggregate_index(
     x,
     pias,
     pias2,
     na.rm = na.rm,
     contrib = contrib,
-    r = r,
+    order = r,
     include_ea = include_ea,
     chainable = TRUE,
     duplicate_contrib = match.arg(duplicate_contrib),
@@ -178,19 +182,23 @@ aggregate.direct_piar_index <- function(
   pias2 = NULL,
   na.rm = FALSE,
   contrib = TRUE,
-  r = 1,
+  order = 1,
+  r = order,
   include_ea = TRUE,
   duplicate_contrib = c("sum", "make.unique"),
   impute_rules = NULL
 ) {
+  if ("r" %in% names(sys.call())) {
+    warning("`r` is deprecated and will be removed; use `order` instead")
+  }
   chkDots(...)
   aggregate_index(
     x,
     pias,
     pias2,
     na.rm = na.rm,
     contrib = contrib,
-    r = r,
+    order = r,
     include_ea = include_ea,
     chainable = FALSE,
     duplicate_contrib = match.arg(duplicate_contrib),
@@ -206,21 +214,21 @@ aggregate_index <- function(
   pias2,
   na.rm,
   contrib,
-  r,
+  order,
   include_ea,
   chainable,
   duplicate_contrib,
   impute_rules
 ) {
   pias <- as_aggregation_structure(pias)
-  r <- as.numeric(r)
+  order <- as.numeric(order)
   has_contrib <- !is.null(x$contrib) && contrib
   res <- .aggregate(
     x,
     pias,
     na.rm,
     has_contrib,
-    r,
+    order,
     include_ea,
     chainable,
     duplicate_contrib,
@@ -246,7 +254,7 @@ aggregate_index <- function(
       pias2,
       na.rm,
       has_contrib,
-      -r,
+      -order,
       include_ea,
       chainable,
       duplicate_contrib,
@@ -259,7 +267,7 @@ aggregate_index <- function(
         res2$contrib,
         res$index,
         res2$index,
-        r = 0
+        order = 0
       )
     }
     res$index[] <- (res$index * res2$index)^0.5
@@ -279,7 +287,7 @@ aggregate_index <- function(
   pias,
   na.rm,
   has_contrib,
-  r,
+  order,
   include_ea,
   chainable,
   duplicate_contrib,
@@ -311,7 +319,7 @@ aggregate_index <- function(
       nodes <- unname(pias$child[[i - 1L]])
       rel[[i]] <- vapply(
         nodes,
-        \(z) gmean(rel[[i - 1L]][z], w[[i - 1L]][z], r, na.rm),
+        \(z) gmean(rel[[i - 1L]][z], w[[i - 1L]][z], order, na.rm),
         numeric(1L)
       )
       if (has_contrib) {
@@ -322,7 +330,7 @@ aggregate_index <- function(
               con[[i - 1L]][nodes[[j]]],
               rel[[i - 1L]][nodes[[j]]],
               w[[i - 1L]][nodes[[j]]],
-              r,
+              order,
               rel[[i]][j],
               duplicate_contrib
             )
@@ -343,7 +351,7 @@ aggregate_index <- function(
 
     # Price update weights for all periods after the first.
     if (chainable) {
-      pias$weights <- update_weights(rel[[1L]], w[[1L]], r)
+      pias$weights <- update_weights(rel[[1L]], w[[1L]], order)
     }
 
     if (!include_ea && length(rel) > 1L) {
@@ -359,8 +367,8 @@ aggregate_index <- function(
 
 #' Aggregate product contributions
 #' @noRd
-aggregate_contrib <- function(x, rel, w, r, index, duplicate_contrib) {
-  w <- transmute_weights(rel, w, r, to = 1, mean = index)
+aggregate_contrib <- function(x, rel, w, order, index, duplicate_contrib) {
+  w <- transmute_weights(rel, w, order, to = 1, mean = index)
   res <- Map(`*`, x, w)
   if (all(lengths(res) == 0L)) {
     return(numeric(0L))
@@ -385,7 +393,7 @@ aggregate_contrib <- function(x, rel, w, r, index, duplicate_contrib) {
 
 #' Aggregate product contributions for a superlative index
 #' @noRd
-super_aggregate_contrib <- function(x, y, rel1, rel2, r) {
-  w <- transmute_weights(c(rel1, rel2), order = r, to = 1)
+super_aggregate_contrib <- function(x, y, rel1, rel2, order) {
+  w <- transmute_weights(c(rel1, rel2), order = order, to = 1)
   w[1L] * x + w[2L] * y
 }

R/elementary_index.R

@@ -9,7 +9,8 @@
 #' (if `contrib = TRUE`) to `x` and `weights` grouped by `ea` and `period`. That
 #' is, for every combination of elementary aggregate and time period,
 #' `elementary_index()` calculates an index based on a generalized mean of
-#' order `r` and, optionally, percent-change contributions. Product names should
+#' order `order` and, optionally, percent-change contributions. Product names
+#' should
 #' 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
@@ -81,8 +82,8 @@
 #'   missing values
 #'   are not removed. Setting `na.rm = TRUE` is equivalent to overall mean
 #'   imputation.
-#' @param r `[numeric(1)]` Order of the generalized mean to aggregate price
-#'   relatives. 0 for a
+#' @param order,r `[numeric(1)]` Order of the generalized mean to aggregate
+#'   price relatives. 0 for a
 #'   geometric index (the default for making elementary indexes), 1 for an
 #'   arithmetic index (the default for aggregating elementary indexes and
 #'   averaging indexes over subperiods), or -1 for a harmonic index (usually for
@@ -163,6 +164,9 @@
 #'   r = 1
 #' )
 elementary_index <- function(x, ...) {
+  if ("r" %in% ...names()) {
+    warning("`r` is deprecated and will be removed; use `order` instead")
+  }
   UseMethod("elementary_index")
 }
 
@@ -184,7 +188,8 @@ elementary_index.numeric <- function(
   chainable = TRUE,
   na.rm = FALSE,
   contrib = FALSE,
-  r = 0
+  order = 0,
+  r = order
 ) {
   chkDots(...)
   if (!is.null(weights)) {

R/emean.R

@@ -2,6 +2,9 @@
 #'
 #' Calculate the component-wise extended mean.
 #'
+#' The extended mean is also called the difference mean, Stolarsky mean, or
+#' extended mean-value mean; see Bullen (2003, p. 393) for details.
+#'
 #' Both `x` and `y` should be strictly positive. This is not enforced, but the
 #' results may not make sense when the extended mean is not defined. The usual
 #' recycling rules apply when `x` and `y` are not the same length.
@@ -74,19 +77,20 @@ emean <- function(
   # Recycling x and y here avoids multiple warnings if one is not a multiple
   # length of the other.
   if (length(x) > length(y)) {
-    if (length(x) %% length(y) != 0) {
-      warning("length of `x` is not a multiple of length of `y")
-      y <- rep_len(length(x))
+    if (length(y) > 0 && length(x) %% length(y) != 0) {
+      warning("length of `y` is not a multiple of length of `x`")
+      y <- rep_len(y, length(x))
     }
   } else if (length(x) < length(y)) {
-    if (length(y) %% length(x) != 0) {
-      warning("length of `y` is not a multiple of length of `x")
-      x <- rep_len(length(y))
+    if (length(x) > 0 && length(y) %% length(x) != 0) {
+      warning("length of `x` is not a multiple of length of `y`")
+      x <- rep_len(x, length(y))
     }
   }
 
-  if (length(tol) > max(length(x), length(y))) {
-    stop("'tol' cannot be longer than 'x' or 'y'")
+  max_len <- max(length(x), length(y))
+  if (max_len > 0 && length(tol) > max_len) {
+    stop("`tol` cannot be longer than `x` or `y`")
   }
 
   if (r == 0 && s == 0) {

R/gmean.R

@@ -31,8 +31,8 @@
 #' @param x `[numeric > 0]` A strictly positive numeric vector.
 #' @param weights `[numeric >= 0]` A positive numeric vector of weights, the
 #'   same length as `x`. The default is to equally weight each element of `x`.
-#' @param order `[numeric(1)]` A finite number giving the order of the
-#'   generalized mean. The default calculates an arithmetic mean.
+#' @param order `[numeric(1)]` A finite number giving the order (or exponent) of
+#'   the generalized mean. The default calculates an arithmetic mean.
 #' @param na.rm `[logical(1)]` Should missing values be removed? By default,
 #'   missing values are not removed.
 #'

R/impute_prices.R

@@ -59,8 +59,8 @@
 #'   product weights), or something that can be coerced into one. The default is
 #'   to give each price equal weight. This is evaluated in `x` for the data
 #'   frame method.
-#' @param r `[numeric(2)]` A pair of numeric values. The first gives the order
-#'   of the generalized-mean price index used to calculate the
+#' @param order,r `[numeric(2)]` A pair of numeric values. The first gives the
+#'   order of the generalized-mean price index used to calculate the
 #'   elementary price indexes, defaulting to a geometric index. The second
 #'   gives the order of the generalized-mean price index used to aggregate the
 #'   elementary price indexes, defaulting to an arithmetic index. Other values
@@ -123,6 +123,9 @@
 #'   method = "overall-mean"
 #' )
 impute_prices <- function(x, ...) {
+  if ("r" %in% ...names()) {
+    warning("`r` is deprecated and will be removed; use `order` instead")
+  }
   UseMethod("impute_prices")
 }
 
@@ -142,7 +145,8 @@ impute_prices.matrix <- function(
   ea = NULL,
   weights = NULL,
   pias = NULL,
-  r = c(0, 1),
+  order = c(0, 1),
+  r = order,
   method = c("overall-mean", "carry-forward"),
   impute_rules = NULL
 ) {
@@ -192,18 +196,18 @@ impute_prices.matrix <- function(
         ea = ea[[t]],
         weights = weights[[t]],
         na.rm = TRUE,
-        r = r[1L]
+        order = r[1L]
       )
       time(index) <- names(res)[t]
       if (!is.null(pias)) {
         index <- aggregate(
           index,
           pias,
           na.rm = TRUE,
-          r = r[2L],
+          order = r[2L],
           impute_rules = impute_rules
         )
-        pias <- update(pias, index, r = r[2L])
+        pias <- update(pias, index, order = r[2L])
       }
       eas <- if (!is.null(ea)) {
         match(as.character(ea[[t]][impute]), index$levels)
@@ -240,7 +244,8 @@ impute_prices.numeric <- function(
   ea = NULL,
   weights = NULL,
   pias = NULL,
-  r = c(0, 1),
+  order = c(0, 1),
+  r = order,
   method = c("overall-mean", "carry-forward", "carry-backward"),
   impute_rules = NULL
 ) {
@@ -296,18 +301,18 @@ impute_prices.numeric <- function(
         ea = ea[[t]],
         weights = weights[[t]],
         na.rm = TRUE,
-        r = r[1L]
+        order = r[1L]
       )
       time(index) <- names(res)[t]
       if (!is.null(pias)) {
         index <- aggregate(
           index,
           pias,
           na.rm = TRUE,
-          r = r[2L],
+          order = r[2L],
           impute_rules = impute_rules
         )
-        pias <- update(pias, index, r = r[2L])
+        pias <- update(pias, index, order = r[2L])
       }
       eas <- if (!is.null(ea)) {
         match(as.character(ea[[t]][impute]), index$levels)