Version 0.7.0

.Rbuildignore

@@ -11,4 +11,5 @@
 ^\.lintr$
 ^inst/benchmark\.R$
 ^inst/logo\.R$
-^tests/testthat/setup\.R$
+^tests/testthat/setup\.R$
+^CRAN-SUBMISSION$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: piar
 Title: Price Index Aggregation
-Version: 0.6.0.9021
+Version: 0.7.0
 Authors@R: c(
     person("Steve", "Martin", role = c("aut", "cre", "cph"),
            email = "[email protected]",

R/aggregation_structure-class.R

@@ -80,7 +80,7 @@ str.piar_aggregation_structure <- function(object, ...) {
   str(unclass(object), ...)
 }
 
-#' Test if an object is a price index aggregation structure
+#' Test if an object is an aggregation structure
 #'
 #' Test if an object is a price index aggregation structure.
 #'

R/aggregation_structure.R

@@ -12,8 +12,8 @@
 #' `NA`s, and there should be no duplicates across different levels of
 #' `x`.
 #' @param weights A numeric vector of aggregation weights for the elemental
-#' aggregates (i.e., the last vector in `x`). The default is to give each
-#' elemental aggregate the same weight.
+#' aggregates (i.e., the last vector in `x`), or something that can be coerced
+#' into one. The default is to give each elemental aggregate the same weight.
 #'
 #' @returns
 #' A price index aggregation structure of class `piar_aggregation_structure`.
@@ -97,8 +97,11 @@ aggregation_structure <- function(x, weights = NULL) {
 
   if (is.null(weights)) {
     weights <- rep.int(1, length(ea))
-  } else if (any(weights <= 0, na.rm = TRUE)) {
-    warning("some elements of 'w' are less than or equal to 0")
+  } else {
+    weights <- as.numeric(weights)
+    if (any(weights <= 0, na.rm = TRUE)) {
+      warning("some elements of 'w' are less than or equal to 0")
+    }
   }
 
   # basic argument checking to make sure inputs can make an

R/as_aggregation_structure.R

@@ -87,8 +87,11 @@ as_aggregation_structure.aggregate_piar_index <- function(x,
                                                           weights = NULL, ...) {
   if (is.null(weights)) {
     weights <- rep.int(1, length(x$pias$levels[[length(x$pias$levels)]]))
-  } else if (any(weights <= 0, na.rm = TRUE)) {
-    warning("some elements of 'w' are less than or equal to 0")
+  } else {
+    weights <- as.numeric(weights)
+    if (any(weights <= 0, na.rm = TRUE)) {
+      warning("some elements of 'w' are less than or equal to 0")
+    }
   }
   piar_aggregation_structure(
     x$pias$child, x$pias$parent, x$pias$levels, weights

R/coerce-aggregation_structure.R

@@ -1,4 +1,4 @@
-#' Coerce a price index aggregation structure into a tabular form
+#' Coerce an aggregation structure into a tabular form
 #'
 #' Coerce a price index aggregation structure into an aggregation matrix, or a
 #' data frame.

R/elemental_index.R

@@ -93,8 +93,8 @@ different_length <- function(...) {
 #' @param ea A factor, or something that can be coerced into one, giving the
 #' elemental aggregate associated with each price relative in `x`. The
 #' default assumes that all price relatives belong to one elemental aggregate.
-#' @param weights A numeric vector of weights for the price relatives in `x`.
-#' The default is equal weights.
+#' @param weights A numeric vector of weights for the price relatives in `x`,
+#' or something that can be coerced into one. The default is equal weights.
 #' @param contrib Should percent-change contributions be calculated? The
 #' default does not calculate contributions.
 #' @param chainable Are the price relatives in `x` period-over-period
@@ -204,18 +204,22 @@ elemental_index.numeric <- function(x,
                                     na.rm = FALSE,
                                     contrib = FALSE,
                                     r = 0) {
+  if (!is.null(weights)) {
+    weights <- as.numeric(weights)
+  }
+  period <- as.factor(period)
+  ea <- as.factor(ea) # ensures elemental aggregates are balanced
+
+  time <- levels(period)
+  levels <- levels(ea)
+
   if (different_length(x, period, ea, weights)) {
     stop("input vectors must be the same length")
   }
   if (any(x <= 0, na.rm = TRUE) || any(weights <= 0, na.rm = TRUE)) {
     warning("some elements of 'x or 'weights' are less than or equal to 0")
   }
 
-  period <- as.factor(period)
-  ea <- as.factor(ea) # ensures elemental aggregates are balanced
-  time <- levels(period)
-  levels <- levels(ea)
-
   if (contrib) {
     if (is.null(names(x))) {
       names(x) <- paste(ea, sequential_names(period, ea), sep = ".")
@@ -231,7 +235,7 @@ elemental_index.numeric <- function(x,
   if (is.null(weights)) {
     weights <- list(list(NULL))
   } else {
-    weights <- Map(split, split(as.numeric(weights), period), ea)
+    weights <- Map(split, split(weights, period), ea)
   }
 
   index_fun <- Vectorize(gpindex::generalized_mean(r), USE.NAMES = FALSE)

R/impute_prices.R

@@ -27,7 +27,8 @@
 #'
 #' @name impute_prices
 #' @aliases impute_prices
-#' @param x A numeric vector of prices.
+#' @param x A numeric vector of prices, or something that can be coerced
+#' into one.
 #' @param period A factor, or something that can be coerced into one, giving
 #' the time period associated with each price in `x`. The ordering of time
 #' periods follows of the levels of `period`, to agree with
@@ -40,7 +41,8 @@
 #' coerced into one, as made with [aggregation_structure()]. The default
 #' imputes from elemental indexes only (i.e., not recursively).
 #' @param weights A numeric vector of weights for the prices in `x` (i.e.,
-#' product weights). The default is to give each price equal weight.
+#' product weights), or something that can be coerced into one. The default is
+#' to give each price equal weight.
 #' @param r1 Order of the generalized-mean price index used to calculate the
 #' elemental price indexes: 0 for a geometric index (the default), 1 for an
 #' arithmetic index, or -1 for a harmonic index. Other values are possible; see
@@ -77,28 +79,34 @@
 #' @export
 shadow_price <- function(x, period, product, ea,
                          pias = NULL, weights = NULL, r1 = 0, r2 = 1) {
-  if (different_length(x, period, product, ea, weights)) {
-    stop("input vectors must be the same length")
-  }
   # this is mostly a combination of gpindex::back_period() and aggregate()
   # it just does it period-by-period and keeps track of prices to impute
+  x <- as.numeric(x)
   period <- as.factor(period)
+  product <- as.factor(product)
+  attributes(product) <- NULL
+  ea <- as.factor(ea)
+  if (!is.null(weights)) {
+    weights <- as.numeric(weights)
+  }
+
+  if (different_length(x, period, product, ea, weights)) {
+    stop("input vectors must be the same length")
+  }
   if (nlevels(period) == 0L) {
     return(rep.int(NA_integer_, length(period)))
   }
 
   res <- split(x, period)
-  product <- as.factor(product)
-  attributes(product) <- NULL
   product <- split(product, period)
   if (duplicate_products(product)) {
     warning("there are duplicated period-product pairs")
   }
-  ea <- split(as.factor(ea), period)
+  ea <- split(ea, period)
   if (is.null(weights)) {
     w <- rep.int(list(NULL), nlevels(period))
   } else {
-    w <- split(as.numeric(weights), period)
+    w <- split(weights, period)
   }
   if (!is.null(pias)) {
     pias <- as_aggregation_structure(pias)
@@ -129,17 +137,19 @@ shadow_price <- function(x, period, product, ea,
 #' @rdname impute_prices
 #' @export
 carry_forward <- function(x, period, product) {
+  x <- as.numeric(x)
+  period <- as.factor(period)
+  product <- as.factor(product)
+  attributes(product) <- NULL
+
   if (different_length(x, period, product)) {
     stop("input vectors must be the same length")
   }
-  period <- as.factor(period)
   if (nlevels(period) == 0L) {
     return(rep.int(NA_integer_, length(period)))
   }
 
   res <- split(x, period)
-  product <- as.factor(product)
-  attributes(product) <- NULL
   product <- split(product, period)
   if (duplicate_products(product)) {
     warning("there are duplicated period-product pairs")

R/levels.piar_aggregation_structure.R

@@ -1,3 +1,16 @@
+#' Get the levels for an aggregation structure
+#' 
+#' Get the hierarchical list of levels for an aggregation structure. It is
+#' an error to try and replace these values.
+#' 
+#' @param x A price index aggregation structure, as made by
+#' [aggregation_structure()].
+#' 
+#' @returns
+#' A list of character vectors giving the levels for each position in the
+#' aggregation structure.
+#' 
+#' @family aggregation structure methods
 #' @export
 levels.piar_aggregation_structure <- function(x) {
   x$levels

R/mean.piar_index.R

@@ -21,7 +21,8 @@
 #' section 4.3 of Balk (2008) for details.
 #'
 #' @param x A price index, as made by, e.g., [elemental_index()].
-#' @param weights A numeric vector of weights for the index values in `x`. The
+#' @param weights A numeric vector of weights for the index values in `x`, or
+#' something that can be coerced into one. The
 #' default is equal weights. It is usually easiest to specify these weights as
 #' a matrix with a row for each index value in `x` and a column for each
 #' time period.
@@ -61,10 +62,11 @@ mean.piar_index <- function(x, weights = NULL, ...,
                             contrib = TRUE,
                             r = 1) {
   if (!is.null(weights)) {
+    weights <- as.numeric(weights)
     if (length(weights) != length(x$time) * length(x$levels)) {
       stop("'weights' must have a value for each index value in 'x'")
     }
-    w <- split(as.numeric(weights), gl(length(x$time), length(x$levels)))
+    w <- split(weights, gl(length(x$time), length(x$levels)))
   }
 
   window <- as.integer(window)

R/price_relative.R

@@ -28,11 +28,15 @@
 #'
 #' @export
 price_relative <- function(x, period, product) {
+  x <- as.numeric(x)
+  period <- as.factor(period)
+  product <- as.factor(product)
+
   if (different_length(x, period, product)) {
     stop("'x', 'period', and 'product' must be the same length")
   }
-  x <- as.numeric(x)
+
   res <- x / x[gpindex::back_period(period, product)]
-  names(res) <- product
+  names(res) <- as.character(product)
   res
 }

R/update.aggregation_structure.R

@@ -1,4 +1,4 @@
-#' Update a price index aggregation structure
+#' Update an aggregation structure
 #'
 #' Price update the weights in a price index aggregation structure.
 #'

R/weights.piar_aggregation_structure.R

@@ -1,4 +1,4 @@
-#' Get the weights for a price index aggregation structure
+#' Get the weights for an aggregation structure
 #'
 #' Get and set the weights for a price index aggregation structure.
 #'

_pkgdown.yml

@@ -43,6 +43,7 @@ reference:
   - as_aggregation_structure
   - as.matrix.piar_aggregation_structure
   - weights.piar_aggregation_structure
+  - levels.piar_aggregation_structure
   - update.piar_aggregation_structure
   - is_aggregation_structure
 

cran-comments.md

@@ -1,13 +1,15 @@
 ## Test environments
 
-- local Ubuntu 20.04 installation, R 4.3.1
+- local Ubuntu 20.04 installation, R 4.3.2
 - win-builder (devel, release, oldrelease)
 - mac-builder (release)
 - R-hub (fedora-clang devel)
 
 ## R CMD check results
 
-There were no ERRORs or WARNINGS or NOTES.
+There were no ERRORs or WARNINGs.
+
+NOTE about invalid URL in README.md is incorrect; URL is valid.
 
 ## Downstream dependencies