diff --git a/.Rbuildignore b/.Rbuildignore index 46c7c80..76855d9 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,4 @@ +^data-raw$ ^.*\.Rproj$ ^\.Rproj\.user$ ^_pkgdown\.yml$ diff --git a/R/adjust.R b/R/adjust.R new file mode 100644 index 0000000..b5f0853 --- /dev/null +++ b/R/adjust.R @@ -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 +} diff --git a/R/sysdata.rda b/R/sysdata.rda new file mode 100644 index 0000000..8865593 Binary files /dev/null and b/R/sysdata.rda differ diff --git a/data-raw/cpi_annual.R b/data-raw/cpi_annual.R new file mode 100644 index 0000000..a4aa912 --- /dev/null +++ b/data-raw/cpi_annual.R @@ -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) diff --git a/tests/testthat/test-adjust.R b/tests/testthat/test-adjust.R new file mode 100644 index 0000000..b10e3e6 --- /dev/null +++ b/tests/testthat/test-adjust.R @@ -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)]))) +})