From 769164c824cdb2a879dd303ddbcbaa76b416797e Mon Sep 17 00:00:00 2001 From: Jared Knowles Date: Mon, 3 Aug 2026 10:24:59 -0400 Subject: [PATCH] feat: per_capita and adjust_to_year for cog_balances() (#25) --- R/balances.R | 27 ++++++++++++++++++++++ tests/testthat/test-balances.R | 41 ++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+) diff --git a/R/balances.R b/R/balances.R index bfd6e77..e80f376 100644 --- a/R/balances.R +++ b/R/balances.R @@ -49,6 +49,7 @@ cog_balances <- function(govid, years, category = NULL, basis = c("harmonized", "raw"), recipe = NULL) { call <- match.call() basis <- match.arg(basis, c("harmonized", "raw")) + .validate_balance_inputs(per_capita, adjust_to_year) govid <- .coerce_govid_input(govid) years <- as.integer(years) 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) 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( verb = "cog_balances", call = call, govid = govid, years = years, category = category, per_capita = per_capita, @@ -84,6 +93,24 @@ cog_balances <- function(govid, years, category = NULL, 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. #' #' `balance_subtype` arrived with cog_pipeline #76/#77 without a diff --git a/tests/testthat/test-balances.R b/tests/testthat/test-balances.R index 2313194..d0e64ac 100644 --- a/tests/testthat/test-balances.R +++ b/tests/testthat/test-balances.R @@ -177,3 +177,44 @@ test_that("cog_balances records found + missing govids in provenance", { 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) + }) +})