Fixed error with str.index

R/as_index.R

@@ -15,7 +15,10 @@ as_index.matrix <- function(x, chainable = TRUE, ...) {
   periods <- as.character(
     if (is.null(colnames(x))) seq_len(ncol(x)) else colnames(x)
   )
-
+  if (any(x <= 0, na.rm = TRUE)) {
+    warning("some elements of 'x' are less than or equal to 0")
+  }
+
   index <- index_skeleton(levels, periods)
   for (t in seq_along(periods)) {
     index[[t]][] <- x[, t]

R/summary.index.R

@@ -19,7 +19,7 @@ print.index_summary <- function(x, ...) {
 }
 
 str.index <- function(object, ...) {
-  str(as.list(object), ...)
+  str(unclass(object), ...)
 }
 
 print.index <- function(x, ...) {

man/aggregation-structure-attributes.Rd

@@ -5,7 +5,7 @@
 \alias{levels.aggregation_structure}
 
 \title{
-Methods to get the weights and levels for a price index aggregation structure.
+Methods to get the weights and levels for a price index aggregation structure
 }
 
 \description{

man/mean.index.Rd

@@ -26,7 +26,7 @@ Aggregate an index over subperiods by taking the (usually arithmetic) mean of in
 }
 
 \details{
-The \code{mean()} method constructs a set of windows of length \code{window}, starting in the first period of the index, and takes the mean of each index value in these windows for each level of the index. The last window is discarded if it is incomplete, so that index values are always averaged over \code{window} periods. The names for the first time period in each window form the new names for the aggregated time periods. Note that percent-change contributions are discarded when aggregating over subperiods. 
+The \code{mean()} method constructs a set of non-overlapping windows of length \code{window}, starting in the first period of the index, and takes the mean of each index value in these windows for each level of the index. The last window is discarded if it is incomplete, so that index values are always averaged over \code{window} periods. The names for the first time period in each window form the new names for the aggregated time periods. Note that percent-change contributions are discarded when aggregating over subperiods. 
 
 An optional vector of weights can be specified when aggregating index values over subperiods, which is often useful when aggregating a Paasche index; see section 4.3 of Balk (2008) for details.
 }

tests/testthat/test-aggregate.R

@@ -258,3 +258,33 @@ test_that("corner cases work", {
   expect_equal(as.matrix(aggregate(as_index(1:5), 6)),
                matrix(NA_real_, dimnames = list(6, 1)))
 })
+
+test_that("partial contributions are correct", {
+  prices <- data.frame(
+    rel = 1:8,
+    period = rep(1:2, each = 4),
+    ea = rep(letters[1:2], 4)
+  )
+
+  epr <- with(prices, elemental_index(rel, period, ea, contrib = TRUE))
+
+  epr <- merge(epr, matrix(9:10, 1, dimnames = list("c", 1:2)))
+
+  pias <- aggregation_structure(
+    list(c("top", "top", "top"), c("a", "b", "c")), 1:3
+  )
+
+  index <- aggregate(epr, pias)
+  expect_equal(
+    sum(contrib(index[, 1])),
+    sum(gpindex::arithmetic_contributions(as.numeric(index[letters[1:3], 1]),
+                                          weights(pias, ea_only = TRUE))[1:2])
+  )
+
+  pias2 <- update(pias, index[, 1])
+  expect_equal(
+    sum(contrib(index[, 2])),
+    sum(gpindex::arithmetic_contributions(as.numeric(index[letters[1:3], 2]),
+                                          weights(pias2, ea_only = TRUE))[1:2])
+  )
+})

tests/testthat/test-extract-index.R

@@ -74,4 +74,8 @@ test_that("replacement methods work", {
     contrib(epr),
     matrix(0, 0, 2, dimnames = list(NULL, 1:2))
   )
+
+  # recycling should still happen
+  epr[1, c(1, 2, 1)] <- 1:3
+  expect_equal(epr[1, ], as_index(matrix(3:2, 1, dimnames = list("11", 1:2))))
 })