diff --git a/DESCRIPTION b/DESCRIPTION index 4a6ffc7..7773170 100644 --- a/DESCRIPTION +++ b/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 = "marberts@protonmail.com", diff --git a/R/contributions.R b/R/contributions.R index a4bcea1..96a53e0 100644 --- a/R/contributions.R +++ b/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 #' diff --git a/R/geks.R b/R/geks.R index 0fd0a3e..c54632b 100644 --- a/R/geks.R +++ b/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,7 +29,7 @@ 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)) @@ -37,7 +37,7 @@ geks_matrix <- function(index, p, q, product, n, nper, window, na.rm) { }) 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, diff --git a/R/means.R b/R/means.R index cb73daa..67ba3ed 100644 --- a/R/means.R +++ b/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 diff --git a/R/offset_prices.R b/R/offset_prices.R index f27195d..c471384 100644 --- a/R/offset_prices.R +++ b/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))) } diff --git a/R/outliers.R b/R/outliers.R index e79e164..1f08a09 100644 --- a/R/outliers.R +++ b/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) diff --git a/R/weights.R b/R/weights.R index 55402d1..b3043b9 100644 --- a/R/weights.R +++ b/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 } diff --git a/man/contributions.Rd b/man/contributions.Rd index a3996de..5ea6b2b 100644 --- a/man/contributions.Rd +++ b/man/contributions.Rd @@ -129,7 +129,7 @@ all.equal(geometric_mean(x) - 1, sum(geometric_contributions(x))) # 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 diff --git a/man/transmute_weights.Rd b/man/transmute_weights.Rd index 5a2fc56..5d274ee 100644 --- a/man/transmute_weights.Rd +++ b/man/transmute_weights.Rd @@ -84,18 +84,12 @@ harmonic_mean(x, transmute_weights(0, -1)(x)) # 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 @@ -129,18 +123,18 @@ all.equal( # 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 ---- diff --git a/tests/Examples/gpindex-Ex.Rout.save b/tests/Examples/gpindex-Ex.Rout.save index 6967754..70c64b7 100644 --- a/tests/Examples/gpindex-Ex.Rout.save +++ b/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,12 +1516,12 @@ 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 ---- @@ -1535,7 +1529,7 @@ t5 1.6720 1.0712 1.2477 0.9801 1.1850 1.2540 1.2678 0.9770 > # 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 diff --git a/tests/testthat/test-splice.R b/tests/testthat/test-splice.R index d5a551d..dc9af7b 100644 --- a/tests/testthat/test-splice.R +++ b/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)) +})