From 35911491ebdffe511a15488d54bcd8d8257a51b2 Mon Sep 17 00:00:00 2001
From: Steve Martin <stevemartin041@gmail.com>
Date: Wed, 9 Aug 2023 00:01:19 -0400
Subject: [PATCH] Fixed error with str.index

---
 R/as_index.R                            |  5 ++++-
 R/summary.index.R                       |  2 +-
 man/aggregation-structure-attributes.Rd |  2 +-
 man/mean.index.Rd                       |  2 +-
 tests/testthat/test-aggregate.R         | 30 +++++++++++++++++++++++++
 tests/testthat/test-extract-index.R     |  4 ++++
 6 files changed, 41 insertions(+), 4 deletions(-)

diff --git a/R/as_index.R b/R/as_index.R
index 6b2ab12..87897a1 100644
--- a/R/as_index.R
+++ b/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]
diff --git a/R/summary.index.R b/R/summary.index.R
index 50d2232..01cbdbd 100644
--- a/R/summary.index.R
+++ b/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, ...) {
diff --git a/man/aggregation-structure-attributes.Rd b/man/aggregation-structure-attributes.Rd
index c44fa60..4041821 100644
--- a/man/aggregation-structure-attributes.Rd
+++ b/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{
diff --git a/man/mean.index.Rd b/man/mean.index.Rd
index d0f852d..64e4ba4 100644
--- a/man/mean.index.Rd
+++ b/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.
 }
diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R
index 535085d..09bd364 100644
--- a/tests/testthat/test-aggregate.R
+++ b/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])
+  )
+})
diff --git a/tests/testthat/test-extract-index.R b/tests/testthat/test-extract-index.R
index d459f75..f2544c7 100644
--- a/tests/testthat/test-extract-index.R
+++ b/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))))
 })