feat: balance_caveats provenance + once-per-session disclosure (#25)

This commit is contained in:
2026-08-03 10:48:11 -04:00
parent 6c5bdb3048
commit 82e4face4e
4 changed files with 167 additions and 0 deletions
+99
View File
@@ -0,0 +1,99 @@
# R/balance_caveats.R
#
# The four caveats from cog_pipeline/docs/data_dictionary.md § Cash and
# security holdings. Each one silently invalidates an obvious analysis, so
# they travel in provenance (machine-readable, for cog-api#26) rather than
# living only in prose.
#
# Two of the four are already carried by the code-driven series-break
# builders and are deliberately NOT duplicated here:
# * SB195/SB196 -- X40/X41 book -> market at FY2002 -- fire via
# series_break_refs on the recipe path, the only path that observes those
# codes.
# What remains is the GAAP distinction (a constant) and the coverage windows
# (measured, never hardcoded, so they stay correct as the corpus grows).
#' Per-subtype observed year extents, plus which requested families are
#' truncated relative to the requested span.
#' @noRd
.balance_caveats <- function(con, codes_observed, years) {
windows <- DBI::dbGetQuery(con,
"SELECT c.balance_subtype AS subtype,
MIN(l.year) AS year_min,
MAX(l.year) AS year_max
FROM balance_long l
JOIN summary_categories c USING (item_code)
WHERE c.balance_subtype IS NOT NULL
GROUP BY 1
ORDER BY 1"
)
observed_subtypes <- if (length(codes_observed) == 0L) {
character(0)
} else {
DBI::dbGetQuery(con, sprintf(
"SELECT DISTINCT balance_subtype FROM summary_categories
WHERE item_code IN (%s) AND balance_subtype IS NOT NULL",
.sql_lit_chr(codes_observed)
))$balance_subtype
}
cw <- stats::setNames(
lapply(seq_len(nrow(windows)),
function(i) as.integer(c(windows$year_min[i], windows$year_max[i]))),
windows$subtype
)
# A family is "truncated" when the caller asked for years outside the span
# that family actually covers -- the FY2016 employee-retirement termination
# and the FY2021 end of the W family are both this shape.
truncated <- character(0)
if (length(years) > 0L) {
for (s in observed_subtypes) {
w <- cw[[s]]
if (is.null(w)) next
if (max(years) > w[2] || min(years) < w[1]) truncated <- c(truncated, s)
}
}
list(
not_gaap = TRUE,
not_gaap_note = paste0(
"Census holdings are gross -- no liabilities are netted -- and are NOT ",
"GAAP fund balance. A reserve ratio built from them overstates what is ",
"actually available."
),
coverage_window = cw,
truncated = sort(unique(truncated))
)
}
#' TRUE the first time `key` is seen this session, FALSE thereafter.
#' Reset by cog_close().
#' @noRd
.balance_caveat_once <- function(key) {
seen <- .uscogdata_env$balance_caveats_shown
if (is.null(seen)) seen <- character(0)
if (key %in% seen) return(FALSE)
.uscogdata_env$balance_caveats_shown <- c(seen, key)
TRUE
}
#' Emit at most one message per caveat class per session.
#' @noRd
.emit_balance_caveats <- function(caveats) {
if (.balance_caveat_once("not_gaap")) {
cli::cli_inform(c(
"!" = "Census holdings are gross and are {.strong not} GAAP fund balance.",
"i" = "No liabilities are netted; a reserve ratio built from them overstates available funds."
))
}
if (length(caveats$truncated) > 0L &&
.balance_caveat_once("coverage_window")) {
cli::cli_inform(c(
"!" = "Requested years extend beyond what {.val {caveats$truncated}} actually covers.",
"i" = "See {.code provenance$balance_caveats$coverage_window}."
))
}
invisible(NULL)
}
+5
View File
@@ -109,6 +109,11 @@ cog_balances <- function(govid, years, category = NULL,
prov$scope$govids_found <- scope$found
prov$scope$govids_missing <- scope$missing
prov$balance_caveats <- .balance_caveats(
con, prov$codes_summed$observed, years
)
.emit_balance_caveats(prov$balance_caveats)
attr(result, "provenance") <- prov
result
}
+1
View File
@@ -95,4 +95,5 @@ cog_close <- function() {
}
.uscogdata_env$con <- NULL
.uscogdata_env$manifest <- NULL
.uscogdata_env$balance_caveats_shown <- NULL
}
+62
View File
@@ -298,3 +298,65 @@ test_that("an unknown recipe id is rejected", {
expect_error(cog_balances("550000227544", 2019, recipe = "no_such_recipe"))
})
})
# --- balance_caveats: GAAP disclosure + measured coverage windows ----------
test_that("balance_caveats is always present and flags the GAAP distinction", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_balances("550000227544", 2019)
cav <- attr(r, "provenance")$balance_caveats
expect_false(is.null(cav))
expect_true(cav$not_gaap)
})
})
test_that("coverage_window is computed from the corpus, not hardcoded", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_balances("550000227544", c(2011, 2012, 2019, 2020))
cav <- attr(r, "provenance")$balance_caveats
# Read the "general" family's true year extent independently, via a
# fresh DuckDB connection against the raw parquet files (never through
# balance_long/.balance_caveats() itself, and never via arrow -- this
# package reads parquet through DuckDB only, see CLAUDE.md). Replicates
# the same predicates 26-balance_long.sql applies (category_type =
# 'balance', NOT is_aggregate) so this is a faithful, independent
# measurement rather than a re-statement of the view under test.
con2 <- DBI::dbConnect(duckdb::duckdb())
on.exit(DBI::dbDisconnect(con2, shutdown = TRUE), add = TRUE)
long_glob <- file.path(fixture_corpus_path(), "data", "long", "**", "*.parquet")
cats_path <- file.path(fixture_corpus_path(), "data", "summary_categories.parquet")
obs <- DBI::dbGetQuery(con2, sprintf(
"SELECT MIN(l.year) AS y0, MAX(l.year) AS y1
FROM read_parquet(%s, hive_partitioning = true) l
JOIN read_parquet(%s) c USING (item_code)
WHERE c.balance_subtype = 'general' AND NOT l.is_aggregate",
uscogdata:::.sql_lit_chr(long_glob), uscogdata:::.sql_lit_chr(cats_path)
))
expect_identical(as.integer(cav$coverage_window$general),
c(as.integer(obs$y0), as.integer(obs$y1)))
})
})
test_that("a request past a family's coverage window is flagged", {
skip_if_no_corpus()
with_fixture_corpus({
# The employee_retirement family (X21/X30/X47/Z77/Z78) is corpus-wide
# truncated relative to 2019 in this fixture; 2012 observes it, 2019 does
# not, so the requested span extends past what it actually covers.
r <- cog_balances("550000227544", c(2012, 2019))
cav <- attr(r, "provenance")$balance_caveats
expect_true("employee_retirement" %in% cav$truncated)
})
})
test_that("the caveat message fires once per session", {
skip_if_no_corpus()
with_fixture_corpus({
expect_message(cog_balances("550000227544", 2019), "not.*GAAP")
expect_no_message(cog_balances("550000227544", 2020))
})
})