feat: per_capita and adjust_to_year for cog_balances() (#25)

This commit is contained in:
2026-08-03 10:24:59 -04:00
parent de3a58d105
commit 769164c824
2 changed files with 68 additions and 0 deletions
+27
View File
@@ -49,6 +49,7 @@ cog_balances <- function(govid, years, category = NULL,
basis = c("harmonized", "raw"), recipe = NULL) { basis = c("harmonized", "raw"), recipe = NULL) {
call <- match.call() call <- match.call()
basis <- match.arg(basis, c("harmonized", "raw")) basis <- match.arg(basis, c("harmonized", "raw"))
.validate_balance_inputs(per_capita, adjust_to_year)
govid <- .coerce_govid_input(govid) govid <- .coerce_govid_input(govid)
years <- as.integer(years) years <- as.integer(years)
if (!is.null(adjust_to_year)) adjust_to_year <- as.integer(adjust_to_year) if (!is.null(adjust_to_year)) adjust_to_year <- as.integer(adjust_to_year)
@@ -67,6 +68,14 @@ cog_balances <- function(govid, years, category = NULL,
ig_view = NULL, subtype_scope = NULL) ig_view = NULL, subtype_scope = NULL)
result <- tibble::as_tibble(DBI::dbGetQuery(con, sql)) result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
# Order matters (matches .verb_spendrev()): per-capita first, so
# .attach_real_dollars() deflates the nominal per-capita column into
# amt_per_capita_real rather than needing amt_per_capita_nominal recomputed.
if (isTRUE(per_capita)) result <- .attach_per_capita(result, con, govid)
if (!is.null(adjust_to_year)) {
result <- .attach_real_dollars(result, adjust_to_year, per_capita)
}
prov <- .build_provenance( prov <- .build_provenance(
verb = "cog_balances", call = call, govid = govid, years = years, verb = "cog_balances", call = call, govid = govid, years = years,
category = category, per_capita = per_capita, category = category, per_capita = per_capita,
@@ -84,6 +93,24 @@ cog_balances <- function(govid, years, category = NULL,
result result
} }
#' Cheap type validation for the two arguments cog_balances() shares with the
#' money verbs. Mirrors the per_capita/adjust_to_year checks in
#' .validate_verb_inputs() (R/spending.R) -- category/recipe validation is
#' deliberately out of scope here (uscogdata#25 Task 3 review note).
#' @noRd
.validate_balance_inputs <- function(per_capita, adjust_to_year) {
if (!is.logical(per_capita) || length(per_capita) != 1L) {
cli::cli_abort("`per_capita` must be a length-1 logical.")
}
if (!is.null(adjust_to_year)) {
if (!(is.integer(adjust_to_year) || is.numeric(adjust_to_year)) ||
length(adjust_to_year) != 1L) {
cli::cli_abort("`adjust_to_year` must be NULL or a length-1 integer.")
}
}
invisible(TRUE)
}
#' Abort unless the mounted corpus classifies balance codes. #' Abort unless the mounted corpus classifies balance codes.
#' #'
#' `balance_subtype` arrived with cog_pipeline #76/#77 without a #' `balance_subtype` arrived with cog_pipeline #76/#77 without a
+41
View File
@@ -177,3 +177,44 @@ test_that("cog_balances records found + missing govids in provenance", {
expect_equal(sort(prov$scope$govids_missing), "XXXINVALID") expect_equal(sort(prov$scope$govids_missing), "XXXINVALID")
}) })
}) })
test_that("per_capita divides holdings by population", {
skip_if_no_corpus()
with_fixture_corpus({
plain <- cog_balances("550000227544", 2019, category = "Fund Balances")
pc <- cog_balances("550000227544", 2019, category = "Fund Balances",
per_capita = TRUE)
expect_true("amt_per_capita_nominal" %in% names(pc))
expect_true("pop_source" %in% names(pc))
expect_identical(pc$amt_nominal, plain$amt_nominal)
# Assert against the denominator read from the corpus, NOT against a
# quantity derived from amt_per_capita_nominal itself -- dividing the
# column back out would be tautological and would pass on any value.
pop <- DBI::dbGetQuery(cog_open(), sprintf(
"SELECT population FROM gov_population_yearly
WHERE canonical_govid = %s AND year = 2019",
uscogdata:::.sql_lit_chr("550000227544")
))$population
expect_length(pop, 1L)
expect_equal(pc$amt_per_capita_nominal, pc$amt_nominal / pop,
tolerance = 1e-8)
prov <- attr(pc, "provenance")
expect_true(prov$transformations$per_capita$applied)
})
})
test_that("adjust_to_year adds real dollars", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_balances("550000227544", 2012, category = "Fund Balances",
adjust_to_year = 2020)
expect_true("amt_real" %in% names(r))
# 2012 dollars inflated to 2020 must exceed nominal.
expect_true(all(r$amt_real > r$amt_nominal))
prov <- attr(r, "provenance")
expect_true(prov$transformations$inflation$applied)
expect_identical(prov$transformations$inflation$base_year, 2020L)
})
})