Removed unnecessary scale_weights()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gpindex
 Title: Generalized Price and Quantity Indexes
-Version: 0.6.0.9016
+Version: 0.6.0.9017
 Authors@R: c(
     person("Steve", "Martin", role = c("aut", "cre", "cph"),
     email = "[email protected]",

R/contributions.R

@@ -111,7 +111,7 @@
 #' # into weights for an arithmetic mean, then finding the contributions
 #' # to the percent change
 #'
-#' scale_weights(transmute_weights(0, 1)(x)) * (x - 1)
+#' transmute_weights(0, 1)(x) * (x - 1)
 #'
 #' # Not the only way to calculate contributions
 #'

R/geks.R

@@ -1,20 +1,20 @@
 #' Make the GEKS matrix
 #' @noRd
 geks_matrix <- function(index, p, q, product, n, nper, window, na.rm) {
-  # making base prices/quantities is the slowest part of the calculation;
+  # Making base prices/quantities is the slowest part of the calculation;
   # the algorithm calculates the lower-triangular part of the GEKS matrix
   # to avoid making relatives with different bases, then uses the
-  # time-reversal property of the 'index' function
+  # time-reversal property of the 'index' function.
   rows <- seq_len(nper)
   lt <- lapply(rows, function(i) {
     if (i < max(window - n, 2L)) {
-      # only the last n + 1 rows are needed for each window,
-      # so pad the top rows left of the diagonal with NA
+      # Only the last n + 1 rows are needed for each window,
+      # so pad the top rows left of the diagonal with NA.
       ans <- rep_len(NA_real_, i - 1L)
     } else {
-      # matching is only done for the lower-triangular part of the matrix
-      # match products for window - 1 periods left of the diagonal
-      # to minimize the number of back prices to find
+      # Matching is only done for the lower-triangular part of the matrix.
+      # Match products for window - 1 periods left of the diagonal
+      # to minimize the number of back prices to find.
       js <- seq.int(to = i - 1L, length.out = min(window, i) - 1L)
       m <- .mapply(
         match,
@@ -29,15 +29,15 @@ geks_matrix <- function(index, p, q, product, n, nper, window, na.rm) {
         list(na.rm = na.rm)
       )
     }
-    # add the diagonal at the end and pad with NAs
+    # Add the diagonal at the end and pad with NAs.
     ans <- c(unlist(ans, use.names = FALSE), 1)
     front_pad <- rep_len(NA_real_, max(i - window, 0L))
     back_pad <- rep_len(NA_real_, nper - length(ans) - length(front_pad))
     c(front_pad, ans, back_pad)
   })
   res <- do.call(rbind, lt)
   rownames(res) <- colnames(res) <- names(p) # time periods
-  # exploit time reversal
+  # Exploit time reversal.
   ut <- upper.tri(res)
   res[ut] <- 1 / t(res)[ut]
   res
@@ -198,10 +198,10 @@ geks <- function(f, r = 0) {
 
     mat <- geks_matrix(f, p, q, product, n, nper, window, na.rm)
     rows <- seq_len(window) - 1L
-    # only the last n + 1 indexes in each window need to be kept
+    # Only the last n + 1 indexes in each window need to be kept.
     cols <- seq.int(window - n, window) - 1L
     res <- vector("list", nper - window + 1L)
-    # move down the diagonal to make the geks index
+    # Move down the diagonal to make the geks index.
     for (i in seq_along(res)) {
       index <- apply(
         mat[rows + i, cols + i, drop = FALSE], 2L,

R/means.R

@@ -215,6 +215,7 @@ generalized_mean <- function(r) {
       if (r == 0) {
         exp(sum(log(x)) / length(x))
       } else if (r == 1) {
+        # The arithmetic case is important enough for the optimization.
         sum(x) / length(x)
       } else {
         (sum(x^r) / length(x))^(1 / r)
@@ -446,7 +447,7 @@ extended_mean <- function(r, s) {
     } else {
       res <- ((a^s - b^s) / (a^r - b^r) * r / s)^(1 / (s - r))
     }
-    # set output to a when a == b
+    # Set output to a when a == b.
     i <- which(abs(a - b) <= tol)
     res[i] <- a[(i - 1L) %% length(a) + 1L]
     res

R/offset_prices.R

@@ -11,7 +11,7 @@ offset_period <- function(f) {
     if (length(period) != length(product)) {
       stop("'period' and 'product' must be the same length")
     }
-    # factors with no levels throws an error below
+    # Factors with no levels throw an error below.
     if (nlevels(period) == 0L) {
       return(rep.int(NA_integer_, length(period)))
     }

R/outliers.R

@@ -97,7 +97,7 @@
 quartile_method <- function(x, cu = 2.5, cl = cu, a = 0, type = 7) {
   x <- as.numeric(x)
   cu <- as.numeric(cu)
-  # it's faster to not recycle cu, cl, or a when they're length 1
+  # It's faster to not recycle cu, cl, or a when they're length 1.
   if (length(cu) != 1L) cu <- rep_len(cu, length(x))
   cl <- as.numeric(cl)
   if (length(cl) != 1L) cl <- rep_len(cl, length(x))
@@ -185,7 +185,7 @@ tukey_algorithm <- function(x, cu = 2.5, cl = cu, type = 7) {
   if (length(ts) == 0L) {
     return(tail)
   }
-  # in some versions m is the median
+  # In some versions m is the median.
   m <- mean(ts, na.rm = TRUE)
   x <- x - m
   u <- cu * (mean(ts[ts >= m], na.rm = TRUE) - m)

R/weights.R

@@ -118,18 +118,12 @@ extended_mean_ <- function(r, s) {
 #' # Transmuting the weights for a harmonic mean into those
 #' # for an arithmetic mean is the same as using weights w / x
 #'
-#' all.equal(
-#'   scale_weights(transmute_weights(-1, 1)(x, w)),
-#'   scale_weights(w / x)
-#' )
+#' all.equal(transmute_weights(-1, 1)(x, w), scale_weights(w / x))
 #' 
 #' # Transmuting the weights for an arithmetic mean into those
 #' # for a harmonic mean is the same as using weights w * x
 #'
-#' all.equal(
-#'   scale_weights(transmute_weights(1, -1)(x, w)),
-#'   scale_weights(w * x)
-#' )
+#' all.equal(transmute_weights(1, -1)(x, w), scale_weights(w * x))
 #'
 #' # Works for nested means, too
 #'
@@ -163,18 +157,18 @@ extended_mean_ <- function(r, s) {
 #' # Transmuted weights increase when x is small and decrease
 #' # when x is large if r < s
 #' 
-#' scale_weights(transmute_weights(0, 1)(x, w)) > scale_weights(w)
+#' transmute_weights(0, 1)(x, w) > scale_weights(w)
 #' 
 #' # The opposite happens when r > s
 #' 
-#' scale_weights(transmute_weights(1, 0)(x, w)) > scale_weights(w)
+#' transmute_weights(1, 0)(x, w) > scale_weights(w)
 #'
 #' #---- Percent-change contributions ----
 #'
 #' # Transmuted weights can be used to calculate percent-change
 #' # contributions for, e.g., a geometric price index
 #'
-#' scale_weights(transmute_weights(0, 1)(x)) * (x - 1)
+#' transmute_weights(0, 1)(x) * (x - 1)
 #' geometric_contributions(x) # the more convenient way
 #'
 #' #---- Basket representation of a price index ----
@@ -248,7 +242,7 @@ nested_transmute <- function(r1, r2, s, t = c(1, 1)) {
     } else {
       v1 <- r_weights1(x, w1)
       v2 <- r_weights2(x, w2)
-      # the calculation is wrong if NAs in w1 or w2 propagate
+      # The calculation is wrong if NAs in w1 or w2 propagate.
       if (anyNA(w1)) {
         v1[is.na(v1) & !is.na(v2)] <- 0
       }
@@ -292,7 +286,7 @@ nested_transmute2 <- function(r1, r2, s, t = c(1, 1)) {
     } else {
       u1 <- s_weights1(x, w1)
       u2 <- s_weights2(x, w2)
-      # the calculation is wrong if NAs in w1 or w2 propagate
+      # The calculation is wrong if NAs in w1 or w2 propagate.
       if (anyNA(w1)) {
         u1[is.na(u1) & !is.na(u2)] <- 0
       }

tests/Examples/gpindex-Ex.Rout.save

@@ -142,7 +142,7 @@ Warning in back_period(period) :
 > # into weights for an arithmetic mean, then finding the contributions
 > # to the percent change
 > 
-> scale_weights(transmute_weights(0, 1)(x)) * (x - 1)
+> transmute_weights(0, 1)(x) * (x - 1)
 [1] 0.5505103 0.8989795
 > 
 > # Not the only way to calculate contributions
@@ -1470,19 +1470,13 @@ t5   1.6720 1.0712    1.2477             0.9801 1.1850  1.2540  1.2678 0.9770
 > # Transmuting the weights for a harmonic mean into those
 > # for an arithmetic mean is the same as using weights w / x
 > 
-> all.equal(
-+   scale_weights(transmute_weights(-1, 1)(x, w)),
-+   scale_weights(w / x)
-+ )
+> all.equal(transmute_weights(-1, 1)(x, w), scale_weights(w / x))
 [1] TRUE
 > 
 > # Transmuting the weights for an arithmetic mean into those
 > # for a harmonic mean is the same as using weights w * x
 > 
-> all.equal(
-+   scale_weights(transmute_weights(1, -1)(x, w)),
-+   scale_weights(w * x)
-+ )
+> all.equal(transmute_weights(1, -1)(x, w), scale_weights(w * x))
 [1] TRUE
 > 
 > # Works for nested means, too
@@ -1522,20 +1516,20 @@ t5   1.6720 1.0712    1.2477             0.9801 1.1850  1.2540  1.2678 0.9770
 > # Transmuted weights increase when x is small and decrease
 > # when x is large if r < s
 > 
-> scale_weights(transmute_weights(0, 1)(x, w)) > scale_weights(w)
+> transmute_weights(0, 1)(x, w) > scale_weights(w)
 [1]  TRUE FALSE FALSE
 > 
 > # The opposite happens when r > s
 > 
-> scale_weights(transmute_weights(1, 0)(x, w)) > scale_weights(w)
+> transmute_weights(1, 0)(x, w) > scale_weights(w)
 [1] FALSE  TRUE  TRUE
 > 
 > #---- Percent-change contributions ----
 > 
 > # Transmuted weights can be used to calculate percent-change
 > # contributions for, e.g., a geometric price index
 > 
-> scale_weights(transmute_weights(0, 1)(x)) * (x - 1)
+> transmute_weights(0, 1)(x) * (x - 1)
 [1] 0.0000000 0.3122793 0.5048413
 > geometric_contributions(x) # the more convenient way
 [1] 0.0000000 0.3122793 0.5048413
@@ -1561,7 +1555,7 @@ t5   1.6720 1.0712    1.2477             0.9801 1.1850  1.2540  1.2678 0.9770
 > cleanEx()
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  0.105 0.012 0.117 0 0 
+Time elapsed:  0.106 0.012 0.117 0 0 
 > grDevices::dev.off()
 null device 
           1 

tests/testthat/test-splice.R

@@ -90,3 +90,10 @@ test_that("errors work", {
   expect_error(splice_index(list(1:3, 1:2)))
   expect_error(splice_index(list(1:3, 1:3), initial = 1:2))
 })
+
+test_that("splicing is the same as chaining", {
+  x <- as.list(1:5)
+  expect_equal(splice_index(x), cumprod(1:5))
+  expect_equal(splice_index(x, initial = 1:3), cumprod(c(1:3, 1:5)))
+  expect_equal(splice_index(x, published = TRUE), cumprod(1:5))
+})