feat: bundle CPIAUCSL + .inflate() helper
Adds R/sysdata.rda with the annual-average CPIAUCSL index (1947-2026, 80 years, sourced from FRED) and an internal .inflate() helper that converts nominal amounts between two years via the ratio of CPI values. Bundling CPI in the package (rather than publishing a cpi_annual.parquet in the corpus) matches the reader-specification intent: real-dollar conversion is a verb-level option, not a corpus-level artifact, so the target_year stays flexible at query time. data-raw/cpi_annual.R carries the one-shot FRED refresh used to build sysdata.rda. Re-run when the CPI series needs to roll forward. Verified: CPI(2000)/CPI(2021) ≈ 0.635, matching the ~0.63 sanity anchor in cog_explorer's existing inflation logic. Tests: tests/testthat/test-adjust.R covers the known 2000→2021 ≈ 1.574x anchor, vectorized from_year, error cases for out-of-range years, and NA-amount preservation. 14 pass / 0 fail.
This commit is contained in:
@@ -1,3 +1,4 @@
|
|||||||
|
^data-raw$
|
||||||
^.*\.Rproj$
|
^.*\.Rproj$
|
||||||
^\.Rproj\.user$
|
^\.Rproj\.user$
|
||||||
^_pkgdown\.yml$
|
^_pkgdown\.yml$
|
||||||
|
|||||||
+45
@@ -0,0 +1,45 @@
|
|||||||
|
# R/adjust.R
|
||||||
|
# Inflation adjustment helpers using bundled CPIAUCSL annual averages.
|
||||||
|
# The `cpi_annual` tibble (year, cpi) is stored as internal data in
|
||||||
|
# R/sysdata.rda and built via data-raw/ on package update.
|
||||||
|
|
||||||
|
#' Return the bundled annual CPI table.
|
||||||
|
#'
|
||||||
|
#' @return Tibble with columns `year` (integer) and `cpi` (numeric, CPIAUCSL
|
||||||
|
#' annual average, 1982-84 = 100).
|
||||||
|
#' @noRd
|
||||||
|
.cpi_table <- function() {
|
||||||
|
cpi_annual
|
||||||
|
}
|
||||||
|
|
||||||
|
#' Inflate (or deflate) an amount vector between two years.
|
||||||
|
#'
|
||||||
|
#' Converts nominal amounts in `from_year` dollars to real amounts in
|
||||||
|
#' `to_year` dollars using the bundled CPIAUCSL annual average index.
|
||||||
|
#' Multiplies by `cpi[to_year] / cpi[from_year]`.
|
||||||
|
#'
|
||||||
|
#' @param amt Numeric vector of nominal amounts.
|
||||||
|
#' @param from_year Integer or integer-like vector of source years (one per
|
||||||
|
#' element of `amt`, or length 1).
|
||||||
|
#' @param to_year Integer target year (scalar).
|
||||||
|
#' @return Numeric vector of real amounts, same length as `amt`.
|
||||||
|
#' @noRd
|
||||||
|
.inflate <- function(amt, from_year, to_year) {
|
||||||
|
cpi <- .cpi_table()
|
||||||
|
from_year <- as.integer(from_year)
|
||||||
|
to_year <- as.integer(to_year)
|
||||||
|
if (length(to_year) != 1L) {
|
||||||
|
cli::cli_abort("`to_year` must be a scalar.")
|
||||||
|
}
|
||||||
|
if (!(to_year %in% cpi$year)) {
|
||||||
|
cli::cli_abort("CPI unavailable for to_year = {to_year}. Supported: {min(cpi$year)}-{max(cpi$year)}.")
|
||||||
|
}
|
||||||
|
missing_years <- setdiff(from_year[!is.na(from_year)], cpi$year)
|
||||||
|
if (length(missing_years) > 0) {
|
||||||
|
cli::cli_abort("CPI unavailable for from_year value(s): {missing_years}.")
|
||||||
|
}
|
||||||
|
lookup <- stats::setNames(cpi$cpi, as.character(cpi$year))
|
||||||
|
cpi_from <- unname(lookup[as.character(from_year)])
|
||||||
|
cpi_to <- unname(lookup[as.character(to_year)])
|
||||||
|
amt * cpi_to / cpi_from
|
||||||
|
}
|
||||||
Binary file not shown.
@@ -0,0 +1,34 @@
|
|||||||
|
# data-raw/cpi_annual.R
|
||||||
|
#
|
||||||
|
# Refresh the bundled CPIAUCSL annual-average table from FRED.
|
||||||
|
# Run interactively when the CPI series needs to be extended forward:
|
||||||
|
# Rscript data-raw/cpi_annual.R
|
||||||
|
#
|
||||||
|
# Source: FRED series CPIAUCSL (Consumer Price Index for All Urban Consumers,
|
||||||
|
# All Items, 1982-84 = 100), monthly. Annual mean computed here. The bundled
|
||||||
|
# artifact is R/sysdata.rda (loaded automatically by the package).
|
||||||
|
|
||||||
|
stopifnot(requireNamespace("utils", quietly = TRUE),
|
||||||
|
requireNamespace("tibble", quietly = TRUE),
|
||||||
|
requireNamespace("usethis", quietly = TRUE))
|
||||||
|
|
||||||
|
fred_url <- "https://fred.stlouisfed.org/graph/fredgraph.csv?id=CPIAUCSL"
|
||||||
|
raw <- utils::read.csv(url(fred_url), stringsAsFactors = FALSE)
|
||||||
|
date_col <- intersect(c("observation_date", "DATE", "date"), names(raw))[1]
|
||||||
|
stopifnot(length(date_col) == 1L, !is.na(date_col))
|
||||||
|
raw$year <- as.integer(format(as.Date(raw[[date_col]]), "%Y"))
|
||||||
|
raw$CPIAUCSL <- suppressWarnings(as.numeric(raw$CPIAUCSL))
|
||||||
|
raw <- raw[!is.na(raw$CPIAUCSL), ]
|
||||||
|
|
||||||
|
annual <- stats::aggregate(
|
||||||
|
raw$CPIAUCSL, by = list(year = raw$year), FUN = mean, na.rm = TRUE
|
||||||
|
)
|
||||||
|
names(annual)[2] <- "cpi"
|
||||||
|
|
||||||
|
cpi_annual <- tibble::as_tibble(annual)
|
||||||
|
cpi_annual$cpi <- round(cpi_annual$cpi, 4)
|
||||||
|
|
||||||
|
message(sprintf("CPI range: %d-%d (%d years)",
|
||||||
|
min(cpi_annual$year), max(cpi_annual$year), nrow(cpi_annual)))
|
||||||
|
|
||||||
|
usethis::use_data(cpi_annual, internal = TRUE, overwrite = TRUE)
|
||||||
@@ -0,0 +1,43 @@
|
|||||||
|
test_that("cpi_annual internal data is available with expected shape", {
|
||||||
|
cpi <- uscogdata:::.cpi_table()
|
||||||
|
expect_true(is.data.frame(cpi))
|
||||||
|
expect_named(cpi, c("year", "cpi"))
|
||||||
|
expect_true(nrow(cpi) > 70L)
|
||||||
|
expect_true(all(c(2000L, 2010L, 2021L) %in% cpi$year))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that(".inflate matches a known anchor: 2000 in 2021$ ≈ 1.57x nominal", {
|
||||||
|
# FRED CPIAUCSL annual: 2000=172.19, 2021=270.97 → ratio ≈ 1.574
|
||||||
|
result <- uscogdata:::.inflate(100, from_year = 2000, to_year = 2021)
|
||||||
|
expect_equal(result, 157.4, tolerance = 0.5)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that(".inflate is vectorized over from_year", {
|
||||||
|
result <- uscogdata:::.inflate(
|
||||||
|
amt = c(100, 100, 100),
|
||||||
|
from_year = c(2000, 2010, 2021),
|
||||||
|
to_year = 2021
|
||||||
|
)
|
||||||
|
expect_length(result, 3L)
|
||||||
|
expect_equal(result[3], 100, tolerance = 1e-6) # same year → identity
|
||||||
|
expect_gt(result[1], 150) # 2000 inflated to 2021 ≈ 157
|
||||||
|
expect_lt(result[2], 130) # 2010 inflated to 2021 ≈ 124
|
||||||
|
expect_gt(result[2], 115)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that(".inflate errors on unknown from_year or to_year", {
|
||||||
|
expect_error(
|
||||||
|
uscogdata:::.inflate(100, from_year = 1900, to_year = 2021),
|
||||||
|
"CPI unavailable for from_year"
|
||||||
|
)
|
||||||
|
expect_error(
|
||||||
|
uscogdata:::.inflate(100, from_year = 2000, to_year = 2200),
|
||||||
|
"CPI unavailable for to_year"
|
||||||
|
)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that(".inflate preserves NA amounts", {
|
||||||
|
result <- uscogdata:::.inflate(c(100, NA, 200), from_year = 2000, to_year = 2021)
|
||||||
|
expect_true(is.na(result[2]))
|
||||||
|
expect_false(any(is.na(result[c(1, 3)])))
|
||||||
|
})
|
||||||
Reference in New Issue
Block a user