Version 0.6.0

.Rbuildignore

@@ -8,3 +8,5 @@
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^inst/logo\.R$
+^man/figures$

.gitignore

@@ -4,3 +4,4 @@
 *.Rproj
 inst/doc
 docs
+pkgdown

DESCRIPTION

@@ -16,7 +16,7 @@ Description: Tools to build and work with bilateral generalized-mean
     Balk (2008, ISBN:978-1-107-40496-0),
     von der Lippe (2001, ISBN:3-8246-0638-0), and the
     CPI manual (2020, ISBN:978-1-51354-298-0).
-Depends: R (>= 3.5)
+Depends: R (>= 4.0)
 Imports: stats
 Suggests: 
     knitr,

NEWS.md

@@ -1,5 +1,7 @@
 ## Version 0.6.0
 
+- Bumped minimum version of R to at least 4.0.
+
 - The use of `...` in `grouped()` and `balanced()` is deprecated, and will be
 removed in a future version. The same behavior can be had by using an
 anonymous function.

R/outliers.R

@@ -36,12 +36,13 @@
 #'
 #' @param x A strictly positive numeric vector of price relatives. These can be
 #' made with, e.g., [back_period()].
-#' @param cu,cl A numeric vector giving the upper and lower cutoffs for each
-#' element of `x`. The usual recycling rules apply.
-#' @param a A numeric vector between 0 and 1 giving the scale factor for the
-#' median to establish the minimum dispersion between quartiles for each
-#' element of `x`. The default does not set a minimum dispersion. The
-#' usual recycling rules apply.
+#' @param cu,cl A numeric vector, or something that can be coerced into one,
+#' giving the upper and lower cutoffs for each element of `x`. Recycled to the
+#' same length as `x`.
+#' @param a A numeric vector, or something that can be coerced into one,
+#' between 0 and 1 giving the scale factor for the median to establish the
+#' minimum dispersion between quartiles for each element of `x`. The default
+#' does not set a minimum dispersion. Recycled to the same length as `x`.
 #' @param type See [quantile()].
 #'
 #' @returns
@@ -90,7 +91,13 @@
 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
+  if (length(cu) != 1L) cu <- rep_len(cu, length(x))
   cl <- as.numeric(cl)
+  if (length(cl) != 1L) cl <- rep_len(cl, length(x))
+  a <- as.numeric(a)
+  if (length(a) != 1L) a <- rep_len(a, length(x))
+
   q <- stats::quantile(
     x, c(0.25, 0.5, 0.75),
     names = FALSE, na.rm = TRUE, type = type
@@ -107,7 +114,12 @@ quartile_method <- function(x, cu = 2.5, cl = cu, a = 0, type = 7) {
 resistant_fences <- function(x, cu = 2.5, cl = cu, a = 0, type = 7) {
   x <- as.numeric(x)
   cu <- as.numeric(cu)
+  if (length(cu) != 1L) cu <- rep_len(cu, length(x))
   cl <- as.numeric(cl)
+  if (length(cl) != 1L) cl <- rep_len(cl, length(x))
+  a <- as.numeric(a)
+  if (length(a) != 1L) a <- rep_len(a, length(x))
+
   q <- stats::quantile(
     x, c(0.25, 0.5, 0.75),
     names = FALSE, na.rm = TRUE, type = type
@@ -124,7 +136,10 @@ resistant_fences <- function(x, cu = 2.5, cl = cu, a = 0, type = 7) {
 robust_z <- function(x, cu = 2.5, cl = cu) {
   x <- as.numeric(x)
   cu <- as.numeric(cu)
+  if (length(cu) != 1L) cu <- rep_len(cu, length(x))
   cl <- as.numeric(cl)
+  if (length(cl) != 1L) cl <- rep_len(cl, length(x))
+
   med <- stats::median(x, na.rm = TRUE)
   s <- stats::mad(x, na.rm = TRUE)
   x <- x - med
@@ -139,7 +154,9 @@ robust_z <- function(x, cu = 2.5, cl = cu) {
 fixed_cutoff <- function(x, cu = 2.5, cl = 1 / cu) {
   x <- as.numeric(x)
   cu <- as.numeric(cu)
+  if (length(cu) != 1L) cu <- rep_len(cu, length(x))
   cl <- as.numeric(cl)
+  if (length(cl) != 1L) cl <- rep_len(cl, length(x))
   x > cu | x < cl
 }
 
@@ -149,7 +166,10 @@ fixed_cutoff <- function(x, cu = 2.5, cl = 1 / cu) {
 tukey_algorithm <- function(x, cu = 2.5, cl = cu, type = 7) {
   x <- as.numeric(x)
   cu <- as.numeric(cu)
+  if (length(cu) != 1L) cu <- rep_len(cu, length(x))
   cl <- as.numeric(cl)
+  if (length(cl) != 1L) cl <- rep_len(cl, length(x))
+
   q <- stats::quantile(
     x, c(0.05, 0.95),
     names = FALSE, na.rm = TRUE, type = type

README.Rmd

@@ -12,6 +12,8 @@ knitr::opts_chunk$set(
 )
 ```
 
+<a href="https://marberts.github.io/gpindex/"><img src="man/figures/logo.png" align="right" height="139" alt="gpindex website" /></a>
+
 # Generalized Price and Quantity Indexes
 
 <!-- Badges -->

README.md

@@ -1,6 +1,8 @@
 
 <!-- README.md is generated from README.Rmd. Please edit that file. -->
 
+<a href="https://marberts.github.io/gpindex/"><img src="man/figures/logo.png" align="right" height="139" alt="gpindex website" /></a>
+
 # Generalized Price and Quantity Indexes
 
 <!-- Badges -->

inst/logo.R

@@ -0,0 +1,12 @@
+library(ggplot2)
+library(hexSticker)
+
+sticker(ggplot() + theme_void(),
+        package = "gpindex",
+        filename = "man/figures/logo.png",
+        p_y = 1.2,
+        p_size = 18,
+        p_family = "mono",
+        p_color = "#97b3b3",
+        h_fill = "#f0f99f",
+        h_color = "#97b3b3")

tests/testthat/test-outliers.R

@@ -34,3 +34,25 @@ test_that("hb transform works", {
   expect_equal(hb_transform(x),
                ifelse(x < median(x), 1 - median(x) / x, x / median(x) - 1))
 })
+
+test_that("recycling works", {
+  expect_identical(fixed_cutoff(x, cl = rep(1 / 2.5, 11)), fixed_cutoff(x))
+  expect_identical(fixed_cutoff(x, cu = rep(2.5, 11)), fixed_cutoff(x))
+  expect_identical(fixed_cutoff(x, numeric(0)), rep(NA, 10))
+
+  expect_identical(robust_z(x, cl = rep(2.5, 11)), robust_z(x))
+  expect_identical(robust_z(x, cu = rep(2.5, 11)), robust_z(x))
+
+  expect_identical(quartile_method(x, cl = rep(2.5, 11)), quartile_method(x))
+  expect_identical(quartile_method(x, cu = rep(2.5, 11)), quartile_method(x))
+  expect_identical(quartile_method(x, a = rep(0, 11)), quartile_method(x))
+
+  expect_identical(resistant_fences(x, cl = rep(2.5, 11)), resistant_fences(x))
+  expect_identical(resistant_fences(x, cu = rep(2.5, 11)), resistant_fences(x))
+  expect_identical(resistant_fences(x, a = rep(0, 11)), resistant_fences(x))
+
+  expect_identical(tukey_algorithm(x, cl = rep(2.5, 11)), tukey_algorithm(x))
+  expect_identical(tukey_algorithm(x, cu = rep(2.5, 11)), tukey_algorithm(x))
+  expect_identical(tukey_algorithm(x, integer(0)),
+                   replace(rep(NA, 10), c(6, 10), TRUE))
+})