Compare commits
7
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
515ab3b019
|
||
|
|
d238bc0a22
|
||
|
|
e53aeb9643
|
||
|
|
9244e08085
|
||
|
|
1b2294e3a0
|
||
|
|
91b64b9b8b
|
||
|
|
267bc24fee
|
@@ -16,4 +16,3 @@
|
||||
^Meta$
|
||||
^\.gitea$
|
||||
^CLAUDE\.md$
|
||||
^\.superpowers$
|
||||
|
||||
@@ -9,6 +9,3 @@ docs/
|
||||
/Meta/
|
||||
.DS_Store
|
||||
/.quarto/
|
||||
|
||||
# SDD working artifacts (ledger, briefs, review packages) — plans/ stays tracked
|
||||
.superpowers/sdd/
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
+1
-24
@@ -21,30 +21,7 @@
|
||||
.uscogdata_defaults[[key]]
|
||||
}
|
||||
|
||||
#' Resolve the corpus URL, guaranteeing the trailing slash the package assumes.
|
||||
#'
|
||||
#' Every consumer builds locations by CONCATENATION -- `paste0(url,
|
||||
#' "manifest.json")` in manifest.R, `paste0(url, e$path)` in mirror.R, and the
|
||||
#' parquet glob in views.R -- and mirror.R:104 documents the invariant outright
|
||||
#' ('url ends in "/"'). Nothing enforced it, so a URL entered without the slash
|
||||
#' failed silently and misleadingly:
|
||||
#'
|
||||
#' HTTPS -> ".../downloadmanifest.json"; the host answers with an HTML 404
|
||||
#' page, which lands in the JSON parser as the lexical error
|
||||
#' reported in issue #3 -- pointing the user at "login page / wrong
|
||||
#' share" when the real cause was one missing character.
|
||||
#' local -> ".../corpusdata/long/**/*.parquet" and a DuckDB "No files found".
|
||||
#'
|
||||
#' Normalizing here fixes every consumer at once, rather than each call site
|
||||
#' re-deriving the same invariant. An empty setting is passed through
|
||||
#' untouched so manifest.R's "not configured" guard still fires instead of the
|
||||
#' value degrading into a bare "/" filesystem root.
|
||||
#' @noRd
|
||||
.resolve_url <- function() {
|
||||
url <- .cfg("url")
|
||||
if (is.null(url) || !nzchar(url) || grepl("/$", url)) return(url)
|
||||
paste0(url, "/")
|
||||
}
|
||||
.resolve_url <- function() .cfg("url")
|
||||
|
||||
.resolve_cache_dir <- function() {
|
||||
v <- .cfg("cache_dir")
|
||||
|
||||
-15
@@ -60,21 +60,6 @@ cog_explain <- function(result, format = c("print", "list")) {
|
||||
cli::cli_text("Basis: {prov$basis}{note}")
|
||||
}
|
||||
|
||||
if (!is.null(prov$expenditure_concept)) {
|
||||
concept_note <- if (!is.null(prov$expenditure_concept_note) &&
|
||||
!is.na(prov$expenditure_concept_note)) {
|
||||
sprintf(" (%s)", prov$expenditure_concept_note)
|
||||
} else {
|
||||
""
|
||||
}
|
||||
cli::cli_text("Concept: {prov$expenditure_concept}{concept_note}")
|
||||
if (isTRUE(prov$expenditure_concept_direct_suppressed)) {
|
||||
cli::cli_alert_warning(
|
||||
"Direct leg unavailable for at least one requested (year, category) -- affected rows report intergovernmental dollars alone, not Direct + IG. See each row's notes."
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
cli::cli_h2("Codes observed")
|
||||
codes <- prov$codes_summed$observed
|
||||
if (length(codes) == 0L) {
|
||||
|
||||
@@ -143,10 +143,6 @@ cog_find_peers <- function(target_govid,
|
||||
#' @param per_capita Default `TRUE` — peer compare usually normalizes by
|
||||
#' population.
|
||||
#' @param adjust_to_year Integer base year for CPI-U conversion or `NULL`.
|
||||
#' @param expenditure_concept `"direct"` (default) or `"total"`. Currently only
|
||||
#' `"direct"` is accepted; the `"total"` option exists in [cog_spending()] for
|
||||
#' single-government queries but cannot be used here because combining Total
|
||||
#' across peer sets counts intergovernmental transfers twice.
|
||||
#' @return Tibble matching [cog_spending()]'s columns, plus a `role`
|
||||
#' column taking values `"target"`, `"peer"`, `"summary_p25"`,
|
||||
#' `"summary_p50"`, or `"summary_p75"`, `target_rank` (target's rank
|
||||
@@ -157,13 +153,8 @@ cog_find_peers <- function(target_govid,
|
||||
#' `cohort_year`, and `cohort_govids`.
|
||||
#' @export
|
||||
cog_peer_compare <- function(target_govid, peers, category, years,
|
||||
per_capita = TRUE, adjust_to_year = NULL,
|
||||
expenditure_concept = c("direct", "total")) {
|
||||
per_capita = TRUE, adjust_to_year = NULL) {
|
||||
call <- match.call()
|
||||
expenditure_concept <- match.arg(expenditure_concept)
|
||||
if (identical(expenditure_concept, "total")) {
|
||||
.abort_concept_not_aggregatable("cog_peer_compare")
|
||||
}
|
||||
if (!is.character(target_govid) || length(target_govid) != 1L) {
|
||||
cli::cli_abort("`target_govid` must be a length-1 character string.")
|
||||
}
|
||||
|
||||
@@ -6,9 +6,6 @@
|
||||
per_capita, adjust_to_year, result, sql,
|
||||
subtype_col, basis = NA_character_,
|
||||
basis_note = NA_character_,
|
||||
expenditure_concept = "direct",
|
||||
expenditure_concept_note = NA_character_,
|
||||
expenditure_concept_direct_suppressed = FALSE,
|
||||
harmonization = NULL, recipe = NULL,
|
||||
suggestions = list()) {
|
||||
manifest <- .uscogdata_env$manifest
|
||||
@@ -54,9 +51,6 @@
|
||||
category = category,
|
||||
basis = basis,
|
||||
basis_note = basis_note,
|
||||
expenditure_concept = expenditure_concept,
|
||||
expenditure_concept_note = expenditure_concept_note,
|
||||
expenditure_concept_direct_suppressed = isTRUE(expenditure_concept_direct_suppressed),
|
||||
harmonization = harmonization %||% list(
|
||||
applied = FALSE, na_rows_excluded = 0L, na_amount_excluded = 0,
|
||||
note = NA_character_
|
||||
|
||||
+1
-12
@@ -25,12 +25,6 @@
|
||||
#' population from `gov_population_yearly`. Govs with missing population
|
||||
#' are excluded from the result.
|
||||
#' @param adjust_to_year Integer base year for CPI-U conversion, or `NULL`.
|
||||
#' @param expenditure_concept `"direct"` (default) or `"total"`. Currently only
|
||||
#' `"direct"` is accepted; the `"total"` option exists in [cog_spending()] for
|
||||
#' single-government queries but cannot be used here because combining Total
|
||||
#' across multiple layers of government double-counts intergovernmental
|
||||
#' transfers (a state's payment to a school district is the same dollar the
|
||||
#' district reports as its own Direct spending).
|
||||
#' @return Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
||||
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
||||
#' `amt_per_capita_nominal` / `amt_per_capita_real`, optional `pop_source`,
|
||||
@@ -39,13 +33,8 @@
|
||||
#' and `rollup$included_govids` / `rollup$excluded_govids`.
|
||||
#' @export
|
||||
cog_geographic_rollup <- function(govids, category, years,
|
||||
per_capita = FALSE, adjust_to_year = NULL,
|
||||
expenditure_concept = c("direct", "total")) {
|
||||
per_capita = FALSE, adjust_to_year = NULL) {
|
||||
call <- match.call()
|
||||
expenditure_concept <- match.arg(expenditure_concept)
|
||||
if (identical(expenditure_concept, "total")) {
|
||||
.abort_concept_not_aggregatable("cog_geographic_rollup")
|
||||
}
|
||||
.validate_rollup_layers(govids)
|
||||
|
||||
govids <- lapply(govids, .coerce_govid_input, arg = "govids[[layer]]")
|
||||
|
||||
+13
-346
@@ -42,34 +42,6 @@
|
||||
#' `basis = "recipe"` with an inert `harmonization` block (`applied =
|
||||
#' FALSE`, pointing at the `recipe` block instead) rather than a
|
||||
#' possibly-misleading `"harmonized"`/`"raw"` value.
|
||||
#' @param expenditure_concept `"direct"` (default) returns only the
|
||||
#' government's own direct spending (item codes `E`/`F`/`G`), unchanged
|
||||
#' from prior releases. `"total"` additionally UNIONs in the
|
||||
#' intergovernmental leg -- payments to local governments (`M` codes) and
|
||||
#' to the state government (`L` codes, excluding the `L--` family-total
|
||||
#' rollup) -- so results gain rows with `spend_subtype ==
|
||||
#' "intergovernmental"`. Requires the active corpus's `summary_categories`
|
||||
#' to carry M/L rows (added by cog_pipeline PR #59); aborts with class
|
||||
#' `uscogdata_ig_categories_unsupported` on an older corpus rather than
|
||||
#' silently under-reporting. Mutually exclusive with `recipe` (a recipe
|
||||
#' already defines its own component codes). **Do not sum `"total"`
|
||||
#' results across levels of government** (e.g. state + county + city):
|
||||
#' a state's `M12` payment to a school district is the same dollar the
|
||||
#' district reports as its own direct `E12`, so summing both double-counts
|
||||
#' it. This matters in particular with [cog_geographic_rollup()], which
|
||||
#' sums across exactly that kind of multi-layer government set.
|
||||
#'
|
||||
#' In the legacy wide era (<= FY2011), some functions are published ONLY
|
||||
#' as an aggregate-flagged family total (e.g. Corrections' `E04`/`E05`
|
||||
#' split), which the Direct leg excludes by construction but the IG leg
|
||||
#' deliberately keeps (see `inst/sql/24-ig_long.sql`). For a `"total"`
|
||||
#' query, any (year, category) where this leaves intergovernmental rows
|
||||
#' with NO Direct counterpart is flagged: the affected rows' `notes`
|
||||
#' name the harmonization recipe that recovers the missing Direct
|
||||
#' component (when one exists), and
|
||||
#' `provenance$expenditure_concept_direct_suppressed` is `TRUE` -- the
|
||||
#' figure in those rows is the intergovernmental leg alone, not Direct +
|
||||
#' IG.
|
||||
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
||||
#' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
||||
@@ -78,13 +50,12 @@
|
||||
#' @export
|
||||
cog_spending <- function(govid, years, category = NULL,
|
||||
per_capita = FALSE, adjust_to_year = NULL,
|
||||
basis = c("harmonized", "raw"), recipe = NULL,
|
||||
expenditure_concept = c("direct", "total")) {
|
||||
basis = c("harmonized", "raw"), recipe = NULL) {
|
||||
.verb_spendrev(
|
||||
verb = "cog_spending",
|
||||
view_base = "spending_annotated",
|
||||
subtype_col = "spend_subtype",
|
||||
flow_prefixes = c("E", "F", "G"),
|
||||
flow_prefixes = c("E", "F", "G", "K"),
|
||||
call = match.call(),
|
||||
govid = govid,
|
||||
years = years,
|
||||
@@ -92,79 +63,22 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
per_capita = per_capita,
|
||||
adjust_to_year = adjust_to_year,
|
||||
basis = basis,
|
||||
recipe = recipe,
|
||||
expenditure_concept = expenditure_concept
|
||||
recipe = recipe
|
||||
)
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
.abort_concept_not_aggregatable <- function(verb) {
|
||||
cli::cli_abort(c(
|
||||
"{.code expenditure_concept = \"total\"} cannot be used in {.fn {verb}}.",
|
||||
"*" = "Use {.code expenditure_concept = \"direct\"} (the default) for any \\
|
||||
comparison or sum that spans more than one government.",
|
||||
"i" = "Why: Census \"Total\" is a government's own Direct spending PLUS the \\
|
||||
money it hands to other governments. The receiving government reports \\
|
||||
that same dollar again as its own Direct when it actually spends it, \\
|
||||
so combining Total across governments double-counts intergovernmental \\
|
||||
transfers.",
|
||||
"i" = "For one government's own Total, use \\
|
||||
{.code cog_spending(expenditure_concept = \"total\")}."
|
||||
), class = "uscogdata_concept_not_aggregatable")
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
.verb_spendrev <- function(verb, view_base, subtype_col, flow_prefixes, call,
|
||||
govid, years, category,
|
||||
per_capita, adjust_to_year,
|
||||
basis = c("harmonized", "raw"), recipe = NULL,
|
||||
expenditure_concept = c("direct", "total")) {
|
||||
basis = c("harmonized", "raw"), recipe = NULL) {
|
||||
basis_explicit <- length(basis) == 1L
|
||||
basis <- match.arg(basis, c("harmonized", "raw"))
|
||||
# match.arg() itself throws a base `simpleError`, not an rlang-classed
|
||||
# condition; wrap it so an invalid expenditure_concept aborts consistently
|
||||
# with the rest of this package's validation (cli::cli_abort -> rlang_error).
|
||||
expenditure_concept <- tryCatch(
|
||||
match.arg(expenditure_concept, c("direct", "total")),
|
||||
error = function(e) {
|
||||
cli::cli_abort(
|
||||
"`expenditure_concept` must be one of {.val direct} or {.val total}.",
|
||||
class = "uscogdata_invalid_expenditure_concept",
|
||||
parent = e
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
govid <- .coerce_govid_input(govid, arg = "govid")
|
||||
.validate_verb_inputs(govid, years, category, per_capita, adjust_to_year,
|
||||
recipe)
|
||||
|
||||
if (!is.null(recipe) && identical(expenditure_concept, "total")) {
|
||||
cli::cli_abort(c(
|
||||
"`recipe` and `expenditure_concept = \"total\"` are mutually exclusive.",
|
||||
i = "A recipe defines its own component codes; pass one or the other.",
|
||||
i = "For a recipe's intergovernmental counterpart, use the matching IG recipe (e.g. `corrections_ig_local_combined`)."
|
||||
), class = "uscogdata_recipe_concept_conflict")
|
||||
}
|
||||
|
||||
# .verb_spendrev() is shared with cog_revenue(), which never exposes
|
||||
# expenditure_concept and always resolves it to "direct" -- so nothing on
|
||||
# the public API can reach this today. But it's a cheap guard against a
|
||||
# future call (direct or via a modified cog_revenue()) that would UNION
|
||||
# the IG leg's expenditure M/L rows into a revenue result, which has no
|
||||
# matching IG view and no sensible meaning.
|
||||
if (identical(expenditure_concept, "total") &&
|
||||
!identical(view_base, "spending_annotated")) {
|
||||
cli::cli_abort(
|
||||
paste0(
|
||||
"`expenditure_concept = \"total\"` is only supported for spending ",
|
||||
"(view_base = \"spending_annotated\"); got view_base = ",
|
||||
"{.val {view_base}}."
|
||||
),
|
||||
class = "uscogdata_expenditure_concept_unsupported"
|
||||
)
|
||||
}
|
||||
|
||||
years <- as.integer(years)
|
||||
if (!is.null(adjust_to_year)) adjust_to_year <- as.integer(adjust_to_year)
|
||||
|
||||
@@ -191,13 +105,7 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
category_for_prov <- recipe_label
|
||||
} else {
|
||||
view <- .select_view(view_base, resolved$basis)
|
||||
ig_view <- if (identical(expenditure_concept, "total")) {
|
||||
.require_ig_categories(con)
|
||||
.select_ig_view(resolved$basis)
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
sql <- .build_verb_sql(view, subtype_col, govid, years, category, ig_view)
|
||||
sql <- .build_verb_sql(view, subtype_col, govid, years, category)
|
||||
result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
||||
}
|
||||
|
||||
@@ -206,6 +114,8 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
result <- .attach_real_dollars(result, adjust_to_year, per_capita)
|
||||
}
|
||||
|
||||
result$notes <- .notes_column(result)
|
||||
|
||||
# A recipe result doesn't go through spending_annotated(_harmonized) /
|
||||
# revenue_annotated(_harmonized) at all -- .run_recipe()'s generic join
|
||||
# reads `long` directly -- so `basis` and the `harmonization` exclusion
|
||||
@@ -231,64 +141,7 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
harmonization <- .build_harmonization_block(
|
||||
con, govid, years, resolved, flow_prefixes
|
||||
)
|
||||
# C1(a): gap detection must run against the Direct leg alone. `result`
|
||||
# can also carry UNION'd intergovernmental rows (expenditure_concept =
|
||||
# "total"), and the wide era (<= FY2011) routinely has legacy IG dollars
|
||||
# surviving (ig_long deliberately keeps aggregate rows) for a
|
||||
# (year, category) whose legacy Direct dollars were suppressed (spending_
|
||||
# long/spending_long_harmonized both filter NOT is_aggregate). Passing
|
||||
# the UNION'd result here would let a surviving IG row count as coverage
|
||||
# and silently cancel the recipe-hint suggestion that should fire.
|
||||
direct_leg_result <- if (identical(expenditure_concept, "total")) {
|
||||
result[!(result[[subtype_col]] %in% "intergovernmental"), , drop = FALSE]
|
||||
} else {
|
||||
result
|
||||
}
|
||||
suggestions <- .build_suggestions(con, govid, years, category,
|
||||
direct_leg_result,
|
||||
resolved$basis, flow_prefixes)
|
||||
}
|
||||
|
||||
# C1(b): when expenditure_concept = "total", flag any row where the IG
|
||||
# leg has dollars but the Direct leg has none for that same (year,
|
||||
# canonical_govid, category) AND a harmonization recipe actually recovers
|
||||
# the missing Direct dollars for that exact triple -- see
|
||||
# .detect_direct_suppressed() for why bare Direct-row absence alone is NOT
|
||||
# sufficient (the dominant real cause is a government that simply has no
|
||||
# direct spending in that category, which is correct, ordinary data). When
|
||||
# a covering recipe is found, both the row-level notes and the provenance
|
||||
# say so rather than pass silently as a plausible Total.
|
||||
direct_suppressed_info <- if (identical(expenditure_concept, "total")) {
|
||||
.detect_direct_suppressed(con, result, subtype_col)
|
||||
} else {
|
||||
list(flag = rep(FALSE, nrow(result)), notes = rep(NA_character_, nrow(result)))
|
||||
}
|
||||
direct_suppressed <- direct_suppressed_info$flag
|
||||
direct_suppressed_flag <- isTRUE(any(direct_suppressed))
|
||||
|
||||
result$notes <- .notes_column(result, direct_suppressed_info$notes)
|
||||
|
||||
# Determine expenditure_concept_note: only non-empty for "total", explains
|
||||
# how the IG leg was assembled from legacy-era aggregates. When the Direct
|
||||
# leg is suppressed for at least one requested (year, category), append an
|
||||
# explicit warning rather than let the base note's "Total = Direct + IG"
|
||||
# framing stand unqualified for rows where that arithmetic didn't happen.
|
||||
expenditure_concept_note_for_prov <- if (identical(expenditure_concept, "total")) {
|
||||
base_note <- "Total = Direct + intergovernmental (M to local govts + L to state govts). Legacy-era IG is assembled from aggregate-flagged rows, which are year-disjoint from their modern leaf components; the L-- family total is excluded."
|
||||
if (direct_suppressed_flag) {
|
||||
paste0(
|
||||
base_note,
|
||||
" NOTE: for at least one requested (year, category) the Direct leg ",
|
||||
"has NO rows in this corpus (a legacy aggregate-only family) -- the ",
|
||||
"affected result rows report the intergovernmental leg alone, not ",
|
||||
"Direct + IG. See `expenditure_concept_direct_suppressed` and each ",
|
||||
"affected row's `notes`."
|
||||
)
|
||||
} else {
|
||||
base_note
|
||||
}
|
||||
} else {
|
||||
NA_character_
|
||||
suggestions <- .build_suggestions(con, govid, years, category, resolved$basis)
|
||||
}
|
||||
|
||||
prov <- .build_provenance(
|
||||
@@ -304,9 +157,6 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
subtype_col = subtype_col,
|
||||
basis = basis_for_prov,
|
||||
basis_note = basis_note_for_prov,
|
||||
expenditure_concept = expenditure_concept,
|
||||
expenditure_concept_note = expenditure_concept_note_for_prov,
|
||||
expenditure_concept_direct_suppressed = direct_suppressed_flag,
|
||||
harmonization = harmonization,
|
||||
recipe = recipe_block,
|
||||
suggestions = suggestions
|
||||
@@ -361,43 +211,6 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
if (identical(basis, "harmonized")) paste0(view_base, "_harmonized") else view_base
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
.select_ig_view <- function(basis) {
|
||||
if (identical(basis, "harmonized")) "ig_annotated_harmonized" else "ig_annotated"
|
||||
}
|
||||
|
||||
#' Abort unless the active corpus's `summary_categories` actually carries
|
||||
#' intergovernmental (M/L) rows.
|
||||
#'
|
||||
#' The 66 M/L category rows arrived via cog_pipeline PR #59 with NO
|
||||
#' `schema_version` bump (`DESCRIPTION` still declares `MinCorpusSchema: 4`),
|
||||
#' so `schema_version` alone cannot gate `expenditure_concept = "total"` --
|
||||
#' a pre-#59 corpus can validly report schema_version 4, 5, or 6 and still
|
||||
#' have zero M/L rows in `summary_categories`. Against such a corpus,
|
||||
#' `ig_annotated`'s LEFT JOIN to `summary_categories` silently produces NA
|
||||
#' `category`/`spend_subtype` for every IG row: with a `category` filter
|
||||
#' this returns 0 rows (reads as "no intergovernmental spending" rather than
|
||||
#' "can't tell"), and with `category = NULL` every IG dollar collapses into
|
||||
#' one NA-subtype group that is invisible to the `spend_subtype ==
|
||||
#' "intergovernmental"` filter this package's own tests, roxygen, and
|
||||
#' vignette all rely on. Checking the data directly (rather than
|
||||
#' schema_version) is the only reliable gate.
|
||||
#' @noRd
|
||||
.require_ig_categories <- function(con, what = "expenditure_concept = \"total\"") {
|
||||
n <- DBI::dbGetQuery(con,
|
||||
"SELECT COUNT(*) AS n FROM summary_categories WHERE LEFT(item_code, 1) IN ('M', 'L')"
|
||||
)$n
|
||||
if (identical(as.integer(n), 0L)) {
|
||||
cli::cli_abort(c(
|
||||
sprintf("%s requires a corpus with intergovernmental category rows.", what),
|
||||
x = "The active corpus's `summary_categories` has no M/L (intergovernmental) rows.",
|
||||
i = "This corpus predates the intergovernmental category rows added by cog_pipeline PR #59.",
|
||||
i = "Point USCOGDATA_URL at a newer corpus that includes the M/L summary_categories rows."
|
||||
), class = "uscogdata_ig_categories_unsupported")
|
||||
}
|
||||
invisible(TRUE)
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
.sql_lit_chr <- function(x) {
|
||||
safe <- gsub("'", "''", x, fixed = TRUE)
|
||||
@@ -405,8 +218,7 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
.build_verb_sql <- function(view, subtype_col, govid, years, category,
|
||||
ig_view = NULL) {
|
||||
.build_verb_sql <- function(view, subtype_col, govid, years, category) {
|
||||
govid_lit <- .sql_lit_chr(govid)
|
||||
years_lit <- paste(as.integer(years), collapse = ",")
|
||||
category_pred <- if (is.null(category)) {
|
||||
@@ -415,26 +227,6 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
sprintf("AND category IN (%s)", .sql_lit_chr(category))
|
||||
}
|
||||
|
||||
# expenditure_concept = "total" adds the intergovernmental leg. UNION ALL,
|
||||
# never UNION: the two legs are disjoint by item_code prefix (E/F/G vs M/L),
|
||||
# so de-duplication would be pure cost, and a silent row-drop if two
|
||||
# governments ever reported identical values.
|
||||
source_expr <- if (is.null(ig_view)) {
|
||||
view
|
||||
} else {
|
||||
sprintf("(SELECT * FROM %s UNION ALL SELECT * FROM %s)", view, ig_view)
|
||||
}
|
||||
|
||||
# bool_or(), not bool_and(): a no-op for the Direct/revenue legs (those
|
||||
# views filter NOT is_aggregate, so no row in any group is ever aggregate),
|
||||
# but load-bearing for the IG leg, which deliberately keeps aggregate rows
|
||||
# (see inst/sql/24-ig_long.sql). The wide era is dense -- every government
|
||||
# has a row for every code in a family, most of them $0 -- so a $0 leaf
|
||||
# commonly lands in the same (year, gov, subtype, category) group as the
|
||||
# real aggregate row. bool_and() would then read FALSE for that group even
|
||||
# though its dollars came entirely from an aggregate row, silently
|
||||
# suppressing the "Aggregate fallback applied" note on exactly the rows
|
||||
# this feature exists to surface.
|
||||
sprintf(
|
||||
"SELECT
|
||||
year,
|
||||
@@ -444,14 +236,14 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
category,
|
||||
SUM(amt) * 1000.0 AS amt_nominal,
|
||||
string_agg(DISTINCT item_code, ',' ORDER BY item_code) AS codes_included,
|
||||
bool_or(is_aggregate) AS aggregate_fallback
|
||||
bool_and(is_aggregate) AS aggregate_fallback
|
||||
FROM %2$s
|
||||
WHERE canonical_govid IN (%3$s)
|
||||
AND year IN (%4$s)
|
||||
%5$s
|
||||
GROUP BY year, canonical_govid, gov_name, xwalk_gov_name, %1$s, category
|
||||
ORDER BY year, canonical_govid, %1$s, category",
|
||||
subtype_col, source_expr, govid_lit, years_lit, category_pred
|
||||
subtype_col, view, govid_lit, years_lit, category_pred
|
||||
)
|
||||
}
|
||||
|
||||
@@ -504,131 +296,11 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
result
|
||||
}
|
||||
|
||||
#' Detect rows where expenditure_concept = "total" is reporting the
|
||||
#' intergovernmental leg with NO Direct counterpart in the same (year,
|
||||
#' canonical_govid, category) group AND a harmonization recipe actually
|
||||
#' recovers the missing Direct dollars for that exact (year, canonical_govid,
|
||||
#' category) triple.
|
||||
#'
|
||||
#' Bare Direct-row absence is deliberately NOT sufficient on its own: the
|
||||
#' dominant real cause of "no Direct sibling row" is a government that simply
|
||||
#' has no direct spending in that category (e.g. a state that funds K-12
|
||||
#' entirely through school districts), which is correct, ordinary data, not
|
||||
#' suppression. Genuine suppression -- a legacy aggregate-only family whose
|
||||
#' Direct-leg basis query excludes it by construction (spending_long/
|
||||
#' spending_long_harmonized both filter NOT is_aggregate) -- always has a
|
||||
#' covering harmonization recipe, because that is exactly what the recipe
|
||||
#' catalog exists to recover (see R/suggestions.R and `cog_recipes()`). So
|
||||
#' checking "does a recipe actually cover this triple" cleanly separates the
|
||||
#' two cases instead of conflating them.
|
||||
#'
|
||||
#' Returns `list(flag, notes)`, both the same length as `result`: `flag` is
|
||||
#' `TRUE` only for the `spend_subtype == "intergovernmental"` row(s) in a
|
||||
#' suppressed group, and `notes` names the recovering recipe(s) for those
|
||||
#' rows (`NA` everywhere else).
|
||||
#' @noRd
|
||||
.detect_direct_suppressed <- function(con, result, subtype_col) {
|
||||
n <- nrow(result)
|
||||
empty_notes <- rep(NA_character_, n)
|
||||
if (n == 0L) return(list(flag = logical(0), notes = character(0)))
|
||||
is_ig <- result[[subtype_col]] %in% "intergovernmental"
|
||||
if (!any(is_ig)) return(list(flag = rep(FALSE, n), notes = empty_notes))
|
||||
|
||||
key <- paste(result$year, result$canonical_govid, result$category, sep = "\r")
|
||||
has_direct <- key %in% unique(key[!is_ig])
|
||||
candidate <- is_ig & !has_direct
|
||||
|
||||
flag <- rep(FALSE, n)
|
||||
notes <- empty_notes
|
||||
if (!any(candidate)) return(list(flag = flag, notes = notes))
|
||||
|
||||
idx <- which(candidate)
|
||||
rows <- unique(result[idx, c("year", "canonical_govid", "category")])
|
||||
covering <- .covering_recipes(con, rows)
|
||||
cov_key <- paste(covering$year, covering$canonical_govid, covering$category,
|
||||
sep = "\r")
|
||||
|
||||
for (i in idx) {
|
||||
k <- paste(result$year[i], result$canonical_govid[i], result$category[i],
|
||||
sep = "\r")
|
||||
m <- match(k, cov_key)
|
||||
if (is.na(m)) next
|
||||
ids <- covering$recipe_ids[[m]]
|
||||
if (length(ids) == 0L) next
|
||||
flag[i] <- TRUE
|
||||
notes[i] <- sprintf(
|
||||
"Direct component is unavailable through this basis for this year; recover it via recipe = '%s' (see cog_recipes()).",
|
||||
paste(sort(unique(ids)), collapse = "', '")
|
||||
)
|
||||
}
|
||||
list(flag = flag, notes = notes)
|
||||
}
|
||||
|
||||
#' For each (year, canonical_govid, category) triple potentially affected by
|
||||
#' a suppressed Direct leg, find the harmonization recipe(s) that (a) cover
|
||||
#' this `category` (share a component item_code via `summary_categories`,
|
||||
#' excluding any recipe that is itself entirely intergovernmental M/L -- the
|
||||
#' same exclusion `.build_suggestions()` applies, see I2) and (b) actually
|
||||
#' produce a `long` row for this exact (canonical_govid, year) via the same
|
||||
#' generic join `.run_recipe()` uses (component year_min/year_max +
|
||||
#' gov_type_scope, no is_aggregate filter -- a recipe's whole point is to
|
||||
#' recover data that's aggregate-only). Adds a list-column `recipe_ids`
|
||||
#' (possibly length-0) to `rows`.
|
||||
#' @noRd
|
||||
.covering_recipes <- function(con, rows) {
|
||||
rows$recipe_ids <- vector("list", nrow(rows))
|
||||
cats <- unique(rows$category[!is.na(rows$category)])
|
||||
if (length(cats) == 0L) return(rows)
|
||||
|
||||
cand <- DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT sc.category, r.recipe_id
|
||||
FROM harmonization_recipes r
|
||||
JOIN summary_categories sc ON sc.item_code = r.component_code
|
||||
WHERE sc.category IN (%s)
|
||||
AND r.recipe_id NOT IN (
|
||||
SELECT DISTINCT recipe_id FROM harmonization_recipes
|
||||
WHERE LEFT(component_code, 1) IN ('M', 'L')
|
||||
)",
|
||||
.sql_lit_chr(cats)
|
||||
))
|
||||
if (nrow(cand) == 0L) return(rows)
|
||||
|
||||
recipe_ids_all <- unique(cand$recipe_id)
|
||||
govids <- unique(rows$canonical_govid)
|
||||
years <- unique(rows$year)
|
||||
covered <- DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT r.recipe_id, l.canonical_govid, l.year
|
||||
FROM long l
|
||||
JOIN harmonization_recipes r
|
||||
ON l.item_code = r.component_code
|
||||
AND l.year BETWEEN r.year_min AND r.year_max
|
||||
AND (r.gov_type_scope = 'all'
|
||||
OR (r.gov_type_scope = 'state' AND l.type = 0)
|
||||
OR (r.gov_type_scope = 'local' AND l.type BETWEEN 1 AND 3))
|
||||
WHERE r.recipe_id IN (%s)
|
||||
AND l.canonical_govid IN (%s)
|
||||
AND l.year IN (%s)",
|
||||
.sql_lit_chr(recipe_ids_all), .sql_lit_chr(govids), paste(years, collapse = ",")
|
||||
))
|
||||
|
||||
for (i in seq_len(nrow(rows))) {
|
||||
cat_i <- rows$category[i]
|
||||
if (is.na(cat_i)) next
|
||||
cat_recipe_ids <- cand$recipe_id[cand$category == cat_i]
|
||||
if (length(cat_recipe_ids) == 0L) next
|
||||
sub <- covered[covered$canonical_govid == rows$canonical_govid[i] &
|
||||
covered$year == rows$year[i] &
|
||||
covered$recipe_id %in% cat_recipe_ids, ]
|
||||
rows$recipe_ids[[i]] <- sort(unique(sub$recipe_id))
|
||||
}
|
||||
rows
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
.notes_column <- function(result, direct_suppressed_notes = NULL) {
|
||||
.notes_column <- function(result) {
|
||||
n <- nrow(result)
|
||||
if (n == 0L) return(character(0))
|
||||
parts <- vector("list", 3L)
|
||||
parts <- vector("list", 2L)
|
||||
agg <- result[["aggregate_fallback"]]
|
||||
parts[[1]] <- if (!is.null(agg)) {
|
||||
ifelse(agg %in% TRUE,
|
||||
@@ -645,11 +317,6 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
} else {
|
||||
rep(NA_character_, n)
|
||||
}
|
||||
parts[[3]] <- if (!is.null(direct_suppressed_notes)) {
|
||||
direct_suppressed_notes
|
||||
} else {
|
||||
rep(NA_character_, n)
|
||||
}
|
||||
out <- character(n)
|
||||
for (i in seq_len(n)) {
|
||||
pieces <- vapply(parts, `[[`, character(1), i)
|
||||
|
||||
+153
-189
@@ -1,8 +1,9 @@
|
||||
# R/suggestions.R
|
||||
# Recipe-component-driven signposting: when a basis = "harmonized" query for
|
||||
# a category comes back with a coverage gap in some requested years (the
|
||||
# result has no rows at all in that year) that a harmonization recipe would
|
||||
# actually fill for this government, surface that recipe as a suggestion.
|
||||
# a category asks for a code that is itself a harmonization recipe
|
||||
# component, and that specific code has no rows in some requested years
|
||||
# while the recipe's own generic join would still fill those years for this
|
||||
# government, surface that recipe as a suggestion.
|
||||
#
|
||||
# This is deliberately keyed off the recipe catalog's component codes, not
|
||||
# off harmonization_map rows: no live map row carries a non-blank
|
||||
@@ -12,83 +13,58 @@
|
||||
# suggestion off of, just a leaf-code absence a recipe happens to fill).
|
||||
# See docs/phase_r_harmonization_review.md § 0.3.
|
||||
#
|
||||
# Scope is deliberately narrow: signposting only runs when the caller
|
||||
# Scope is deliberately narrow in one respect and, as of Phase R3 Task 19c,
|
||||
# deliberately WIDE in another: signposting only runs when the caller
|
||||
# supplied a `category` (an un-scoped, all-categories query has no single
|
||||
# coverage question to answer) and only flags a recipe when the ACTUAL
|
||||
# result has zero rows in a requested year AND the candidate recipe's own
|
||||
# generic join (same join .run_recipe() uses, including its wide-era
|
||||
# aggregate rows) produces at least one row for this government in that
|
||||
# year. Checking presence per-government (not corpus-wide) avoids false
|
||||
# positives from ordinary reporting variance -- most governments don't use
|
||||
# every sibling code in a multi-code category every year, and that is not
|
||||
# a format-boundary gap worth signposting.
|
||||
#
|
||||
# C1(a): for expenditure_concept = "total" callers, `result` here must
|
||||
# already be the Direct-leg subset (the caller filters out
|
||||
# spend_subtype == "intergovernmental" rows before calling in). A gap year
|
||||
# is "the requested year has no Direct rows", never "no rows at all" --
|
||||
# an IG row surviving on a legacy aggregate that Direct excludes must not
|
||||
# read as coverage and cancel the very suggestion that would recover it.
|
||||
# coverage question to answer), but within that category it now checks
|
||||
# EACH recipe component that is itself a category member individually,
|
||||
# rather than asking whether the whole category *result* has zero rows
|
||||
# that year. A recipe fires when one of its own components has zero rows
|
||||
# for this government in a requested year, AND SOME OTHER component of that
|
||||
# SAME recipe -- excluding the gapped one itself -- has a row (same join
|
||||
# .run_recipe() uses, aggregate rows included) for that year. This is the
|
||||
# literal review-doc § 0.3 criterion: "...has no rows ... but other
|
||||
# components do." A component's OWN aggregate-only row does not satisfy
|
||||
# its own gap (self-coverage is not "other components"); only a genuinely
|
||||
# different sibling component can. This fires even if OTHER, unrelated
|
||||
# codes in the same category have full data that year and the overall
|
||||
# result looks complete. That is a deliberate narrowing of the R2-era
|
||||
# false-positive guard: most governments don't use every sibling code in a
|
||||
# multi-code category every year, and per-code detection WILL flag some of
|
||||
# that as a "gap" even though it's really just a government not having
|
||||
# that particular sub-type of spending, not a format-boundary artifact.
|
||||
# The remaining guard against ordinary reporting variance is the
|
||||
# per-government, per-OTHER-component `covered` check below (a component
|
||||
# is only flagged when a DIFFERENT component of the SAME recipe -- not
|
||||
# some unrelated code, and not the gapped component's own aggregate row --
|
||||
# actually has something to offer in that year); it no longer tries to
|
||||
# avoid noise from sibling *codes*, only from a recipe with genuinely
|
||||
# nothing else to contribute. The acceptable noise level this trade
|
||||
# produces is a product decision, measured (not tuned here) by
|
||||
# data-raw/measure_signposting_rate.R and ruled on at Checkpoint R3.
|
||||
|
||||
#' Build the `prov$suggestions` list for a (non-recipe) basis = "harmonized"
|
||||
#' verb call: recipes whose generic join would fill a real gap in `result`.
|
||||
#'
|
||||
#' @param con Active DuckDB connection.
|
||||
#' @param govid Character vector of canonical_govid values (the verb's raw
|
||||
#' `govid`).
|
||||
#' @param years Integer vector of requested years.
|
||||
#' @param category `category` argument as passed to the verb (character
|
||||
#' vector or `NULL`; suggestions are only computed when non-NULL).
|
||||
#' @param result The verb's already-computed result tibble (post basis
|
||||
#' query, pre per_capita/adjust_to_year), pre-filtered to the Direct leg
|
||||
#' only when the caller's `expenditure_concept = "total"` (see C1(a)).
|
||||
#' @param basis The *resolved* basis (`"harmonized"` or `"raw"`).
|
||||
#' @param flow_prefixes The calling verb's own flow-type prefixes (e.g.
|
||||
#' `c("E", "F", "G")` for `cog_spending()`, `c("T", "A", "U", "B", "C",
|
||||
#' "D")` for `cog_revenue()` -- see `.verb_spendrev()`). Passed through to
|
||||
#' `.attach_ig_counterparts()` to keep the intergovernmental-counterpart
|
||||
#' lookup scoped to the calling verb's own flow family.
|
||||
#' @return List of `list(recipe_id, label, available_years, hint,
|
||||
#' ig_recipe_id)`, possibly empty.
|
||||
#' Recipe components that are classified under the requested category --
|
||||
#' the codes a category-scoped query actually "requests". A recipe can
|
||||
#' have components outside the category (e.g. general_gov_e89_wide's E85
|
||||
#' leg has no category assignment); those never trigger on their own, they
|
||||
#' just were never part of what this query asked for.
|
||||
#' @noRd
|
||||
.build_suggestions <- function(con, govid, years, category, result, basis,
|
||||
flow_prefixes) {
|
||||
if (!identical(basis, "harmonized") || is.null(category)) return(list())
|
||||
|
||||
# Exclude any recipe that is ITSELF an intergovernmental (M/L) recipe --
|
||||
# i.e. every one of its own component codes is M/L-prefixed. Without this,
|
||||
# a category whose summary_categories rows span both a Direct family
|
||||
# (e.g. E04/E05, "Corrections") and its M/L counterpart (M04/M05, same
|
||||
# category since Task 1) makes the M/L recipe itself (e.g.
|
||||
# `corrections_ig_local_combined`) a raw top-level candidate for a plain
|
||||
# (Direct) cog_spending() call -- following that hint would silently
|
||||
# return intergovernmental dollars under `expenditure_concept = "direct"`
|
||||
# provenance. This is a stronger, unconditional exclusion than the
|
||||
# flow-prefix gate below/in `.attach_ig_counterparts()`: an M/L recipe
|
||||
# should never be suggested as a coverage-gap filler for EITHER verb, not
|
||||
# just kept from being named as the *counterpart* of another suggestion.
|
||||
candidates <- DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT recipe_id FROM harmonization_recipes
|
||||
WHERE component_code IN (
|
||||
SELECT DISTINCT item_code FROM summary_categories WHERE category IN (%s)
|
||||
)
|
||||
AND recipe_id NOT IN (
|
||||
SELECT DISTINCT recipe_id FROM harmonization_recipes
|
||||
WHERE LEFT(component_code, 1) IN ('M', 'L')
|
||||
)",
|
||||
.category_recipe_components <- function(con, category) {
|
||||
DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT r.recipe_id, r.component_code, r.year_min, r.year_max,
|
||||
r.gov_type_scope
|
||||
FROM harmonization_recipes r
|
||||
JOIN summary_categories sc
|
||||
ON sc.item_code = r.component_code AND sc.category IN (%s)",
|
||||
.sql_lit_chr(category)
|
||||
))$recipe_id
|
||||
if (length(candidates) == 0L) return(list())
|
||||
))
|
||||
}
|
||||
|
||||
result_years <- if (is.null(result) || nrow(result) == 0L) {
|
||||
integer(0)
|
||||
} else {
|
||||
unique(as.integer(result$year))
|
||||
}
|
||||
gap_years <- setdiff(as.integer(years), result_years)
|
||||
if (length(gap_years) == 0L) return(list())
|
||||
|
||||
meta <- tibble::as_tibble(DBI::dbGetQuery(con, sprintf(
|
||||
#' Label + overall year coverage for a set of recipe ids (the suggestion's
|
||||
#' `label`/`available_years`).
|
||||
#' @noRd
|
||||
.recipe_meta <- function(con, candidates) {
|
||||
tibble::as_tibble(DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT recipe_id, any_value(label) AS label,
|
||||
MIN(year_min) AS year_min, MAX(year_max) AS year_max
|
||||
FROM harmonization_recipes
|
||||
@@ -96,13 +72,48 @@
|
||||
GROUP BY recipe_id",
|
||||
.sql_lit_chr(candidates)
|
||||
)))
|
||||
}
|
||||
|
||||
# Which (recipe_id, year) pairs the recipe's own generic join actually
|
||||
# covers for this government, restricted to the gap years -- the same
|
||||
# join .run_recipe() uses (component year_min/year_max + gov_type_scope,
|
||||
# no is_aggregate filter), just checking existence instead of summing.
|
||||
covered <- DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT r.recipe_id, l.year
|
||||
#' Which (recipe_id, component_code, year) triples have at least one
|
||||
#' NOT-aggregate row for these governments -- i.e. that specific requested
|
||||
#' code itself has data, scoped exactly like .run_recipe()'s join
|
||||
#' (component year_min/year_max + gov_type_scope). NOT-aggregate mirrors
|
||||
#' what basis = "harmonized" itself excludes: an aggregate-only year is a
|
||||
#' gap for that code exactly as it would be in a plain category query.
|
||||
#' @noRd
|
||||
.component_presence <- function(con, candidates, govid, years_lit) {
|
||||
DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT r.recipe_id, r.component_code, l.year
|
||||
FROM long l
|
||||
JOIN harmonization_recipes r
|
||||
ON l.item_code = r.component_code
|
||||
AND l.year BETWEEN r.year_min AND r.year_max
|
||||
AND (r.gov_type_scope = 'all'
|
||||
OR (r.gov_type_scope = 'state' AND l.type = 0)
|
||||
OR (r.gov_type_scope = 'local' AND l.type BETWEEN 1 AND 3))
|
||||
WHERE NOT l.is_aggregate
|
||||
AND r.recipe_id IN (%s)
|
||||
AND l.canonical_govid IN (%s)
|
||||
AND l.year IN (%s)",
|
||||
.sql_lit_chr(candidates), .sql_lit_chr(govid), years_lit
|
||||
))
|
||||
}
|
||||
|
||||
#' Which (recipe_id, component_code, year) triples have at least one row
|
||||
#' (aggregate rows included) for these governments -- the same scoping
|
||||
#' .run_recipe()'s join uses (component year_min/year_max + gov_type_scope),
|
||||
#' just checking existence instead of summing. Kept at per-component grain
|
||||
#' (not unioned across the whole recipe, unlike the R2/R3-pre-fix version of
|
||||
#' this function) so a gap check can require the covering evidence to come
|
||||
#' from a DIFFERENT component -- review-doc § 0.3's "other components", not
|
||||
#' the gapped component's own aggregate row. This is the per-government
|
||||
#' guard against ordinary reporting variance: a recipe with genuinely
|
||||
#' nothing to offer from any OTHER component (aggregate or leaf) never
|
||||
#' fires.
|
||||
#' @noRd
|
||||
.recipe_coverage <- function(con, candidates, govid, years_lit) {
|
||||
DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT r.recipe_id, r.component_code, l.year
|
||||
FROM long l
|
||||
JOIN harmonization_recipes r
|
||||
ON l.item_code = r.component_code
|
||||
@@ -113,13 +124,68 @@
|
||||
WHERE r.recipe_id IN (%s)
|
||||
AND l.canonical_govid IN (%s)
|
||||
AND l.year IN (%s)",
|
||||
.sql_lit_chr(candidates), .sql_lit_chr(govid),
|
||||
paste(gap_years, collapse = ",")
|
||||
.sql_lit_chr(candidates), .sql_lit_chr(govid), years_lit
|
||||
))
|
||||
}
|
||||
|
||||
#' TRUE if recipe `rid` has at least one requested component with an
|
||||
#' in-scope requested year that has no data (`present`), in a year some
|
||||
#' OTHER component of the same recipe is otherwise fillable (`covered`,
|
||||
#' excluding the component under test) -- the per-code gap the R2
|
||||
#' whole-result check couldn't see, covered by another component the way
|
||||
#' review-doc § 0.3 specifies (not by the gapped component's own aggregate
|
||||
#' row -- that is self-coverage, not "other components", and must not
|
||||
#' count).
|
||||
#' @noRd
|
||||
.recipe_component_gapped <- function(rid, requested, present, covered, years) {
|
||||
comps <- requested[requested$recipe_id == rid, , drop = FALSE]
|
||||
for (i in seq_len(nrow(comps))) {
|
||||
this_code <- comps$component_code[i]
|
||||
in_scope <- years[years >= comps$year_min[i] & years <= comps$year_max[i]]
|
||||
if (length(in_scope) == 0L) next
|
||||
has_data <- present$year[
|
||||
present$recipe_id == rid & present$component_code == this_code
|
||||
]
|
||||
gap_years <- setdiff(in_scope, has_data)
|
||||
if (length(gap_years) == 0L) next
|
||||
other_covered_years <- covered$year[
|
||||
covered$recipe_id == rid & covered$component_code != this_code
|
||||
]
|
||||
if (any(gap_years %in% other_covered_years)) return(TRUE)
|
||||
}
|
||||
FALSE
|
||||
}
|
||||
|
||||
#' Build the `prov$suggestions` list for a (non-recipe) basis = "harmonized"
|
||||
#' verb call: recipes whose generic join would fill a real per-code gap for
|
||||
#' the requested category.
|
||||
#'
|
||||
#' @param con Active DuckDB connection.
|
||||
#' @param govid Character vector of canonical_govid values (the verb's raw
|
||||
#' `govid`).
|
||||
#' @param years Integer vector of requested years.
|
||||
#' @param category `category` argument as passed to the verb (character
|
||||
#' vector or `NULL`; suggestions are only computed when non-NULL).
|
||||
#' @param basis The *resolved* basis (`"harmonized"` or `"raw"`).
|
||||
#' @return List of `list(recipe_id, label, available_years, hint)`, possibly
|
||||
#' empty.
|
||||
#' @noRd
|
||||
.build_suggestions <- function(con, govid, years, category, basis) {
|
||||
if (!identical(basis, "harmonized") || is.null(category)) return(list())
|
||||
|
||||
requested <- .category_recipe_components(con, category)
|
||||
if (nrow(requested) == 0L) return(list())
|
||||
candidates <- unique(requested$recipe_id)
|
||||
years_int <- as.integer(years)
|
||||
years_lit <- paste(years_int, collapse = ",")
|
||||
|
||||
meta <- .recipe_meta(con, candidates)
|
||||
present <- .component_presence(con, candidates, govid, years_lit)
|
||||
covered <- .recipe_coverage(con, candidates, govid, years_lit)
|
||||
|
||||
suggestions <- list()
|
||||
for (rid in candidates) {
|
||||
if (!rid %in% covered$recipe_id) next
|
||||
if (!.recipe_component_gapped(rid, requested, present, covered, years_int)) next
|
||||
m <- meta[meta$recipe_id == rid, ]
|
||||
suggestions[[length(suggestions) + 1L]] <- list(
|
||||
recipe_id = rid,
|
||||
@@ -128,121 +194,19 @@
|
||||
hint = sprintf("re-run with recipe = '%s'", rid)
|
||||
)
|
||||
}
|
||||
.attach_ig_counterparts(con, suggestions, flow_prefixes)
|
||||
}
|
||||
|
||||
#' Attach `ig_recipe_id` to each suggestion: the intergovernmental-expenditure
|
||||
#' recipe (an M-to-local or L-to-state recipe) whose component codes cover
|
||||
#' exactly the same set of function suffixes as the firing recipe's own
|
||||
#' components, e.g. `corrections_combined`'s {E04, E05} -> suffixes {"04",
|
||||
#' "05"} matches `corrections_ig_local_combined`'s {M04, M05} -> the same
|
||||
#' {"04", "05"}. `NULL` when no such recipe exists, which also covers the
|
||||
#' case where the firing recipe already IS the IG recipe (self-matches are
|
||||
#' excluded, so an IG recipe never names itself as its own counterpart).
|
||||
#'
|
||||
#' Matching is deliberately an exact set match, not "any suffix in common":
|
||||
#' the two-digit suffix only means the same "function" across recipes that
|
||||
#' share the underlying Census functional-classification scheme (E/F/G/L/M
|
||||
#' all use "04"/"05" for corrections). M/L "combined other" codes (47/89/
|
||||
#' 91-94) reuse digits for an unrelated catch-all construct, so e.g.
|
||||
#' `general_gov_e89_wide`'s {E85, E89} -> {"85", "89"} must NOT match
|
||||
#' `ige_local_m89_wide`'s {"89", "91", "92", "93"} on the shared "89" alone.
|
||||
#' Checked by hand against the full harmonization_recipes catalog: only the
|
||||
#' corrections family (E/F/G/M, suffixes 04/05) has an exact-set match in
|
||||
#' this corpus.
|
||||
#'
|
||||
#' Exact-set suffix matching is NOT enough on its own, though: the same
|
||||
#' reused-digit problem exists ACROSS the revenue-side IG families too.
|
||||
#' `ig_local_d47_wide` (D47/D94, suffixes {"47","94"}) is an exact-set match
|
||||
#' for `ige_local_m47_wide` (M47/M94, same suffixes) even though one is
|
||||
#' intergovernmental REVENUE received from local governments and the other is
|
||||
#' intergovernmental EXPENDITURE paid to local governments -- unrelated flows
|
||||
#' that happen to reuse "47"/"94" for their own "transit/utilities" and
|
||||
#' "other/combined" catch-alls. `ig_federal_b47_wide`, `ig_state_c47_wide`,
|
||||
#' and their `*_89` siblings all collide the same way. None of this is
|
||||
#' reachable via `cog_revenue()` in the bundled fixture today (its B/C/D
|
||||
#' recipes never happen to have a covered gap year for any fixture govid),
|
||||
#' but it IS reachable via a mis-scoped `cog_spending()` call on a
|
||||
#' revenue-only category, e.g. `cog_spending(gov, category = "IG Federal")`
|
||||
#' fires `ig_federal_b47_wide`/`ig_federal_b89_wide` for real in the fixture
|
||||
#' -- so this is a live, not merely theoretical, gap.
|
||||
#'
|
||||
#' Two flow-family checks close this, both required (see
|
||||
#' `tests/testthat/test-expenditure-concept.R`, "revenue-flavored ... never
|
||||
#' receives an M/L counterpart" tests, for the pairwise verification):
|
||||
#' 1. `own_prefix %in% flow_prefixes`: the firing recipe's own component
|
||||
#' codes must belong to the calling verb's own flow family (the same
|
||||
#' `flow_prefixes` `.build_harmonization_block()` uses, see
|
||||
#' `R/basis.R`). This blocks a recipe surfaced through a mis-scoped
|
||||
#' category from ever reaching the M/L search, e.g. `cog_spending()`'s
|
||||
#' flow_prefixes are `c("E","F","G")`, which `ig_federal_b47_wide`'s own
|
||||
#' `"B"` is not part of.
|
||||
#' 2. `own_prefix %in% c("E","F","G")`: M/L only ever pairs with the
|
||||
#' DIRECT-expenditure family, never with revenue (`cog_revenue()`'s
|
||||
#' flow_prefixes already fold B/C/D in as ordinary revenue -- there is
|
||||
#' no separate "Total" bolt-on for revenue the way `expenditure_concept`
|
||||
#' adds one for spending) and never with ANOTHER M/L recipe (without
|
||||
#' this check, `ige_local_m47_wide` would wrongly match sibling
|
||||
#' `ige_state_l47_wide` on their shared {"47","94"} suffix set).
|
||||
#' Condition 1 alone does not catch this: under `cog_revenue()`,
|
||||
#' `ig_federal_b47_wide`'s own `"B"` IS inside revenue's own
|
||||
#' `flow_prefixes`, so only this second, family-specific check blocks
|
||||
#' the search.
|
||||
#' @noRd
|
||||
.attach_ig_counterparts <- function(con, suggestions, flow_prefixes) {
|
||||
if (length(suggestions) == 0L) return(suggestions)
|
||||
|
||||
comp <- DBI::dbGetQuery(con,
|
||||
"SELECT recipe_id, component_code FROM harmonization_recipes")
|
||||
comp$prefix <- substr(comp$component_code, 1L, 1L)
|
||||
comp$suffix <- substr(comp$component_code, 2L, nchar(comp$component_code))
|
||||
suffix_sets <- lapply(split(comp$suffix, comp$recipe_id), function(x) sort(unique(x)))
|
||||
prefix_sets <- lapply(split(comp$prefix, comp$recipe_id), function(x) sort(unique(x)))
|
||||
|
||||
ig_recipe_ids <- unique(comp$recipe_id[comp$prefix %in% c("M", "L")])
|
||||
|
||||
find_counterpart <- function(rid) {
|
||||
own_prefix <- prefix_sets[[rid]]
|
||||
own_suffix <- suffix_sets[[rid]]
|
||||
if (is.null(own_prefix) || is.null(own_suffix)) return(NULL)
|
||||
if (!all(own_prefix %in% flow_prefixes)) return(NULL)
|
||||
if (!all(own_prefix %in% c("E", "F", "G"))) return(NULL)
|
||||
for (cand in ig_recipe_ids) {
|
||||
if (identical(cand, rid)) next
|
||||
if (setequal(suffix_sets[[cand]], own_suffix)) return(cand)
|
||||
}
|
||||
NULL
|
||||
}
|
||||
|
||||
lapply(suggestions, function(s) {
|
||||
# `s$ig_recipe_id <- NULL` would DELETE the element rather than set it
|
||||
# (standard R list-assignment gotcha), leaving no-match entries missing
|
||||
# the key entirely instead of carrying it as NULL. Single-bracket
|
||||
# assignment with a wrapped list preserves a NULL-valued element so the
|
||||
# field is always present, per the brief's "NULL when there is none".
|
||||
s["ig_recipe_id"] <- list(find_counterpart(s$recipe_id))
|
||||
s
|
||||
})
|
||||
suggestions
|
||||
}
|
||||
|
||||
#' Emit the single cli::cli_inform() message summarizing all suggestions
|
||||
#' for a verb call (the brief's "one message", not one per suggestion).
|
||||
#' Bullet text is pre-formatted plain text (no cli/glue `{}` markup) since
|
||||
#' recipe ids/labels are untrusted-ish data values, not literal call-site
|
||||
#' expressions. When a suggestion has an `ig_recipe_id`, one indented
|
||||
#' continuation line is appended naming the intergovernmental counterpart
|
||||
#' recipe (embedded `\n` renders as a hanging-indent continuation of the
|
||||
#' same bullet under cli, not a new bullet).
|
||||
#' expressions.
|
||||
#' @noRd
|
||||
.inform_suggestions <- function(suggestions) {
|
||||
bullets <- vapply(suggestions, function(s) {
|
||||
bullet <- sprintf("%s (%d-%d): %s", s$recipe_id,
|
||||
sprintf("%s (%d-%d): %s", s$recipe_id,
|
||||
s$available_years[1], s$available_years[2], s$hint)
|
||||
if (!is.null(s$ig_recipe_id)) {
|
||||
bullet <- paste0(bullet, sprintf(
|
||||
"\n intergovernmental counterpart: recipe = '%s'", s$ig_recipe_id))
|
||||
}
|
||||
bullet
|
||||
}, character(1))
|
||||
cli::cli_inform(c(
|
||||
i = "Coverage gap detected for the requested years; a harmonization recipe may fill it:",
|
||||
|
||||
@@ -1,35 +1,23 @@
|
||||
# R/views.R
|
||||
|
||||
# SQL files that cannot be registered unconditionally against a v4 corpus,
|
||||
# for one of two distinct reasons -- both fail at CREATE VIEW time (DuckDB
|
||||
# resolves a view's source schema eagerly, even though it defers execution),
|
||||
# so a v4 corpus can't tolerate either unconditionally:
|
||||
#
|
||||
# (a) Missing FILE. 33-/34-/35- read_parquet() a v5-only parquet table
|
||||
# SQL files whose view definitions read schema-v5-only parquet tables
|
||||
# (harmonization_map.parquet, harmonization_recipes.parquet,
|
||||
# series_breaks.parquet) that doesn't exist at all on a v4 corpus --
|
||||
# "IO Error: No files found".
|
||||
#
|
||||
# (b) Missing COLUMN. 22-/23-/25- reference `long.harmonized_code`, a
|
||||
# column that does not exist on a v4 corpus's `long` table (harmonized
|
||||
# space was introduced in schema v5) -- "Binder Error: Referenced
|
||||
# column harmonized_code not found". 42-/43-/45- are on this list only
|
||||
# because they SELECT s.* FROM the (a)/(b) views above, so they'd fail
|
||||
# to resolve their own source view if it weren't already skipped.
|
||||
#
|
||||
# Registration is therefore gated on manifest$schema_version >= 5 for all of
|
||||
# them; verb-level *usage* of the resulting views is separately gated by
|
||||
# .resolve_basis() / .require_schema_v5().
|
||||
# series_breaks.parquet) or select from views built on top of them. DuckDB's
|
||||
# read_parquet() resolves the file at CREATE VIEW time (even for a view, it
|
||||
# still needs the source schema) and errors immediately -- "IO Error: No
|
||||
# files found" -- if the path doesn't exist, so these cannot be registered
|
||||
# unconditionally against a v4 corpus the way the rest of inst/sql/ is.
|
||||
# Registration is therefore gated on manifest$schema_version >= 5; verb-level
|
||||
# *usage* of the resulting views is separately gated by .resolve_basis() /
|
||||
# .require_schema_v5().
|
||||
.harmonization_view_files <- c(
|
||||
"22-spending_long_harmonized.sql",
|
||||
"23-revenue_long_harmonized.sql",
|
||||
"25-ig_long_harmonized.sql",
|
||||
"33-harmonization_map.sql",
|
||||
"34-harmonization_recipes.sql",
|
||||
"35-series_breaks_pq.sql",
|
||||
"42-spending_annotated_harmonized.sql",
|
||||
"43-revenue_annotated_harmonized.sql",
|
||||
"45-ig_annotated_harmonized.sql"
|
||||
"43-revenue_annotated_harmonized.sql"
|
||||
)
|
||||
|
||||
#' Register DuckDB views from inst/sql/ SQL files
|
||||
|
||||
@@ -25,32 +25,30 @@ package implements.
|
||||
- `USCOGDATA_CACHE_DIR` — optional override for the manifest cache directory
|
||||
- `USCOGDATA_MANIFEST_TTL_SECS` — optional manifest re-fetch TTL (default 3600)
|
||||
|
||||
## Direct vs Total spending
|
||||
## Raw-parquet caveat: `survey_weight` is not an aggregation weight
|
||||
|
||||
`cog_spending(..., expenditure_concept = c("direct", "total"))` controls
|
||||
whose spending a result counts. `"direct"` (the default) is a government's
|
||||
own current operations, capital outlay, and other direct spending. `"total"`
|
||||
additionally adds in the intergovernmental legs — money it hands to other
|
||||
governments to spend on its behalf — which is meaningful for describing one
|
||||
government's own budget over time, but double-counts when summed across
|
||||
governments (a state's payment to a county is the same dollar the county
|
||||
reports as its own direct spending).
|
||||
|
||||
**Rule of thumb: any figure that spans more than one government uses
|
||||
`direct`.** `cog_geographic_rollup()` and `cog_peer_compare()` enforce this
|
||||
by refusing `expenditure_concept = "total"`. See
|
||||
`vignette("total-spending", package = "uscogdata")` for the full
|
||||
explanation with worked examples.
|
||||
Users reading the corpus parquet directly (DuckDB, arrow) will see a
|
||||
`survey_weight` column (schema v6, col 28). It is legacy Census IndFin
|
||||
sample-design **metadata passed through verbatim** — the Census Bureau's own
|
||||
source documentation says it "is for informational purposes only and should
|
||||
not be used to derive any other statistics" (`_ReadMe_First_IndFin.txt`;
|
||||
likewise `UserGuide.xls` Data User Note 8: "Do not use the weight field to
|
||||
derive state or national totals"). The raw encoding is also inconsistent
|
||||
across vintages (reciprocal scale most years, direct scale in 2003, a `1`
|
||||
placeholder in 1967/70/71/73/2001, all-`0` in 2007–2012, `NA` for all
|
||||
modern-source rows), so `sum(amt * survey_weight/10000)`-style expressions
|
||||
produce silently wrong totals — including exact zeros for 2007–2012. Sum
|
||||
`amt` unweighted; no uscogdata function reads this column. Full evidence:
|
||||
`cog_pipeline/.superpowers/sdd/weight-semantics-findings.md`.
|
||||
|
||||
## Developer notes
|
||||
|
||||
### Testing
|
||||
|
||||
The package ships a bundled fixture corpus at `inst/extdata/fixture_corpus/` —
|
||||
a 15 MB four-year slice (2011, 2012, 2019, 2020) of the full corpus covering
|
||||
all 50 states. `tests/testthat/setup.R` automatically points `USCOGDATA_URL`
|
||||
at this fixture, so the full test suite runs offline with no network
|
||||
dependency:
|
||||
a 3.6 MB two-year slice (2019 + 2020) of the full corpus covering all 50
|
||||
states. `tests/testthat/setup.R` automatically points `USCOGDATA_URL` at this
|
||||
fixture, so the full test suite runs offline with no network dependency:
|
||||
|
||||
```r
|
||||
devtools::test() # uses bundled fixture, no credentials required
|
||||
|
||||
@@ -0,0 +1,563 @@
|
||||
# data-raw/measure_signposting_rate.R
|
||||
#
|
||||
# Phase R3 Task 19c: measures the harmonization-signposting suggestion rate
|
||||
# under THREE `.build_suggestions()` implementations, over a realistic query
|
||||
# battery:
|
||||
# every summary_categories category
|
||||
# x a 3-year pre/post-2012 span (the wide-aggregate -> modern-leaf
|
||||
# format-boundary window; falls back to the widest span the corpus
|
||||
# actually supports if it can't fill a full 3+3 design -- see
|
||||
# .measure_year_span())
|
||||
# x up to N_GOV sampled governments (seeded, deterministic)
|
||||
#
|
||||
# The three arms, oldest to newest:
|
||||
# - "coarse" (git ref b0df1ec, the merged R2 tip): a year counts as
|
||||
# gapped only when the WHOLE category result has zero rows that year.
|
||||
# - "selfcov" (git ref da72bf3, Task 19c's first per-code pass, since
|
||||
# amended after review): per-code, but a component's gap could be
|
||||
# satisfied by ANY component of the recipe INCLUDING ITSELF -- so a
|
||||
# code whose only representation in a year was its own wide-era
|
||||
# aggregate row satisfied its own coverage check. Flagged in review as
|
||||
# not matching review-doc S: 0.3's literal criterion ("... has no rows
|
||||
# ... but OTHER components do") and fixed in the next commit.
|
||||
# - "percode" (live code): per-code, requiring a genuinely DIFFERENT
|
||||
# sibling component to supply the covering evidence -- the shipped,
|
||||
# corrected implementation.
|
||||
#
|
||||
# READ THIS BEFORE QUOTING ANY DELTA FROM THIS SCRIPT
|
||||
# -----------------------------------------------------
|
||||
# The coarse and per-code checks are PARTLY DISJOINT, not nested. Per-code
|
||||
# is NOT a strict widening of coarse: there are queries coarse fires on that
|
||||
# per-code does not, so moving coarse -> percode both ADDS and REMOVES
|
||||
# signposting. Every `*_delta_pp` figure this script reports -- overall and
|
||||
# per category -- is therefore a NET of those two flows and can mask a
|
||||
# coverage loss in either direction. A headline "+X pp" can sit on top of
|
||||
# categories that lost coverage outright (a NEGATIVE corrected_delta_pp),
|
||||
# and a category-level zero can be an add and a loss cancelling. Read
|
||||
# `$subset_relation` (printed under "Subset relation" below) alongside any
|
||||
# delta; that section is where the two flows are separated.
|
||||
#
|
||||
# The disjointness is structural, not a sampling artifact. Both arms pair a
|
||||
# gap test with a coverage test, and it is the COVERAGE test that differs:
|
||||
# - coarse: gap = the WHOLE category result has zero rows that year;
|
||||
# covered = the recipe's generic join has ANY row that year
|
||||
# (unioned across all components -- a component's own
|
||||
# aggregate row counts).
|
||||
# - percode: gap = one specific component has no non-aggregate row that
|
||||
# year; covered = a DIFFERENT component of the SAME recipe has
|
||||
# a row that year (self-coverage explicitly excluded, per
|
||||
# review-doc S: 0.3's "...but OTHER components do").
|
||||
# So when a whole category is empty in a year -- exactly coarse's trigger --
|
||||
# and the only covering evidence is the gapped component's own wide-era
|
||||
# aggregate row, coarse fires and per-code CANNOT: there is by construction
|
||||
# no other component to supply the evidence. That case is already pinned as
|
||||
# intended behaviour in tests/testthat/test-recipes.R ("per-code gap does
|
||||
# NOT fire when a code's only coverage is its own aggregate row"). This
|
||||
# script's job is to say how often it costs coverage, not to relitigate it.
|
||||
#
|
||||
# This script MEASURES the deltas; it does not decide whether the resulting
|
||||
# signposting trade -- added "noise" in one direction, lost whole-category
|
||||
# gap coverage in the other -- is acceptable. That is Jared's ruling at
|
||||
# Checkpoint R3 (see
|
||||
# cog_pipeline/.superpowers/sdd/phase-r-task-19c-brief.md). The selfcov arm
|
||||
# exists purely to answer a narrower, mechanical question for that ruling:
|
||||
# how much of the coarse -> percode delta was ever attributable to the
|
||||
# self-coverage bug (selfcov -> percode), as opposed to genuine
|
||||
# other-component coverage (coarse -> percode directly)?
|
||||
#
|
||||
# All three arms no longer coexist in R/suggestions.R (each superseded the
|
||||
# last in place), so this script pulls each VERBATIM from git history and
|
||||
# evaluates it in an isolated environment parented on the uscogdata
|
||||
# namespace, so each still resolves the unchanged sibling helpers it
|
||||
# depends on (.sql_lit_chr()) exactly as the live package did at that
|
||||
# commit. This guarantees every non-live arm is the actual shipped code at
|
||||
# that point, not a hand-reconstruction that could silently drift from what
|
||||
# really shipped.
|
||||
#
|
||||
# Usage (from the uscogdata package root; a git checkout, not a tarball):
|
||||
# Rscript data-raw/measure_signposting_rate.R
|
||||
# USCOGDATA_URL=<staged-corpus-url> Rscript data-raw/measure_signposting_rate.R
|
||||
#
|
||||
# Or from R:
|
||||
# source("data-raw/measure_signposting_rate.R")
|
||||
# res <- measure_signposting_rate(corpus_url = "<url>")
|
||||
# res$summary; res$by_category
|
||||
|
||||
#' Pull a historical `.build_suggestions()` (and whatever helpers it uses)
|
||||
#' verbatim from git history and evaluate it in an isolated environment
|
||||
#' parented on the uscogdata namespace, so it resolves unchanged sibling
|
||||
#' helpers (`.sql_lit_chr()`) the same way the live package does.
|
||||
#' @noRd
|
||||
.measure_load_git_impl <- function(git_ref, git_path = "R/suggestions.R") {
|
||||
old_src <- tryCatch(
|
||||
system2("git", c("show", sprintf("%s:%s", git_ref, git_path)),
|
||||
stdout = TRUE, stderr = TRUE),
|
||||
error = function(e) NULL
|
||||
)
|
||||
status <- attr(old_src, "status")
|
||||
if (is.null(old_src) || (!is.null(status) && status != 0L) ||
|
||||
!any(grepl("^\\.build_suggestions", old_src))) {
|
||||
stop(
|
||||
"Could not retrieve the .build_suggestions() implementation from ",
|
||||
"git ref '", git_ref, "' at '", git_path, "'. Run this script from ",
|
||||
"inside the uscogdata git checkout (not a tarball/installed copy).",
|
||||
call. = FALSE
|
||||
)
|
||||
}
|
||||
env <- new.env(parent = asNamespace("uscogdata"))
|
||||
# eval(parse()) here is safe: `old_src` is not external/untrusted input --
|
||||
# it is this repo's OWN historical R/suggestions.R, fetched via `git show`
|
||||
# from a fixed, hardcoded internal commit ref (overridable only by a
|
||||
# caller who already has R-level code execution in this dev-only
|
||||
# measurement script). No network or user-supplied data reaches this call.
|
||||
eval(parse(text = old_src), envir = env)
|
||||
stopifnot(is.function(env$.build_suggestions))
|
||||
env
|
||||
}
|
||||
|
||||
#' Resolve the query battery's year span: a `pre_n`-year window immediately
|
||||
#' before `boundary_year` unioned with a `post_n`-year window starting at
|
||||
#' `boundary_year` (default 3+3 around 2012, the wide-aggregate ->
|
||||
#' modern-leaf format boundary). Falls back to every distinct year the
|
||||
#' corpus actually has in `long` when it can't fill that full design, and
|
||||
#' says so explicitly in `$note` rather than silently padding or
|
||||
#' fabricating years.
|
||||
#' @noRd
|
||||
.measure_year_span <- function(con, boundary_year = 2012L,
|
||||
pre_n = 3L, post_n = 3L) {
|
||||
available <- sort(as.integer(
|
||||
DBI::dbGetQuery(con, "SELECT DISTINCT year FROM long")$year
|
||||
))
|
||||
desired_pre <- (boundary_year - pre_n):(boundary_year - 1L)
|
||||
desired_post <- boundary_year:(boundary_year + post_n - 1L)
|
||||
actual_pre <- intersect(desired_pre, available)
|
||||
actual_post <- intersect(desired_post, available)
|
||||
full_design <- length(actual_pre) == pre_n && length(actual_post) == post_n
|
||||
|
||||
if (full_design) {
|
||||
years <- sort(c(actual_pre, actual_post))
|
||||
note <- sprintf(
|
||||
"Full %d-year pre/%d-year post-%d design available -- using years: %s.",
|
||||
pre_n, post_n, boundary_year, paste(years, collapse = ", ")
|
||||
)
|
||||
} else {
|
||||
years <- available
|
||||
note <- sprintf(paste(
|
||||
"Corpus does NOT support a full %d-year pre/%d-year post-%d span",
|
||||
"(desired pre-window %s -> only %s present; desired post-window %s",
|
||||
"-> only %s present). Falling back to the WIDEST span this corpus",
|
||||
"supports: all %d distinct year(s) actually in `long`: %s.",
|
||||
"This is NOT a 3-year pre/post-%d design -- reported as measured,",
|
||||
"not padded or fabricated."
|
||||
),
|
||||
pre_n, post_n, boundary_year,
|
||||
paste(desired_pre, collapse = ","),
|
||||
if (length(actual_pre)) paste(actual_pre, collapse = ",") else "none",
|
||||
paste(desired_post, collapse = ","),
|
||||
if (length(actual_post)) paste(actual_post, collapse = ",") else "none",
|
||||
length(available), paste(available, collapse = ", "),
|
||||
boundary_year)
|
||||
}
|
||||
list(years = years, full_design = full_design, note = note,
|
||||
available = available)
|
||||
}
|
||||
|
||||
#' Deterministically sample up to `n` distinct governments that actually
|
||||
#' report *something* in the battery's year span (querying a government
|
||||
#' with zero presence in every measured year isn't a realistic query).
|
||||
#' @noRd
|
||||
.measure_sample_govids <- function(con, years, n = 20L, seed = 19L) {
|
||||
pool <- DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT canonical_govid FROM long WHERE year IN (%s)
|
||||
ORDER BY canonical_govid",
|
||||
paste(years, collapse = ",")
|
||||
))$canonical_govid
|
||||
if (length(pool) <= n) return(sort(pool))
|
||||
set.seed(seed)
|
||||
sort(sample(pool, n))
|
||||
}
|
||||
|
||||
#' Comma-join a suggestion list's recipe ids (stable order) for the detail
|
||||
#' frame's audit columns; `""` when nothing fired.
|
||||
#' @noRd
|
||||
.measure_recipe_ids <- function(suggestions) {
|
||||
if (length(suggestions) == 0L) return("")
|
||||
paste(sort(vapply(suggestions, function(s) s$recipe_id, character(1))),
|
||||
collapse = ",")
|
||||
}
|
||||
|
||||
#' Run one (category, government) query through the coarse (`coarse_env`),
|
||||
#' self-coverage-allowed (`selfcov_env`), and live per-code
|
||||
#' `.build_suggestions()` and return a one-row summary of what each fired.
|
||||
#'
|
||||
#' Also records the coarse arm's OWN trigger evidence -- `coarse_gap_years`,
|
||||
#' the requested years in which the whole category result has zero rows --
|
||||
#' so a coarse-fired/per-code-silent disagreement can be named down to
|
||||
#' (category, government, year) instead of just counted. Per-code's gap
|
||||
#' years are deliberately NOT re-derived here: that would mean
|
||||
#' reimplementing `.recipe_component_gapped()`'s set arithmetic in the
|
||||
#' measurement harness, where it could silently drift from the code under
|
||||
#' measurement. Per-code rows are identified by the recipe ids they fired.
|
||||
#' @noRd
|
||||
.measure_one_query <- function(con, coarse_env, selfcov_env, category,
|
||||
category_type, govid, years) {
|
||||
view <- if (identical(category_type, "revenue")) {
|
||||
"revenue_annotated_harmonized"
|
||||
} else {
|
||||
"spending_annotated_harmonized"
|
||||
}
|
||||
subtype_col <- if (identical(category_type, "revenue")) {
|
||||
"revenue_subtype"
|
||||
} else {
|
||||
"spend_subtype"
|
||||
}
|
||||
sql <- .build_verb_sql(view, subtype_col, govid, years, category)
|
||||
result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
||||
|
||||
coarse_sugg <- coarse_env$.build_suggestions(
|
||||
con, govid, years, category, result, "harmonized"
|
||||
)
|
||||
selfcov_sugg <- selfcov_env$.build_suggestions(
|
||||
con, govid, years, category, "harmonized"
|
||||
)
|
||||
percode_sugg <- .build_suggestions(con, govid, years, category, "harmonized")
|
||||
|
||||
result_years <- if (nrow(result) == 0L) integer(0) else unique(as.integer(result$year))
|
||||
gap_years <- sort(setdiff(as.integer(years), result_years))
|
||||
|
||||
data.frame(
|
||||
category = category,
|
||||
category_type = category_type,
|
||||
canonical_govid = govid,
|
||||
n_result_rows = nrow(result),
|
||||
coarse_gap_years = paste(gap_years, collapse = ","),
|
||||
n_coarse = length(coarse_sugg),
|
||||
n_selfcov = length(selfcov_sugg),
|
||||
n_percode = length(percode_sugg),
|
||||
fired_coarse = length(coarse_sugg) > 0L,
|
||||
fired_selfcov = length(selfcov_sugg) > 0L,
|
||||
fired_percode = length(percode_sugg) > 0L,
|
||||
coarse_recipes = .measure_recipe_ids(coarse_sugg),
|
||||
percode_recipes = .measure_recipe_ids(percode_sugg),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
#' Columns that identify a disagreeing query well enough for a human to go
|
||||
#' and inspect it, in print order. Intersected with what `detail` actually
|
||||
#' has, so this works on a minimal hand-built frame too.
|
||||
#' @noRd
|
||||
.MEASURE_IDENTITY_COLS <- c(
|
||||
"category", "category_type", "canonical_govid", "coarse_gap_years",
|
||||
"n_result_rows", "coarse_recipes", "percode_recipes"
|
||||
)
|
||||
|
||||
#' Separate the two flows the `*_delta_pp` figures net together.
|
||||
#'
|
||||
#' Per-code is NOT a widening of coarse (see this file's header): the two
|
||||
#' checks pair different gap tests with different coverage tests, so moving
|
||||
#' coarse -> percode both adds and removes firings. This splits the
|
||||
#' disagreement into:
|
||||
#' - `violations`: coarse fired, per-code did NOT -- signposting coverage
|
||||
#' LOST. These are what a net delta hides. `holds` is FALSE whenever
|
||||
#' this is non-empty, i.e. whenever coarse is not a subset of per-code.
|
||||
#' - `additions`: per-code fired, coarse did NOT -- the expected gain.
|
||||
#'
|
||||
#' Deliberately returns the offending rows, not just counts, so the
|
||||
#' Checkpoint R3 ruling can be made against named (category, government,
|
||||
#' year) cases. Deliberately does NOT assert -- the violation set is really
|
||||
#' non-empty on the staged corpus, and a hard assertion here would only
|
||||
#' break the harness that is supposed to report it.
|
||||
#' @noRd
|
||||
.measure_subset_relation <- function(detail) {
|
||||
required <- c("category", "canonical_govid", "fired_coarse", "fired_percode")
|
||||
absent <- if (is.data.frame(detail)) setdiff(required, names(detail)) else required
|
||||
if (!is.data.frame(detail) || length(absent) > 0L) {
|
||||
stop("`detail` must be a data frame with columns ",
|
||||
paste(required, collapse = ", "), " (missing: ",
|
||||
paste(absent, collapse = ", "), ").", call. = FALSE)
|
||||
}
|
||||
fired_coarse <- as.logical(detail$fired_coarse)
|
||||
fired_percode <- as.logical(detail$fired_percode)
|
||||
if (anyNA(fired_coarse) || anyNA(fired_percode)) {
|
||||
stop("`fired_coarse`/`fired_percode` must be non-NA logicals.", call. = FALSE)
|
||||
}
|
||||
|
||||
keep <- intersect(.MEASURE_IDENTITY_COLS, names(detail))
|
||||
viol_idx <- which(fired_coarse & !fired_percode)
|
||||
add_idx <- which(fired_percode & !fired_coarse)
|
||||
|
||||
list(
|
||||
holds = length(viol_idx) == 0L,
|
||||
n_queries = nrow(detail),
|
||||
n_coarse_fired = sum(fired_coarse),
|
||||
n_percode_fired = sum(fired_percode),
|
||||
n_both = sum(fired_coarse & fired_percode),
|
||||
n_violations = length(viol_idx),
|
||||
n_additions = length(add_idx),
|
||||
violations = detail[viol_idx, keep, drop = FALSE],
|
||||
additions = detail[add_idx, keep, drop = FALSE]
|
||||
)
|
||||
}
|
||||
|
||||
#' Render a data frame of disagreeing queries as indented report lines,
|
||||
#' capped at `max_rows` with an explicit note about what was withheld (the
|
||||
#' full set is always in the returned `$subset_relation`).
|
||||
#' @noRd
|
||||
.measure_fmt_rows <- function(df, max_rows = 50L) {
|
||||
if (nrow(df) == 0L) return(" (none)")
|
||||
shown <- utils::head(df, max_rows)
|
||||
out <- paste0(" ", utils::capture.output(print(shown, row.names = FALSE)))
|
||||
if (nrow(df) > max_rows) {
|
||||
out <- c(out, sprintf(" ... %d more row(s) not shown; full set in $subset_relation.",
|
||||
nrow(df) - max_rows))
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
#' Format `.measure_subset_relation()` as a prominent, clearly-labelled
|
||||
#' report section. States plainly whether coarse is a subset of per-code
|
||||
#' and, when it is not, exactly where it breaks.
|
||||
#' @noRd
|
||||
.measure_format_subset_report <- function(rel, max_rows = 50L) {
|
||||
lines <- c(
|
||||
"==== Subset relation: is COARSE a subset of PER-CODE? ====",
|
||||
sprintf("Queries: %d | coarse fired: %d | per-code fired: %d | both: %d",
|
||||
rel$n_queries, rel$n_coarse_fired, rel$n_percode_fired, rel$n_both)
|
||||
)
|
||||
if (rel$holds) {
|
||||
lines <- c(lines, sprintf(paste(
|
||||
"HOLDS: coarse IS a subset of per-code -- 0 of %d queries fire under",
|
||||
"coarse but not per-code. On THIS battery the delta is a pure",
|
||||
"addition of %d query/queries, with no coverage lost."
|
||||
), rel$n_queries, rel$n_additions))
|
||||
} else {
|
||||
lines <- c(lines,
|
||||
"*** VIOLATED: coarse is NOT a subset of per-code. ***",
|
||||
sprintf(paste(
|
||||
"%d of %d queries fire under COARSE but NOT under PER-CODE:",
|
||||
"signposting coverage the move LOSES."
|
||||
), rel$n_violations, rel$n_queries),
|
||||
sprintf(paste(
|
||||
"Every delta reported above is therefore a NET of %d addition(s)",
|
||||
"MINUS %d loss(es), and understates both. Do not read it as",
|
||||
"'per-code fires wherever coarse did, plus more'."
|
||||
), rel$n_additions, rel$n_violations),
|
||||
"",
|
||||
paste(" COVERAGE LOST -- coarse fired, per-code silent.",
|
||||
"`coarse_gap_years` is the requested year(s) in which the whole",
|
||||
"category result was empty (coarse's own trigger evidence):"),
|
||||
.measure_fmt_rows(rel$violations, max_rows)
|
||||
)
|
||||
}
|
||||
c(lines, "",
|
||||
sprintf(" COVERAGE ADDED -- per-code fired, coarse silent (%d query/queries):",
|
||||
rel$n_additions),
|
||||
.measure_fmt_rows(rel$additions, max_rows))
|
||||
}
|
||||
|
||||
#' Measure the coarse-vs-per-code signposting suggestion rate over a
|
||||
#' realistic query battery (every category x a pre/post-boundary_year span
|
||||
#' x up to n_gov sampled governments).
|
||||
#'
|
||||
#' @param corpus_url Corpus to measure against. Defaults to
|
||||
#' `Sys.getenv("USCOGDATA_URL")`; if that's unset, falls back to the
|
||||
#' bundled v5 fixture (so the script runs out of the box). Re-run with
|
||||
#' `USCOGDATA_URL` pointed at the staged/full corpus later.
|
||||
#' @param n_gov Governments to sample (deterministically). "Up to" -- if
|
||||
#' the corpus has fewer distinct governments in the measured years than
|
||||
#' this, every one of them is used.
|
||||
#' @param seed Sampling seed (fixed for reproducibility).
|
||||
#' @param boundary_year,pre_years_n,post_years_n Define the desired query
|
||||
#' span: `pre_years_n` years immediately before `boundary_year`, unioned
|
||||
#' with `post_years_n` years starting at `boundary_year`. Falls back to
|
||||
#' the corpus's widest actually-available span when this can't be filled
|
||||
#' (see `.measure_year_span()`).
|
||||
#' @param coarse_ref Git ref to pull the R2 coarse `.build_suggestions()`
|
||||
#' from.
|
||||
#' @param selfcov_ref Git ref to pull Task 19c's first, self-coverage-
|
||||
#' allowed per-code `.build_suggestions()` from (amended after review).
|
||||
#' @param verbose Print progress/notes as the battery runs.
|
||||
#' @return Invisibly, a list with `corpus_url`, `years`, `span_note`,
|
||||
#' `full_design`, `govids`, `seed`, `detail` (one row per query),
|
||||
#' `by_category`, and `summary`.
|
||||
#' @noRd
|
||||
measure_signposting_rate <- function(corpus_url = Sys.getenv("USCOGDATA_URL", unset = NA),
|
||||
n_gov = 20L,
|
||||
seed = 19L,
|
||||
boundary_year = 2012L,
|
||||
pre_years_n = 3L,
|
||||
post_years_n = 3L,
|
||||
coarse_ref = "b0df1ec",
|
||||
selfcov_ref = "da72bf3",
|
||||
verbose = TRUE) {
|
||||
pkgload::load_all(".", quiet = TRUE)
|
||||
|
||||
if (is.na(corpus_url) || !nzchar(corpus_url)) {
|
||||
corpus_url <- paste0(
|
||||
system.file("extdata/fixture_corpus", package = "uscogdata"), "/"
|
||||
)
|
||||
if (verbose) {
|
||||
message("No USCOGDATA_URL set; defaulting to the bundled v5 fixture: ",
|
||||
corpus_url)
|
||||
}
|
||||
}
|
||||
|
||||
old_url <- Sys.getenv("USCOGDATA_URL", unset = NA)
|
||||
cog_close()
|
||||
Sys.setenv(USCOGDATA_URL = corpus_url)
|
||||
on.exit({
|
||||
cog_close()
|
||||
if (is.na(old_url)) Sys.unsetenv("USCOGDATA_URL") else Sys.setenv(USCOGDATA_URL = old_url)
|
||||
}, add = TRUE)
|
||||
|
||||
con <- cog_open()
|
||||
coarse_env <- .measure_load_git_impl(git_ref = coarse_ref)
|
||||
selfcov_env <- .measure_load_git_impl(git_ref = selfcov_ref)
|
||||
|
||||
span <- .measure_year_span(con, boundary_year, pre_years_n, post_years_n)
|
||||
years <- span$years
|
||||
if (verbose) message(span$note)
|
||||
|
||||
govids <- .measure_sample_govids(con, years, n = n_gov, seed = seed)
|
||||
if (verbose) {
|
||||
message(sprintf("Sampled %d government(s) (seed = %d) from %d present in years %s.",
|
||||
length(govids), seed,
|
||||
length(DBI::dbGetQuery(con, sprintf(
|
||||
"SELECT DISTINCT canonical_govid FROM long WHERE year IN (%s)",
|
||||
paste(years, collapse = ",")))$canonical_govid),
|
||||
paste(years, collapse = ", ")))
|
||||
}
|
||||
|
||||
categories <- DBI::dbGetQuery(con,
|
||||
"SELECT DISTINCT category, category_type FROM summary_categories
|
||||
WHERE category IS NOT NULL ORDER BY category_type, category")
|
||||
if (verbose) {
|
||||
message(sprintf("Battery: %d categories x %d governments = %d queries.",
|
||||
nrow(categories), length(govids),
|
||||
nrow(categories) * length(govids)))
|
||||
}
|
||||
|
||||
rows <- vector("list", nrow(categories) * length(govids))
|
||||
k <- 0L
|
||||
for (ci in seq_len(nrow(categories))) {
|
||||
for (gv in govids) {
|
||||
k <- k + 1L
|
||||
rows[[k]] <- .measure_one_query(
|
||||
con, coarse_env, selfcov_env,
|
||||
category = categories$category[ci],
|
||||
category_type = categories$category_type[ci],
|
||||
govid = gv, years = years
|
||||
)
|
||||
}
|
||||
}
|
||||
detail <- do.call(rbind, rows)
|
||||
# percode only ever fires where selfcov also fires (percode is a strict
|
||||
# narrowing of selfcov: same gap detection, plus the self-coverage path
|
||||
# removed) -- this is what makes the decomposition below exact rather
|
||||
# than approximate. Checked, not assumed.
|
||||
stopifnot(all(detail$fired_percode <= detail$fired_selfcov))
|
||||
detail$fired_selfcov_only <- detail$fired_selfcov & !detail$fired_percode
|
||||
|
||||
# coarse vs percode is NOT a subset relation the way percode vs selfcov
|
||||
# is (see header). Measured and REPORTED, never asserted: the violation
|
||||
# set is genuinely non-empty on the staged corpus, and a stopifnot() here
|
||||
# would break the harness whose whole job is to surface it.
|
||||
subset_relation <- .measure_subset_relation(detail)
|
||||
detail$coarse_only <- detail$fired_coarse & !detail$fired_percode
|
||||
detail$percode_only <- detail$fired_percode & !detail$fired_coarse
|
||||
|
||||
by_category <- dplyr::summarise(
|
||||
dplyr::group_by(detail, category, category_type),
|
||||
n_queries = dplyr::n(),
|
||||
coarse_rate = mean(fired_coarse),
|
||||
selfcov_rate = mean(fired_selfcov),
|
||||
percode_rate = mean(fired_percode),
|
||||
original_delta_pp = (mean(fired_selfcov) - mean(fired_coarse)) * 100,
|
||||
corrected_delta_pp = (mean(fired_percode) - mean(fired_coarse)) * 100,
|
||||
selfcov_share_pp = mean(fired_selfcov_only) * 100,
|
||||
# the two flows corrected_delta_pp nets together, per category
|
||||
n_coarse_only = sum(coarse_only),
|
||||
n_percode_only = sum(percode_only),
|
||||
.groups = "drop"
|
||||
)
|
||||
by_category <- dplyr::arrange(by_category, dplyr::desc(corrected_delta_pp))
|
||||
|
||||
summary_overall <- data.frame(
|
||||
n_queries = nrow(detail),
|
||||
n_categories = nrow(categories),
|
||||
n_governments = length(govids),
|
||||
coarse_fired = sum(detail$fired_coarse),
|
||||
selfcov_fired = sum(detail$fired_selfcov),
|
||||
percode_fired = sum(detail$fired_percode),
|
||||
coarse_rate = mean(detail$fired_coarse),
|
||||
selfcov_rate = mean(detail$fired_selfcov),
|
||||
percode_rate = mean(detail$fired_percode)
|
||||
)
|
||||
summary_overall$original_delta_pp <- (summary_overall$selfcov_rate - summary_overall$coarse_rate) * 100
|
||||
summary_overall$corrected_delta_pp <- (summary_overall$percode_rate - summary_overall$coarse_rate) * 100
|
||||
summary_overall$selfcov_share_pp <- mean(detail$fired_selfcov_only) * 100
|
||||
summary_overall$relative_increase <- if (summary_overall$coarse_rate > 0) {
|
||||
summary_overall$percode_rate / summary_overall$coarse_rate - 1
|
||||
} else {
|
||||
NA_real_
|
||||
}
|
||||
|
||||
if (verbose) {
|
||||
message(sprintf(
|
||||
"Coarse rate: %.4f (%d/%d) | Self-cov-allowed rate: %.4f (%d/%d) | Corrected per-code rate: %.4f (%d/%d)",
|
||||
summary_overall$coarse_rate, summary_overall$coarse_fired, summary_overall$n_queries,
|
||||
summary_overall$selfcov_rate, summary_overall$selfcov_fired, summary_overall$n_queries,
|
||||
summary_overall$percode_rate, summary_overall$percode_fired, summary_overall$n_queries
|
||||
))
|
||||
message(sprintf(
|
||||
"Original delta (selfcov - coarse): %+.2f pp | Corrected delta (percode - coarse): %+.2f pp | Self-coverage share of original delta: %.2f pp (%d/%d queries fired ONLY via self-coverage)",
|
||||
summary_overall$original_delta_pp, summary_overall$corrected_delta_pp,
|
||||
summary_overall$selfcov_share_pp,
|
||||
sum(detail$fired_selfcov_only), summary_overall$n_queries
|
||||
))
|
||||
message(if (subset_relation$holds) {
|
||||
sprintf("Subset relation coarse <= percode HOLDS (0 coarse-only firings); delta is a pure addition of %d.",
|
||||
subset_relation$n_additions)
|
||||
} else {
|
||||
sprintf("*** Subset relation coarse <= percode VIOLATED: %d coarse-only firing(s) LOST vs %d percode-only added. Deltas above are NETS. ***",
|
||||
subset_relation$n_violations, subset_relation$n_additions)
|
||||
})
|
||||
}
|
||||
|
||||
invisible(list(
|
||||
corpus_url = corpus_url,
|
||||
years = years,
|
||||
span_note = span$note,
|
||||
full_design = span$full_design,
|
||||
govids = govids,
|
||||
seed = seed,
|
||||
n_categories = nrow(categories),
|
||||
detail = detail,
|
||||
by_category = by_category,
|
||||
summary = summary_overall,
|
||||
subset_relation = subset_relation
|
||||
))
|
||||
}
|
||||
|
||||
if (identical(environment(), globalenv()) && sys.nframe() == 0L) {
|
||||
res <- measure_signposting_rate()
|
||||
cat("\n==== Query battery ====\n")
|
||||
cat("Corpus:", res$corpus_url, "\n")
|
||||
cat("Years:", paste(res$years, collapse = ", "), "\n")
|
||||
cat("Full 3-year pre/post-2012 design achieved:", res$full_design, "\n")
|
||||
cat(res$span_note, "\n")
|
||||
cat("Governments sampled:", length(res$govids), "\n\n")
|
||||
|
||||
cat("==== Overall summary (coarse / self-coverage-allowed / corrected per-code) ====\n")
|
||||
print(res$summary)
|
||||
|
||||
cat("\n==== By category (sorted by corrected delta, descending) ====\n")
|
||||
cat("NOTE: corrected_delta_pp is a NET. n_coarse_only = firings LOST going\n")
|
||||
cat("coarse -> percode; n_percode_only = firings ADDED. A category can be\n")
|
||||
cat("negative (net coverage loss) even when the overall figure is positive.\n")
|
||||
print(as.data.frame(res$by_category), row.names = FALSE)
|
||||
|
||||
cat("\n")
|
||||
cat(paste(.measure_format_subset_report(res$subset_relation), collapse = "\n"), "\n")
|
||||
}
|
||||
Binary file not shown.
+3
-3
@@ -1,7 +1,7 @@
|
||||
{
|
||||
"schema_version": 6,
|
||||
"built_at": "2026-07-27T13:04:05Z",
|
||||
"pipeline_commit": "6098baf",
|
||||
"built_at": "2026-07-23T16:14:30Z",
|
||||
"pipeline_commit": "4f992a0",
|
||||
"fixture_note": "Four-year (2011, 2012, 2019, 2020) fixture for uscogdata tests. Full corpus available via USCOGDATA_URL. Regenerated for Phase R2 (schema_version 5, harmonization_map/harmonization_recipes/ series_breaks parquet tables added). 2011/2012 straddle the wide-aggregate -> modern-leaf format boundary exercised by basis= \"harmonized\" and recipe= queries; 2019/2020 retain the prior per-capita/CPI regression anchors. Full canonical_fips_xwalk master and canonical_alias lookup table included via data-raw/regenerate_fixture_corpus.R.",
|
||||
"data_vintage": {
|
||||
"source_vintages": {
|
||||
@@ -75,7 +75,7 @@
|
||||
},
|
||||
{
|
||||
"path": "data/summary_categories.parquet",
|
||||
"sha256": "0985b607f3f35a8dff62c0561261ab6922423b81d11c07b03bcb3e3461f85e33",
|
||||
"sha256": "8e6fcd4dd9bb4723841a67233b19388c9762dfc23b4479501183cebf7ea3c1b5",
|
||||
"description": "summary_categories.parquet"
|
||||
},
|
||||
{
|
||||
|
||||
@@ -12,19 +12,6 @@
|
||||
"category": { "type": ["string", "array", "null"] },
|
||||
"basis": { "type": ["string", "null"] },
|
||||
"basis_note": { "type": ["string", "null"] },
|
||||
"expenditure_concept": {
|
||||
"type": "string",
|
||||
"enum": ["direct", "total"],
|
||||
"description": "Which spending concept produced this result. 'direct' is the government's own E/F/G spending; 'total' adds its intergovernmental payments (M to local governments, L to state governments). Only 'direct' is valid for results combined across governments."
|
||||
},
|
||||
"expenditure_concept_note": {
|
||||
"type": ["string", "null"],
|
||||
"description": "How the intergovernmental leg was assembled; null for 'direct'."
|
||||
},
|
||||
"expenditure_concept_direct_suppressed": {
|
||||
"type": "boolean",
|
||||
"description": "TRUE when expenditure_concept = 'total' and at least one requested (year, category) has intergovernmental rows but NO Direct rows in this corpus (typically a legacy aggregate-only family) -- those result rows report the intergovernmental leg alone, not Direct + IG. Always FALSE for expenditure_concept = 'direct'. See the affected rows' `notes` for the recovering recipe, if any."
|
||||
},
|
||||
"harmonization": { "type": "object" },
|
||||
"recipe": { "type": ["object", "null"] },
|
||||
"suggestions": { "type": "array" },
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
CREATE OR REPLACE VIEW spending_long AS
|
||||
SELECT *
|
||||
FROM long
|
||||
WHERE LEFT(item_code, 1) IN ('E', 'F', 'G')
|
||||
WHERE LEFT(item_code, 1) IN ('E', 'F', 'G', 'K')
|
||||
AND NOT is_aggregate;
|
||||
|
||||
@@ -3,4 +3,4 @@ SELECT * REPLACE (harmonized_code AS item_code)
|
||||
FROM long
|
||||
WHERE NOT is_aggregate
|
||||
AND harmonized_code IS NOT NULL
|
||||
AND LEFT(harmonized_code, 1) IN ('E', 'F', 'G');
|
||||
AND LEFT(harmonized_code, 1) IN ('E', 'F', 'G', 'K');
|
||||
|
||||
@@ -1,18 +0,0 @@
|
||||
-- Intergovernmental expenditure rows (M = to local govts, L = to state govts).
|
||||
--
|
||||
-- Deliberately does NOT filter `NOT is_aggregate`, unlike spending_long. In the
|
||||
-- wide era (<= FY2011) the IG families M05/M12/M47/M89/L47/L89 are published
|
||||
-- ONLY as aggregate-flagged rows -- filtering them would hide ~70% of legacy IG
|
||||
-- dollars and make Total silently collapse to Direct. This is safe because the
|
||||
-- aggregate codes and their modern leaf components are strictly year-disjoint
|
||||
-- (M47 ends 2011 / M94 starts 2012; M89 is aggregate only <= 2011 and a leaf
|
||||
-- from 2012 alongside M91-93), so no row is ever counted twice. Same argument
|
||||
-- the pipeline's recipe joins use.
|
||||
--
|
||||
-- `L--` IS excluded: it is the IG-to-state FAMILY TOTAL and genuinely rolls up
|
||||
-- the L-NN codes, so including it would double-count.
|
||||
CREATE OR REPLACE VIEW ig_long AS
|
||||
SELECT *
|
||||
FROM long
|
||||
WHERE LEFT(item_code, 1) IN ('M', 'L')
|
||||
AND item_code NOT LIKE '%--';
|
||||
@@ -1,15 +0,0 @@
|
||||
-- Harmonized-basis IG rows. Uses COALESCE(harmonized_code, item_code) rather
|
||||
-- than harmonized_code alone: aggregate rows carry NO harmonized_code by
|
||||
-- construction (harmonized space is leaf-only), so a plain
|
||||
-- `harmonized_code IS NOT NULL` filter would drop every legacy IG aggregate --
|
||||
-- in the bundled fixture corpus (year 2011; 2012+ all carry a harmonized_code)
|
||||
-- that is $379,016,063k across 25,688 M rows and $2,277,458k across 19,266 L
|
||||
-- rows (`SELECT year, LEFT(item_code,1), SUM(amt), COUNT(*) FROM ig_long
|
||||
-- WHERE harmonized_code IS NULL GROUP BY 1, 2`). COALESCE keeps the one real
|
||||
-- IG collapse rule (M38 -> M36, SB012, year-disjoint 1967-2011 vs 2012+)
|
||||
-- while never dropping a row.
|
||||
CREATE OR REPLACE VIEW ig_long_harmonized AS
|
||||
SELECT * REPLACE (COALESCE(harmonized_code, item_code) AS item_code)
|
||||
FROM long
|
||||
WHERE LEFT(item_code, 1) IN ('M', 'L')
|
||||
AND item_code NOT LIKE '%--';
|
||||
@@ -1,16 +0,0 @@
|
||||
CREATE OR REPLACE VIEW ig_annotated AS
|
||||
SELECT
|
||||
s.*,
|
||||
x.gov_name AS xwalk_gov_name,
|
||||
x.govs_type,
|
||||
x.type_label,
|
||||
x.fips_state AS xwalk_fips_state,
|
||||
x.fips_county AS xwalk_fips_county,
|
||||
x.fips_place,
|
||||
x.population_acs,
|
||||
c.category,
|
||||
c.category_type,
|
||||
c.spend_subtype
|
||||
FROM ig_long s
|
||||
LEFT JOIN canonical_fips_xwalk x USING (canonical_govid)
|
||||
LEFT JOIN summary_categories c USING (item_code);
|
||||
@@ -1,16 +0,0 @@
|
||||
CREATE OR REPLACE VIEW ig_annotated_harmonized AS
|
||||
SELECT
|
||||
s.*,
|
||||
x.gov_name AS xwalk_gov_name,
|
||||
x.govs_type,
|
||||
x.type_label,
|
||||
x.fips_state AS xwalk_fips_state,
|
||||
x.fips_county AS xwalk_fips_county,
|
||||
x.fips_place,
|
||||
x.population_acs,
|
||||
c.category,
|
||||
c.category_type,
|
||||
c.spend_subtype
|
||||
FROM ig_long_harmonized s
|
||||
LEFT JOIN canonical_fips_xwalk x USING (canonical_govid)
|
||||
LEFT JOIN summary_categories c USING (item_code);
|
||||
@@ -9,8 +9,7 @@ cog_geographic_rollup(
|
||||
category,
|
||||
years,
|
||||
per_capita = FALSE,
|
||||
adjust_to_year = NULL,
|
||||
expenditure_concept = c("direct", "total")
|
||||
adjust_to_year = NULL
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
@@ -28,13 +27,6 @@ population from `gov_population_yearly`. Govs with missing population
|
||||
are excluded from the result.}
|
||||
|
||||
\item{adjust_to_year}{Integer base year for CPI-U conversion, or `NULL`.}
|
||||
|
||||
\item{expenditure_concept}{`"direct"` (default) or `"total"`. Currently only
|
||||
`"direct"` is accepted; the `"total"` option exists in [cog_spending()] for
|
||||
single-government queries but cannot be used here because combining Total
|
||||
across multiple layers of government double-counts intergovernmental
|
||||
transfers (a state's payment to a school district is the same dollar the
|
||||
district reports as its own Direct spending).}
|
||||
}
|
||||
\value{
|
||||
Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
||||
|
||||
@@ -10,8 +10,7 @@ cog_peer_compare(
|
||||
category,
|
||||
years,
|
||||
per_capita = TRUE,
|
||||
adjust_to_year = NULL,
|
||||
expenditure_concept = c("direct", "total")
|
||||
adjust_to_year = NULL
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
@@ -28,11 +27,6 @@ cog_peer_compare(
|
||||
population.}
|
||||
|
||||
\item{adjust_to_year}{Integer base year for CPI-U conversion or `NULL`.}
|
||||
|
||||
\item{expenditure_concept}{`"direct"` (default) or `"total"`. Currently only
|
||||
`"direct"` is accepted; the `"total"` option exists in [cog_spending()] for
|
||||
single-government queries but cannot be used here because combining Total
|
||||
across peer sets counts intergovernmental transfers twice.}
|
||||
}
|
||||
\value{
|
||||
Tibble matching [cog_spending()]'s columns, plus a `role`
|
||||
|
||||
+1
-31
@@ -11,8 +11,7 @@ cog_spending(
|
||||
per_capita = FALSE,
|
||||
adjust_to_year = NULL,
|
||||
basis = c("harmonized", "raw"),
|
||||
recipe = NULL,
|
||||
expenditure_concept = c("direct", "total")
|
||||
recipe = NULL
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
@@ -56,35 +55,6 @@ argument is ignored and the result's provenance reports
|
||||
`basis = "recipe"` with an inert `harmonization` block (`applied =
|
||||
FALSE`, pointing at the `recipe` block instead) rather than a
|
||||
possibly-misleading `"harmonized"`/`"raw"` value.}
|
||||
|
||||
\item{expenditure_concept}{`"direct"` (default) returns only the
|
||||
government's own direct spending (item codes `E`/`F`/`G`), unchanged
|
||||
from prior releases. `"total"` additionally UNIONs in the
|
||||
intergovernmental leg -- payments to local governments (`M` codes) and
|
||||
to the state government (`L` codes, excluding the `L--` family-total
|
||||
rollup) -- so results gain rows with `spend_subtype ==
|
||||
"intergovernmental"`. Requires the active corpus's `summary_categories`
|
||||
to carry M/L rows (added by cog_pipeline PR #59); aborts with class
|
||||
`uscogdata_ig_categories_unsupported` on an older corpus rather than
|
||||
silently under-reporting. Mutually exclusive with `recipe` (a recipe
|
||||
already defines its own component codes). **Do not sum `"total"`
|
||||
results across levels of government** (e.g. state + county + city):
|
||||
a state's `M12` payment to a school district is the same dollar the
|
||||
district reports as its own direct `E12`, so summing both double-counts
|
||||
it. This matters in particular with [cog_geographic_rollup()], which
|
||||
sums across exactly that kind of multi-layer government set.
|
||||
|
||||
In the legacy wide era (<= FY2011), some functions are published ONLY
|
||||
as an aggregate-flagged family total (e.g. Corrections' `E04`/`E05`
|
||||
split), which the Direct leg excludes by construction but the IG leg
|
||||
deliberately keeps (see `inst/sql/24-ig_long.sql`). For a `"total"`
|
||||
query, any (year, category) where this leaves intergovernmental rows
|
||||
with NO Direct counterpart is flagged: the affected rows' `notes`
|
||||
name the harmonization recipe that recovers the missing Direct
|
||||
component (when one exists), and
|
||||
`provenance$expenditure_concept_direct_suppressed` is `TRUE` -- the
|
||||
figure in those rows is the intergovernmental leg alone, not Direct +
|
||||
IG.}
|
||||
}
|
||||
\value{
|
||||
Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||
|
||||
@@ -57,37 +57,3 @@ with_doctored_schema_version <- function(version, code) {
|
||||
}, add = TRUE)
|
||||
force(code)
|
||||
}
|
||||
|
||||
# Copy the bundled fixture to a temp dir with summary_categories.parquet
|
||||
# rewritten to drop every M/L (intergovernmental) row, then run `code`
|
||||
# against it with a clean session (mirrors with_fixture_corpus()/
|
||||
# with_doctored_schema_version()). Models a real pre-cog_pipeline-PR#59
|
||||
# corpus: the 66 M/L category rows shipped with NO schema_version bump (see
|
||||
# C2 in the expenditure-concept review), so schema_version is left
|
||||
# untouched here -- only the category data itself is rolled back.
|
||||
with_corpus_missing_ig_categories <- function(code) {
|
||||
src <- fixture_corpus_path()
|
||||
tmp <- withr::local_tempdir(.local_envir = parent.frame())
|
||||
file.copy(list.files(src, full.names = TRUE), tmp, recursive = TRUE)
|
||||
|
||||
cats_path <- file.path(tmp, "data", "summary_categories.parquet")
|
||||
filtered_path <- file.path(tmp, "data", "summary_categories_filtered.parquet")
|
||||
write_con <- DBI::dbConnect(duckdb::duckdb())
|
||||
on.exit(DBI::dbDisconnect(write_con, shutdown = TRUE), add = TRUE)
|
||||
DBI::dbExecute(write_con, sprintf(
|
||||
"COPY (SELECT * FROM read_parquet(%s) WHERE LEFT(item_code, 1) NOT IN ('M', 'L'))
|
||||
TO %s (FORMAT PARQUET)",
|
||||
uscogdata:::.sql_lit_chr(cats_path), uscogdata:::.sql_lit_chr(filtered_path)
|
||||
))
|
||||
file.remove(cats_path)
|
||||
file.rename(filtered_path, cats_path)
|
||||
|
||||
old_url <- Sys.getenv("USCOGDATA_URL", unset = NA)
|
||||
uscogdata:::cog_close()
|
||||
Sys.setenv(USCOGDATA_URL = paste0(tmp, "/"))
|
||||
on.exit({
|
||||
uscogdata:::cog_close()
|
||||
if (is.na(old_url)) Sys.unsetenv("USCOGDATA_URL") else Sys.setenv(USCOGDATA_URL = old_url)
|
||||
}, add = TRUE)
|
||||
force(code)
|
||||
}
|
||||
|
||||
@@ -15,18 +15,7 @@ test_that("cog_categories(type = 'spending') returns only expenditure rows", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_categories(type = "spending")
|
||||
expect_true(all(r$category_type == "expenditure"))
|
||||
expect_true(all(r$subtype %in% c("operations", "capital", "intergovernmental")))
|
||||
})
|
||||
|
||||
test_that("cog_categories surfaces the intergovernmental spending subtype", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_categories(type = "spending")
|
||||
expect_true("intergovernmental" %in% r$subtype)
|
||||
# IG rows reuse the existing functional categories -- they add a subtype,
|
||||
# not new category values.
|
||||
ig_cats <- sort(unique(r$category[r$subtype == "intergovernmental"]))
|
||||
direct_cats <- sort(unique(r$category[r$subtype != "intergovernmental"]))
|
||||
expect_true(all(ig_cats %in% c(direct_cats, "Other Education")))
|
||||
expect_true(all(r$subtype %in% c("operations", "capital")))
|
||||
})
|
||||
|
||||
test_that("cog_categories(type = 'revenue') returns only revenue rows", {
|
||||
|
||||
@@ -26,41 +26,3 @@ test_that(".resolve_cache_dir falls back to R_user_dir", {
|
||||
})
|
||||
})
|
||||
})
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Trailing-slash normalization (uscogdata #3 follow-up).
|
||||
#
|
||||
# EVERY consumer builds paths by concatenation: paste0(url, "manifest.json")
|
||||
# (manifest.R), paste0(url, e$path) (mirror.R), and the parquet glob in
|
||||
# views.R. mirror.R:104 even comments 'url ends in "/"' -- an assumption the
|
||||
# package documents and relies on but never enforced.
|
||||
#
|
||||
# A URL missing its trailing slash therefore fails SILENTLY and confusingly:
|
||||
# HTTPS -> ".../downloadmanifest.json" -> the host answers with an HTML 404
|
||||
# page -> the jsonlite lexical error that issue #3 reported;
|
||||
# local -> ".../corpusdata/long/**/*.parquet" -> DuckDB "No files found".
|
||||
# Neither message points at the real cause. Normalize once, at resolution.
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
test_that(".resolve_url appends a missing trailing slash", {
|
||||
withr::local_envvar(USCOGDATA_URL = "https://example.org/s/TOKEN/download")
|
||||
expect_equal(.resolve_url(), "https://example.org/s/TOKEN/download/")
|
||||
})
|
||||
|
||||
test_that(".resolve_url leaves an existing trailing slash alone", {
|
||||
withr::local_envvar(USCOGDATA_URL = "https://example.org/s/TOKEN/download/")
|
||||
expect_equal(.resolve_url(), "https://example.org/s/TOKEN/download/")
|
||||
})
|
||||
|
||||
test_that(".resolve_url normalizes a local path without a trailing slash", {
|
||||
withr::local_envvar(USCOGDATA_URL = "/tmp/corpus")
|
||||
expect_equal(.resolve_url(), "/tmp/corpus/")
|
||||
})
|
||||
|
||||
test_that(".resolve_url does not invent a slash for an empty setting", {
|
||||
# An unset/empty URL must stay empty so the "not configured" guard in
|
||||
# manifest.R still fires, rather than degrading into a bare "/" root.
|
||||
withr::local_envvar(USCOGDATA_URL = "")
|
||||
withr::local_options(uscogdata.url = "")
|
||||
expect_equal(.resolve_url(), "")
|
||||
})
|
||||
|
||||
@@ -1,536 +0,0 @@
|
||||
test_that("the corpus contains no K-prefix rows, so the Direct leg omits K", {
|
||||
con <- .ensure_session()
|
||||
n <- DBI::dbGetQuery(con,
|
||||
"SELECT COUNT(*) AS n FROM long WHERE LEFT(item_code, 1) = 'K'")$n
|
||||
expect_equal(n, 0)
|
||||
|
||||
sql_files <- c("20-spending_long.sql", "22-spending_long_harmonized.sql")
|
||||
for (f in sql_files) {
|
||||
txt <- paste(readLines(system.file("sql", f, package = "uscogdata")),
|
||||
collapse = " ")
|
||||
expect_false(grepl("'K'", txt, fixed = TRUE),
|
||||
label = paste(f, "must not reference the inert K prefix"))
|
||||
}
|
||||
})
|
||||
|
||||
test_that("expenditure_concept defaults to direct and preserves today's numbers", {
|
||||
gov <- "010000226085" # Alabama state government
|
||||
base <- cog_spending(gov, years = 2019, category = "Police")
|
||||
expl <- cog_spending(gov, years = 2019, category = "Police",
|
||||
expenditure_concept = "direct")
|
||||
expect_equal(base$amt_nominal, expl$amt_nominal)
|
||||
expect_false("intergovernmental" %in% base$spend_subtype)
|
||||
})
|
||||
|
||||
test_that("expenditure_concept = 'total' adds an intergovernmental subtype", {
|
||||
gov <- "010000226085"
|
||||
d <- cog_spending(gov, years = 2019, category = "Police",
|
||||
expenditure_concept = "direct")
|
||||
t <- cog_spending(gov, years = 2019, category = "Police",
|
||||
expenditure_concept = "total")
|
||||
expect_true("intergovernmental" %in% t$spend_subtype)
|
||||
# Direct rows are untouched; Total only ever ADDS. Use %in% rather than
|
||||
# != : a category = NULL result can contain a NULL-subtype group (codes
|
||||
# with no summary_categories row, e.g. E16/E21/E85/F16/F85/G16/G21/G85),
|
||||
# and `NA != "intergovernmental"` is NA, not TRUE, which would silently
|
||||
# smuggle an all-NA phantom row into dt.
|
||||
dt <- t[!(t$spend_subtype %in% "intergovernmental"), ]
|
||||
expect_equal(sort(dt$amt_nominal), sort(d$amt_nominal))
|
||||
expect_gt(sum(t$amt_nominal), sum(d$amt_nominal))
|
||||
})
|
||||
|
||||
test_that("legacy-era Total does not collapse to Direct (the is_aggregate trap)", {
|
||||
# In the wide era the IG dollars live almost entirely on aggregate-flagged
|
||||
# rows. A Total leg that inherited the Direct leg's NOT is_aggregate filter
|
||||
# would silently return Total == Direct here.
|
||||
gov <- "010000226085"
|
||||
d <- cog_spending(gov, years = 2011, category = "Education K-12",
|
||||
expenditure_concept = "direct")
|
||||
t <- cog_spending(gov, years = 2011, category = "Education K-12",
|
||||
expenditure_concept = "total")
|
||||
expect_true("intergovernmental" %in% t$spend_subtype)
|
||||
ig <- sum(t$amt_nominal[t$spend_subtype == "intergovernmental"])
|
||||
expect_gt(ig, 0)
|
||||
expect_gt(sum(t$amt_nominal), sum(d$amt_nominal))
|
||||
})
|
||||
|
||||
test_that("the IG leg never includes the L-- family total", {
|
||||
con <- .ensure_session()
|
||||
codes <- DBI::dbGetQuery(con,
|
||||
"SELECT DISTINCT item_code FROM ig_long")$item_code
|
||||
expect_false(any(grepl("--$", codes)))
|
||||
expect_true(all(substr(codes, 1, 1) %in% c("M", "L")))
|
||||
})
|
||||
|
||||
test_that("expenditure_concept rejects unknown values", {
|
||||
expect_error(
|
||||
cog_spending("010000226085", years = 2019, expenditure_concept = "gross"),
|
||||
class = "rlang_error"
|
||||
)
|
||||
})
|
||||
|
||||
test_that("total composes with basis = 'raw' and basis = 'harmonized'", {
|
||||
gov <- "010000226085"
|
||||
h <- cog_spending(gov, years = 2011, category = "Education K-12",
|
||||
expenditure_concept = "total", basis = "harmonized")
|
||||
r <- cog_spending(gov, years = 2011, category = "Education K-12",
|
||||
expenditure_concept = "total", basis = "raw")
|
||||
ig_h <- sum(h$amt_nominal[h$spend_subtype == "intergovernmental"])
|
||||
ig_r <- sum(r$amt_nominal[r$spend_subtype == "intergovernmental"])
|
||||
# The only IG harmonization rule is M38 -> M36 (year-disjoint), so the IG
|
||||
# total must agree between bases even though the code labels may differ.
|
||||
expect_equal(ig_h, ig_r)
|
||||
})
|
||||
|
||||
test_that("recipe = and expenditure_concept = 'total' together aborts", {
|
||||
expect_error(
|
||||
cog_spending("121011212191", 2020L, recipe = "corrections_combined",
|
||||
expenditure_concept = "total"),
|
||||
class = "uscogdata_recipe_concept_conflict"
|
||||
)
|
||||
})
|
||||
|
||||
test_that("aggregate-sourced IG dollars are flagged aggregate_fallback = TRUE (bool_or, not bool_and)", {
|
||||
# Regression test: .build_verb_sql() originally used bool_and(is_aggregate)
|
||||
# for aggregate_fallback, which is correct for the Direct leg (a group can
|
||||
# never mix aggregate and non-aggregate rows there -- spending_long filters
|
||||
# NOT is_aggregate) but wrong for the IG leg. The wide era is dense -- every
|
||||
# government has a $0 row for every code in a family -- so a $0 leaf sits in
|
||||
# the same (year, gov, subtype, category) group as the real aggregate row
|
||||
# and flips bool_and() to FALSE. Measured: AL state 2011 had $5,740,775,000
|
||||
# of aggregate-sourced IG dollars (Corrections $31,358,000 + Education K-12
|
||||
# $5,152,385,000 + General Government $557,032,000) reporting
|
||||
# aggregate_fallback = FALSE under bool_and(), with the only TRUE row being
|
||||
# Transit Utilities at $0. bool_or() reports all of them correctly.
|
||||
gov <- "010000226085"
|
||||
t <- cog_spending(gov, years = 2011, category = "Education K-12",
|
||||
expenditure_concept = "total")
|
||||
ig <- t[t$spend_subtype == "intergovernmental", ]
|
||||
expect_equal(nrow(ig), 1L)
|
||||
expect_true(ig$aggregate_fallback)
|
||||
expect_true(nzchar(ig$notes))
|
||||
expect_match(ig$notes, "Aggregate fallback applied", fixed = TRUE)
|
||||
})
|
||||
|
||||
test_that("legacy aggregate IG codes are year-disjoint from their modern leaf components", {
|
||||
# The safety of ig_long's deliberate omission of `NOT is_aggregate` (see
|
||||
# inst/sql/24-ig_long.sql) rests entirely on each legacy code's AGGREGATE
|
||||
# instance being year-disjoint from the modern leaf codes it rolls up --
|
||||
# if a future corpus rebuild ever back-filled a leaf into a year where the
|
||||
# code is still flagged aggregate, `total` would silently double-count and
|
||||
# this suite would still pass. This test fails loudly if that ever
|
||||
# happens.
|
||||
#
|
||||
# Note the invariant is scoped to the AGGREGATE flag, not bare code
|
||||
# presence: M89/L89 do NOT disappear after the wide era the way M47/L47
|
||||
# do -- they continue past 2011 as their OWN independent leaf line item
|
||||
# (is_aggregate = FALSE) alongside M91-93/L91-93, which is fine because a
|
||||
# non-aggregate M89/L89 no longer represents a rollup of those codes.
|
||||
# (Verified in the fixture: M89/L89 are is_aggregate = TRUE only in 2011,
|
||||
# when M91-93/L91-93 don't exist yet; from 2012 on M89/L89 are
|
||||
# is_aggregate = FALSE leaves coexisting with M91-93/L91-93.)
|
||||
#
|
||||
# Pairs are the M/L-prefixed components (this package's ig_long only
|
||||
# covers M/L; other prefixes in the same rollup, e.g. N/O/P/Q/R, fall
|
||||
# outside its domain and are irrelevant here) enumerated in
|
||||
# cog_pipeline's data/wide_to_long_xwalk.csv `full_desc` column (read
|
||||
# once at authoring time, not at test time -- this test stays offline):
|
||||
# M47 "To local governments, total (includes N47, O47, P47, R47, and M94)"
|
||||
# M89 "To local governments, total (incl N89, O89, P89, R89, M91, M92, and M93)"
|
||||
# L47 "To state government (includes L94)"
|
||||
# L89 "To state government (includes L91, L92, and L93)"
|
||||
con <- .ensure_session()
|
||||
pairs <- list(
|
||||
list(aggregate = "M47", components = "M94"),
|
||||
list(aggregate = "M89", components = c("M91", "M92", "M93")),
|
||||
list(aggregate = "L47", components = "L94"),
|
||||
list(aggregate = "L89", components = c("L91", "L92", "L93"))
|
||||
)
|
||||
agg_years_by_code <- DBI::dbGetQuery(con,
|
||||
"SELECT DISTINCT year, item_code FROM ig_long WHERE is_aggregate")
|
||||
codes_by_year <- DBI::dbGetQuery(con, "SELECT DISTINCT year, item_code FROM ig_long")
|
||||
|
||||
for (p in pairs) {
|
||||
agg_years <- agg_years_by_code$year[agg_years_by_code$item_code == p$aggregate]
|
||||
for (yr in agg_years) {
|
||||
codes_yr <- codes_by_year$item_code[codes_by_year$year == yr]
|
||||
has_component <- any(p$components %in% codes_yr)
|
||||
expect_false(
|
||||
has_component,
|
||||
label = sprintf(
|
||||
"year %s has aggregate-flagged %s co-occurring with a modern component (%s)",
|
||||
yr, p$aggregate, paste(p$components, collapse = ",")
|
||||
)
|
||||
)
|
||||
}
|
||||
}
|
||||
})
|
||||
|
||||
test_that(".verb_spendrev rejects expenditure_concept = 'total' for a non-spending view_base", {
|
||||
# cog_revenue() never exposes expenditure_concept and always resolves it
|
||||
# to the "direct" default, so there is no revenue codepath that reaches
|
||||
# this today -- but .verb_spendrev() is shared, and nothing else stops a
|
||||
# future caller from passing expenditure_concept = "total" alongside
|
||||
# view_base = "revenue_annotated", which would UNION expenditure M/L rows
|
||||
# into a revenue result. Exercise the internal helper directly.
|
||||
expect_error(
|
||||
uscogdata:::.verb_spendrev(
|
||||
verb = "cog_revenue_test", view_base = "revenue_annotated",
|
||||
subtype_col = "revenue_subtype",
|
||||
flow_prefixes = c("T", "A", "U", "B", "C", "D"),
|
||||
call = quote(cog_revenue_test()),
|
||||
govid = "010000226085", years = 2019L, category = NULL,
|
||||
per_capita = FALSE, adjust_to_year = NULL, basis = "raw",
|
||||
recipe = NULL, expenditure_concept = "total"
|
||||
),
|
||||
class = "uscogdata_expenditure_concept_unsupported"
|
||||
)
|
||||
})
|
||||
|
||||
test_that("cog_geographic_rollup refuses expenditure_concept = 'total'", {
|
||||
expect_error(
|
||||
cog_geographic_rollup(
|
||||
govids = list(state = "010000226085"),
|
||||
category = "Police", years = 2019,
|
||||
expenditure_concept = "total"
|
||||
),
|
||||
class = "uscogdata_concept_not_aggregatable"
|
||||
)
|
||||
})
|
||||
|
||||
test_that("cog_peer_compare refuses expenditure_concept = 'total'", {
|
||||
expect_error(
|
||||
cog_peer_compare(
|
||||
target_govid = "010000226085", peers = "010000226085",
|
||||
category = "Police", years = 2019,
|
||||
expenditure_concept = "total"
|
||||
),
|
||||
class = "uscogdata_concept_not_aggregatable"
|
||||
)
|
||||
})
|
||||
|
||||
test_that("the refusal message names the fix and the reason", {
|
||||
err <- tryCatch(
|
||||
cog_geographic_rollup(govids = list(state = "010000226085"),
|
||||
category = "Police", years = 2019,
|
||||
expenditure_concept = "total"),
|
||||
condition = function(e) e
|
||||
)
|
||||
msg <- paste(conditionMessage(err), collapse = " ")
|
||||
expect_match(msg, "direct")
|
||||
expect_match(msg, "double-count|double count")
|
||||
expect_match(msg, "cog_geographic_rollup")
|
||||
|
||||
# Test that cog_peer_compare's message names its own function
|
||||
err2 <- tryCatch(
|
||||
cog_peer_compare(target_govid = "010000226085", peers = "010000226085",
|
||||
category = "Police", years = 2019,
|
||||
expenditure_concept = "total"),
|
||||
condition = function(e) e
|
||||
)
|
||||
msg2 <- paste(conditionMessage(err2), collapse = " ")
|
||||
expect_match(msg2, "direct")
|
||||
expect_match(msg2, "double-count|double count")
|
||||
expect_match(msg2, "cog_peer_compare")
|
||||
})
|
||||
|
||||
test_that("both cross-government verbs still accept the direct default", {
|
||||
expect_no_error(
|
||||
cog_geographic_rollup(govids = list(state = "010000226085"),
|
||||
category = "Police", years = 2019)
|
||||
)
|
||||
expect_no_error(
|
||||
cog_peer_compare(target_govid = "010000226085", peers = "010000226085",
|
||||
category = "Police", years = 2019)
|
||||
)
|
||||
})
|
||||
|
||||
test_that("provenance always records the expenditure concept", {
|
||||
d <- cog_spending("010000226085", years = 2019, category = "Police")
|
||||
t <- cog_spending("010000226085", years = 2019, category = "Police",
|
||||
expenditure_concept = "total")
|
||||
expect_equal(attr(d, "provenance")$expenditure_concept, "direct")
|
||||
expect_equal(attr(t, "provenance")$expenditure_concept, "total")
|
||||
# The note explains the non-obvious part: how legacy IG was assembled.
|
||||
expect_true(nzchar(attr(t, "provenance")$expenditure_concept_note))
|
||||
expect_true(is.na(attr(d, "provenance")$expenditure_concept_note) ||
|
||||
!nzchar(attr(d, "provenance")$expenditure_concept_note))
|
||||
})
|
||||
|
||||
test_that("the provenance schema documents expenditure_concept", {
|
||||
sch <- jsonlite::fromJSON(
|
||||
system.file("schemas", "provenance-v1.json", package = "uscogdata"),
|
||||
simplifyVector = FALSE
|
||||
)
|
||||
expect_true("expenditure_concept" %in% names(sch$properties))
|
||||
})
|
||||
|
||||
test_that("a firing suggestion names the intergovernmental counterpart recipe", {
|
||||
# Corrections has no legacy leaf rows, so the coverage-gap suggestion fires;
|
||||
# corrections_ig_local_combined is its IG counterpart.
|
||||
r <- suppressMessages(
|
||||
cog_spending("010000226085", years = c(2005, 2011), category = "Corrections")
|
||||
)
|
||||
sugg <- attr(r, "provenance")$suggestions
|
||||
expect_gt(length(sugg), 0L)
|
||||
ids <- vapply(sugg, function(s) s$recipe_id %||% "", character(1))
|
||||
expect_true("corrections_combined" %in% ids)
|
||||
ig <- unlist(lapply(sugg, function(s) s$ig_recipe_id))
|
||||
expect_true("corrections_ig_local_combined" %in% ig)
|
||||
})
|
||||
|
||||
test_that("no suggestion fires for a healthy query", {
|
||||
r <- cog_spending("010000226085", years = 2019, category = "Police")
|
||||
expect_length(attr(r, "provenance")$suggestions, 0L)
|
||||
})
|
||||
|
||||
test_that("a mis-scoped cog_spending() call never attaches an M/L counterpart to a revenue-flavored recipe", {
|
||||
# "IG Federal" is a revenue-only category (summary_categories maps it to
|
||||
# B-prefixed component codes only; its recipes are ig_federal_b47_wide /
|
||||
# ig_federal_b89_wide). A cog_spending() call scoped to it returns zero
|
||||
# spending rows for every requested year -- there is no spending
|
||||
# component in this category at all -- so the coverage-gap machinery
|
||||
# fires for real (not hypothetically) even though this isn't the kind of
|
||||
# format-boundary gap the recipe catalog is meant to signpost. This is
|
||||
# exactly the live-corpus risk flagged in review: ig_federal_b47_wide's
|
||||
# own component codes (B47/B94, suffixes {"47","94"}) are an EXACT
|
||||
# suffix-set match for the expenditure recipe ige_local_m47_wide
|
||||
# (M47/M94, same suffixes) -- a coincidence of reused digits, not a real
|
||||
# Direct/Total pairing. The flow-family gate in
|
||||
# .attach_ig_counterparts() must keep ig_recipe_id NULL here.
|
||||
r <- suppressMessages(
|
||||
cog_spending("010000226085", years = c(2005, 2011), category = "IG Federal")
|
||||
)
|
||||
sugg <- attr(r, "provenance")$suggestions
|
||||
expect_gt(length(sugg), 0L)
|
||||
ids <- vapply(sugg, function(s) s$recipe_id %||% "", character(1))
|
||||
expect_true("ig_federal_b47_wide" %in% ids)
|
||||
ig <- unlist(lapply(sugg, function(s) s$ig_recipe_id))
|
||||
expect_length(ig, 0L)
|
||||
})
|
||||
|
||||
test_that("C1: 'total' on a legacy aggregate-only family reports the IG-only figure honestly, not as Direct + IG", {
|
||||
# AL state government, Corrections, 2011. Measured pre-fix: 'total'
|
||||
# returned $31,358,000 (the IG leg alone, on an aggregate-flagged M04/M05
|
||||
# row) with 0 suggestions (the surviving IG row made the gap-detection
|
||||
# machinery think the Direct leg was covered) and a note asserting
|
||||
# "Total = Direct + intergovernmental" with no caveat. True Direct (via
|
||||
# recipe = "corrections_combined") is $521,651,000 -- the IG-only figure
|
||||
# is ~6% of it.
|
||||
gov <- "010000226085"
|
||||
|
||||
d <- cog_spending(gov, years = 2011, category = "Corrections",
|
||||
expenditure_concept = "direct")
|
||||
expect_equal(nrow(d), 0L)
|
||||
|
||||
t <- suppressMessages(cog_spending(
|
||||
gov, years = 2011, category = "Corrections", expenditure_concept = "total"
|
||||
))
|
||||
expect_equal(nrow(t), 1L)
|
||||
expect_equal(t$spend_subtype, "intergovernmental")
|
||||
expect_equal(t$amt_nominal, 31358000)
|
||||
|
||||
r <- cog_spending(gov, years = 2011, recipe = "corrections_combined")
|
||||
expect_equal(r$amt_nominal, 521651000)
|
||||
|
||||
# C1(a): the recipe hints must fire for "total" exactly as they do for
|
||||
# "direct" -- the surviving IG row must not be mistaken for Direct
|
||||
# coverage.
|
||||
prov <- attr(t, "provenance")
|
||||
expect_gt(length(prov$suggestions), 0L)
|
||||
ids <- vapply(prov$suggestions, function(s) s$recipe_id %||% "", character(1))
|
||||
expect_true("corrections_combined" %in% ids)
|
||||
|
||||
# C1(b): the affected row's notes name a recovering recipe rather than
|
||||
# staying silent, and the provenance carries a flag a downstream consumer
|
||||
# (e.g. cog-api, which passes provenance through verbatim) can test.
|
||||
expect_true(nzchar(t$notes))
|
||||
expect_match(t$notes, "unavailable", fixed = TRUE)
|
||||
expect_match(t$notes, "corrections_combined", fixed = TRUE)
|
||||
expect_true(prov$expenditure_concept_direct_suppressed)
|
||||
|
||||
# The base "Total = Direct + IG" note must NOT stand unqualified when that
|
||||
# arithmetic didn't actually happen for this row.
|
||||
expect_match(prov$expenditure_concept_note, "NOTE", fixed = TRUE)
|
||||
expect_match(prov$expenditure_concept_note,
|
||||
"expenditure_concept_direct_suppressed", fixed = TRUE)
|
||||
})
|
||||
|
||||
test_that("C1(b): expenditure_concept_direct_suppressed is FALSE when the Direct leg is present", {
|
||||
d <- cog_spending("010000226085", years = 2019, category = "Police",
|
||||
expenditure_concept = "direct")
|
||||
t <- cog_spending("010000226085", years = 2019, category = "Police",
|
||||
expenditure_concept = "total")
|
||||
expect_false(isTRUE(attr(d, "provenance")$expenditure_concept_direct_suppressed))
|
||||
expect_false(isTRUE(attr(t, "provenance")$expenditure_concept_direct_suppressed))
|
||||
expect_false(any(nzchar(t$notes[t$spend_subtype == "intergovernmental"]) &
|
||||
grepl("unavailable", t$notes[t$spend_subtype == "intergovernmental"])))
|
||||
})
|
||||
|
||||
# M/I fix: .detect_direct_suppressed() was equating "no Direct sibling row"
|
||||
# with "Direct was suppressed", but the dominant real cause is a government
|
||||
# that simply has no direct spending in that category -- correct, ordinary
|
||||
# data. The fix gates the flag (and its row note) on a harmonization recipe
|
||||
# ACTUALLY covering that exact (year, canonical_govid, category) triple.
|
||||
|
||||
test_that("M/I: true positive, category supplied explicitly (unchanged behavior)", {
|
||||
al <- "010000226085"
|
||||
t_cat <- suppressMessages(cog_spending(
|
||||
al, years = 2011, category = "Corrections", expenditure_concept = "total"
|
||||
))
|
||||
expect_true(attr(t_cat, "provenance")$expenditure_concept_direct_suppressed)
|
||||
expect_match(t_cat$notes, "corrections_combined", fixed = TRUE)
|
||||
expect_match(t_cat$notes, "unavailable", fixed = TRUE)
|
||||
})
|
||||
|
||||
test_that("M/I: true positive, category = NULL now also names the recipe (was the fallback bug)", {
|
||||
# Root bug: .build_suggestions() short-circuits to list() when category is
|
||||
# NULL, so the note previously always hit its "no covering recipe found"
|
||||
# fallback here even though corrections_combined genuinely covers this row.
|
||||
al <- "010000226085"
|
||||
t_null <- suppressMessages(cog_spending(
|
||||
al, years = 2011, category = NULL, expenditure_concept = "total"
|
||||
))
|
||||
corr_row <- t_null[t_null$category %in% "Corrections", ]
|
||||
expect_equal(nrow(corr_row), 1L)
|
||||
expect_true(attr(t_null, "provenance")$expenditure_concept_direct_suppressed)
|
||||
expect_match(corr_row$notes, "corrections_combined", fixed = TRUE)
|
||||
expect_match(corr_row$notes, "unavailable", fixed = TRUE)
|
||||
expect_false(grepl("no covering recipe found", corr_row$notes, fixed = TRUE))
|
||||
})
|
||||
|
||||
test_that("M/I: false positive -- Virginia Education K-12 FY2019 total is NOT flagged", {
|
||||
# States fund K-12 through school districts, so the Direct leg (E12/F12/
|
||||
# G12) is genuinely, correctly zero -- not suppressed. Must not be flagged
|
||||
# and must carry no suppression note.
|
||||
va <- "510000227542"
|
||||
t_va <- suppressMessages(cog_spending(
|
||||
va, years = 2019, category = "Education K-12", expenditure_concept = "total"
|
||||
))
|
||||
expect_equal(nrow(t_va), 1L)
|
||||
expect_equal(t_va$spend_subtype, "intergovernmental")
|
||||
expect_equal(t_va$amt_nominal, 8028179000)
|
||||
expect_false(isTRUE(attr(t_va, "provenance")$expenditure_concept_direct_suppressed))
|
||||
expect_false(nzchar(t_va$notes) && grepl("unavailable", t_va$notes))
|
||||
})
|
||||
|
||||
test_that("M/I: false positive by construction -- 'Other Education' has no E/F/G code, never flagged", {
|
||||
# "Other Education" maps only to M21/L21 in summary_categories -- there is
|
||||
# no E/F/G code for it in this corpus at all, so no Direct-recovering
|
||||
# recipe can exist and it must never be flagged, in any fixture year.
|
||||
con <- uscogdata:::.ensure_session()
|
||||
years_all <- DBI::dbGetQuery(con, "SELECT DISTINCT year FROM long ORDER BY year")$year
|
||||
states <- DBI::dbGetQuery(con,
|
||||
"SELECT DISTINCT canonical_govid FROM long WHERE type = 0")$canonical_govid
|
||||
oe <- suppressMessages(cog_spending(
|
||||
states, years = years_all, category = "Other Education",
|
||||
expenditure_concept = "total"
|
||||
))
|
||||
expect_false(isTRUE(attr(oe, "provenance")$expenditure_concept_direct_suppressed))
|
||||
expect_false(any(nzchar(oe$notes) & grepl("unavailable", oe$notes)))
|
||||
})
|
||||
|
||||
test_that("M/I: a clean FY2019 category = NULL total query flags far fewer than the pre-fix 32/50 states", {
|
||||
con <- uscogdata:::.ensure_session()
|
||||
states <- DBI::dbGetQuery(con,
|
||||
"SELECT DISTINCT canonical_govid FROM long WHERE type = 0")$canonical_govid
|
||||
r <- suppressMessages(cog_spending(
|
||||
states, years = 2019, category = NULL, expenditure_concept = "total"
|
||||
))
|
||||
ig <- r[r$spend_subtype == "intergovernmental", ]
|
||||
flagged <- ig[nzchar(ig$notes) & grepl("unavailable", ig$notes), ]
|
||||
expect_lt(length(unique(flagged$canonical_govid)), 32L)
|
||||
# Every remaining flagged row must actually name a covering recipe --
|
||||
# never the old no-recipe-found fallback.
|
||||
expect_true(all(grepl("recipe = '", flagged$notes, fixed = TRUE)))
|
||||
expect_false(any(grepl("no covering recipe found", flagged$notes, fixed = TRUE)))
|
||||
})
|
||||
|
||||
test_that("C2: expenditure_concept = 'total' aborts on a corpus with no intergovernmental category rows", {
|
||||
with_corpus_missing_ig_categories({
|
||||
con <- uscogdata:::.ensure_session()
|
||||
n <- DBI::dbGetQuery(con,
|
||||
"SELECT COUNT(*) AS n FROM summary_categories WHERE LEFT(item_code, 1) IN ('M', 'L')"
|
||||
)$n
|
||||
expect_equal(n, 0)
|
||||
|
||||
err <- tryCatch(
|
||||
cog_spending("010000226085", years = 2019, category = "Police",
|
||||
expenditure_concept = "total"),
|
||||
condition = function(e) e
|
||||
)
|
||||
expect_s3_class(err, "uscogdata_ig_categories_unsupported")
|
||||
msg <- conditionMessage(err)
|
||||
expect_match(msg, "PR #59|predates", perl = TRUE)
|
||||
})
|
||||
|
||||
# 'direct' is unaffected on the same corpus -- the guard is scoped to
|
||||
# expenditure_concept = "total" only.
|
||||
with_corpus_missing_ig_categories({
|
||||
expect_no_error(
|
||||
cog_spending("010000226085", years = 2019, category = "Police",
|
||||
expenditure_concept = "direct")
|
||||
)
|
||||
})
|
||||
})
|
||||
|
||||
test_that("C2: expenditure_concept = 'total' still works on a corpus that DOES carry M/L category rows", {
|
||||
expect_no_error(
|
||||
cog_spending("010000226085", years = 2019, category = "Police",
|
||||
expenditure_concept = "total")
|
||||
)
|
||||
})
|
||||
|
||||
test_that("I2: an intergovernmental (M/L) recipe never appears as its own top-level suggestion", {
|
||||
# Task 1's M04/M05 category rows share the "Corrections" summary_categories
|
||||
# category with the Direct-flavored E04/E05, so `corrections_ig_local_
|
||||
# combined` (entirely M-prefixed) becomes a raw *candidate* in
|
||||
# .build_suggestions()'s component_code-driven query. Following a
|
||||
# "re-run with recipe = 'corrections_ig_local_combined'" hint on a plain
|
||||
# cog_spending() call would silently return intergovernmental dollars
|
||||
# under provenance$expenditure_concept = "direct". Task 6's gate
|
||||
# (.attach_ig_counterparts()) already protects the *counterpart* lookup;
|
||||
# this exercises that the candidate list itself is filtered too.
|
||||
r <- suppressMessages(
|
||||
cog_spending("010000226085", years = c(2005, 2011), category = "Corrections")
|
||||
)
|
||||
sugg <- attr(r, "provenance")$suggestions
|
||||
ids <- vapply(sugg, function(s) s$recipe_id %||% "", character(1))
|
||||
expect_true("corrections_combined" %in% ids)
|
||||
expect_false("corrections_ig_local_combined" %in% ids)
|
||||
})
|
||||
|
||||
test_that(".attach_ig_counterparts() never pairs a revenue-side recipe with its coincidental M/L suffix twin", {
|
||||
# Broader version of the case above, run at the matching-helper level
|
||||
# (the same level code review's pairwise enumeration was done at) rather
|
||||
# than end-to-end: the fixture has no (govid, year) combination where
|
||||
# cog_revenue() itself produces a covered gap for any B/C/D recipe, so an
|
||||
# end-to-end repro for THIS specific set of recipes isn't reachable
|
||||
# today. Each of these six recipes shares an exact suffix set with an
|
||||
# M/L expenditure recipe purely by reused-digit coincidence:
|
||||
# ig_federal_b47_wide {"47","94"} == ige_local_m47_wide / ige_state_l47_wide
|
||||
# ig_federal_b89_wide {"89","91","92","93"} == ige_local_m89_wide / ige_state_l89_wide
|
||||
# ig_state_c47_wide {"47","94"} == ige_local_m47_wide / ige_state_l47_wide
|
||||
# ig_state_c89_wide {"89","91","92","93"} == ige_local_m89_wide / ige_state_l89_wide
|
||||
# ig_local_d47_wide {"47","94"} == ige_local_m47_wide / ige_state_l47_wide
|
||||
# ig_local_d89_wide {"89","91","92","93"} == ige_local_m89_wide / ige_state_l89_wide
|
||||
# None of them may receive an ig_recipe_id under cog_revenue()'s own
|
||||
# flow_prefixes, since M/L only ever pairs with the direct-expenditure
|
||||
# (E/F/G) family.
|
||||
con <- uscogdata:::.ensure_session()
|
||||
fake_suggestion <- function(rid) {
|
||||
list(recipe_id = rid, label = "x", available_years = c(1967L, 2023L),
|
||||
hint = "h")
|
||||
}
|
||||
fake_suggestions <- lapply(
|
||||
c("ig_federal_b47_wide", "ig_federal_b89_wide",
|
||||
"ig_state_c47_wide", "ig_state_c89_wide",
|
||||
"ig_local_d47_wide", "ig_local_d89_wide"),
|
||||
fake_suggestion
|
||||
)
|
||||
out <- uscogdata:::.attach_ig_counterparts(
|
||||
con, fake_suggestions, c("T", "A", "U", "B", "C", "D")
|
||||
)
|
||||
ig <- unlist(lapply(out, function(s) s$ig_recipe_id))
|
||||
expect_length(ig, 0L)
|
||||
})
|
||||
@@ -70,37 +70,6 @@ test_that("cog_explain prints a Suggestions section when the provenance has one"
|
||||
expect_true(grepl("re-run with recipe", txt))
|
||||
})
|
||||
|
||||
test_that("cog_explain prints the expenditure concept (I1)", {
|
||||
skip_if_no_corpus()
|
||||
d <- cog_spending("010000226085", years = 2019, category = "Police")
|
||||
t <- cog_spending("010000226085", years = 2019, category = "Police",
|
||||
expenditure_concept = "total")
|
||||
txt_d <- paste(c(
|
||||
capture.output(cog_explain(d)),
|
||||
capture.output(cog_explain(d), type = "message")
|
||||
), collapse = "\n")
|
||||
txt_t <- paste(c(
|
||||
capture.output(cog_explain(t)),
|
||||
capture.output(cog_explain(t), type = "message")
|
||||
), collapse = "\n")
|
||||
expect_true(grepl("Concept: direct", txt_d))
|
||||
expect_true(grepl("Concept: total", txt_t))
|
||||
})
|
||||
|
||||
test_that("cog_explain surfaces the C1(b) direct-suppressed flag as a warning", {
|
||||
skip_if_no_corpus()
|
||||
t <- suppressMessages(cog_spending(
|
||||
"010000226085", years = 2011, category = "Corrections",
|
||||
expenditure_concept = "total"
|
||||
))
|
||||
expect_true(attr(t, "provenance")$expenditure_concept_direct_suppressed)
|
||||
txt <- paste(c(
|
||||
capture.output(cog_explain(t)),
|
||||
capture.output(cog_explain(t), type = "message")
|
||||
), collapse = "\n")
|
||||
expect_true(grepl("Direct leg unavailable", txt))
|
||||
})
|
||||
|
||||
test_that("cog_explain prints denominator + popyear_range + counts", {
|
||||
skip_if_no_corpus()
|
||||
with_fixture_corpus({
|
||||
|
||||
@@ -176,6 +176,16 @@ test_that("recipe = requires schema_version >= 5", {
|
||||
})
|
||||
|
||||
# --- signposting -------------------------------------------------------
|
||||
#
|
||||
# Phase R3 / Task 19c: .build_suggestions() was narrowed from a whole-result
|
||||
# gap check (R2: does the ENTIRE category result have zero rows in a
|
||||
# requested year) to per-code gap detection (does a specific recipe
|
||||
# component -- itself a member of the requested category -- have zero rows
|
||||
# in a year the recipe's own generic join otherwise covers). See
|
||||
# R/suggestions.R's header comment and docs/phase_r_harmonization_review.md
|
||||
# § 0.3. The R2 test below ("...across the 2011->2012 gap") is unaffected
|
||||
# by the refinement (it already passed under both the coarse and per-code
|
||||
# rule). The next few pin cases the coarse rule specifically could NOT see.
|
||||
|
||||
test_that("signposting suggests corrections_combined across the 2011->2012 gap", {
|
||||
skip_if_no_corpus()
|
||||
@@ -193,10 +203,96 @@ test_that("signposting suggests corrections_combined across the 2011->2012 gap",
|
||||
expect_equal(hit$available_years, c(1967L, 2023L))
|
||||
})
|
||||
|
||||
test_that("no signposting when the result already has full year coverage", {
|
||||
test_that("per-code gap does NOT fire when a code's only coverage is its own aggregate row (self-coverage is not \"other components\")", {
|
||||
skip_if_no_corpus()
|
||||
# Broward, FY2011 ONLY (isolating the 2011 half of the query above): E05,
|
||||
# F05, and G05 each report SOLELY as a wide-era AGGREGATE row that year
|
||||
# (216088, 1453, 270 respectively); E04/F04/G04 -- their modern-only
|
||||
# siblings -- don't exist as codes at all before 2012, corpus-wide (zero
|
||||
# rows for any government). Each component's own aggregate row would
|
||||
# trivially satisfy a same-component "covered" check, but review-doc
|
||||
# § 0.3's criterion is explicit that a gap must be covered by "OTHER
|
||||
# components", not the gapped component's own aggregate form. With no
|
||||
# OTHER component present for any of the three Corrections recipes in
|
||||
# 2011, none of them should fire -- this is what the combined
|
||||
# 2011-2012 test above actually relies on 2012 (E05 gapped, E04 -- a
|
||||
# genuinely different component -- covers) to fire, not 2011.
|
||||
r <- cog_spending("121011212191", years = 2011L, category = "Corrections")
|
||||
prov <- attr(r, "provenance")
|
||||
expect_length(prov$suggestions, 0L)
|
||||
})
|
||||
|
||||
test_that("per-code gap fires even when a sibling code masks the whole-result check (Cleburne County, FY2012)", {
|
||||
skip_if_no_corpus()
|
||||
# Cleburne County, AL (canonical_govid 011029122489), FY2012: E04 ($854)
|
||||
# and E05 ($1) both report ("operations" subtype), and G04 ($14,000,
|
||||
# corrections_other_capital_combined's modern-only leg) also reports
|
||||
# ("capital" subtype) -- so the WHOLE category result is non-empty for
|
||||
# 2012 (2 rows) and the R2 whole-result check would never look further.
|
||||
# But G05 -- G04's OWN recipe sibling, the 1967-2023 wide leg -- has
|
||||
# ZERO rows at all that year: a genuine, per-code gap the recipe exists
|
||||
# to bridge, invisible at the category-result grain because it's masked
|
||||
# by G04's own data, let alone the unrelated E04/E05 pair.
|
||||
r <- cog_spending("011029122489", years = 2012L, category = "Corrections")
|
||||
expect_equal(nrow(r), 2L) # operations + capital rows: a non-empty result
|
||||
|
||||
prov <- attr(r, "provenance")
|
||||
ids <- vapply(prov$suggestions, function(s) s$recipe_id, character(1))
|
||||
expect_true("corrections_other_capital_combined" %in% ids)
|
||||
hit <- prov$suggestions[[which(ids == "corrections_other_capital_combined")]]
|
||||
expect_equal(hit$hint, "re-run with recipe = 'corrections_other_capital_combined'")
|
||||
expect_equal(hit$available_years, c(1967L, 2023L))
|
||||
|
||||
# corrections_combined must NOT fire: E04 AND E05 both have real 2012
|
||||
# data for this government, so neither of ITS OWN components is gapped.
|
||||
expect_false("corrections_combined" %in% ids)
|
||||
})
|
||||
|
||||
test_that("per-code gap does not fire when no recipe component has any data at all (ordinary reporting variance, not a format-boundary gap)", {
|
||||
skip_if_no_corpus()
|
||||
# Same government/year as above: F04 and F05 (corrections_capital_combined)
|
||||
# are BOTH completely absent -- Cleburne simply never reported capital
|
||||
# corrections spending under that code family in 2012, wide-era or
|
||||
# modern. The recipe's own generic join (aggregate-inclusive, either
|
||||
# component) has nothing to offer either, so this must stay silent --
|
||||
# the per-government `covered` guard the header comment describes is
|
||||
# unchanged and still does this filtering.
|
||||
r <- cog_spending("011029122489", years = 2012L, category = "Corrections")
|
||||
prov <- attr(r, "provenance")
|
||||
ids <- vapply(prov$suggestions, function(s) s$recipe_id, character(1))
|
||||
expect_false("corrections_capital_combined" %in% ids)
|
||||
})
|
||||
|
||||
test_that("per-code gap fires for Broward 2019-2020 even though the category result looks complete", {
|
||||
skip_if_no_corpus()
|
||||
# Broward reports E04 + G04 (modern leaf codes) in BOTH 2019 and 2020 but
|
||||
# never reports E05 or G05 (their own recipe siblings) in either year --
|
||||
# a real per-code gap in two of the three Corrections recipes, invisible
|
||||
# under the R2 coarse check because the category *result* is non-empty
|
||||
# both years (this replaces the old R2-era "full year coverage" test,
|
||||
# whose premise -- that a non-empty result implies nothing to signpost --
|
||||
# is exactly what this refinement narrows; see data-raw/
|
||||
# measure_signposting_rate.R for the measured rate change this causes).
|
||||
# corrections_capital_combined correctly stays silent: Broward reports
|
||||
# neither F04 nor F05 in 2019 or 2020, so that recipe's own join has
|
||||
# nothing to offer either (ordinary non-reporting, not a format-boundary
|
||||
# gap) -- the per-government `covered` guard still does its job here too.
|
||||
r <- cog_spending("121011212191", years = 2019:2020, category = "Corrections")
|
||||
prov <- attr(r, "provenance")
|
||||
ids <- vapply(prov$suggestions, function(s) s$recipe_id, character(1))
|
||||
expect_true("corrections_combined" %in% ids)
|
||||
expect_true("corrections_other_capital_combined" %in% ids)
|
||||
expect_false("corrections_capital_combined" %in% ids)
|
||||
})
|
||||
|
||||
test_that("no signposting when every recipe component genuinely has data (true full per-code coverage)", {
|
||||
skip_if_no_corpus()
|
||||
# Maricopa County, AZ (canonical_govid 041013160815): all six Corrections
|
||||
# codes (E04, E05, F04, F05, G04, G05) report real, nonzero, non-aggregate
|
||||
# amounts in BOTH 2019 and 2020 -- genuinely nothing for any recipe to
|
||||
# fill, even at the finer per-code grain this refinement now checks.
|
||||
r <- cog_spending("041013160815", years = 2019:2020, category = "Corrections")
|
||||
prov <- attr(r, "provenance")
|
||||
expect_length(prov$suggestions, 0L)
|
||||
})
|
||||
|
||||
|
||||
@@ -0,0 +1,164 @@
|
||||
# tests/testthat/test-signposting-harness.R
|
||||
#
|
||||
# Pins the subset-relation REPORTING in data-raw/measure_signposting_rate.R.
|
||||
#
|
||||
# Phase R3 Task 19c narrowed signposting from a coarse whole-result gap
|
||||
# check to per-code gap detection. Those two checks are partly DISJOINT,
|
||||
# not nested: a query can fire under coarse and stay silent under per-code,
|
||||
# so the harness's `*_delta_pp` figures are NETS that can hide a coverage
|
||||
# loss. `.measure_subset_relation()` is what separates the two flows, and
|
||||
# `.measure_format_subset_report()` is what puts the loss in front of a
|
||||
# human. Both are load-bearing for the Checkpoint R3 ruling, so both are
|
||||
# pinned here: if the violation detection is deleted, inverted, or quietly
|
||||
# downgraded to a count with no identities, these tests fail.
|
||||
#
|
||||
# These tests do NOT assert that the violation set is empty -- it is
|
||||
# genuinely non-empty, and asserting otherwise would be pinning a bug as a
|
||||
# contract. They assert only that a real violation is DETECTED and NAMED.
|
||||
|
||||
# The harness lives in data-raw/, which is .Rbuildignore'd, so it is absent
|
||||
# from an installed/checked tarball. Source it into an env parented on the
|
||||
# namespace so it resolves the package internals it calls (.build_verb_sql,
|
||||
# .build_suggestions) exactly as it does when run for real.
|
||||
harness_env <- function() {
|
||||
path <- testthat::test_path("..", "..", "data-raw", "measure_signposting_rate.R")
|
||||
skip_if_not(file.exists(path),
|
||||
"data-raw/ is .Rbuildignore'd; harness not present in this tree")
|
||||
env <- new.env(parent = asNamespace("uscogdata"))
|
||||
source(path, local = env)
|
||||
env
|
||||
}
|
||||
|
||||
# A detail frame in exactly the shape .measure_one_query() emits, covering
|
||||
# all four quadrants of the coarse x percode cross-tab.
|
||||
fake_detail <- function() {
|
||||
data.frame(
|
||||
category = c("Corrections", "Other Taxes", "Police", "Fire"),
|
||||
category_type = c("expenditure", "revenue", "expenditure", "expenditure"),
|
||||
canonical_govid = c("121011212191", "472155175824", "011029122489",
|
||||
"041013160815"),
|
||||
n_result_rows = c(0L, 1L, 2L, 6L),
|
||||
coarse_gap_years = c("2011", "", "", ""),
|
||||
fired_coarse = c(TRUE, FALSE, TRUE, FALSE),
|
||||
fired_percode = c(FALSE, TRUE, TRUE, FALSE),
|
||||
coarse_recipes = c("corrections_combined", "", "police_combined", ""),
|
||||
percode_recipes = c("", "t29_license_wide", "police_combined", ""),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
test_that(".measure_subset_relation() separates coverage LOST from coverage ADDED", {
|
||||
e <- harness_env()
|
||||
rel <- e$.measure_subset_relation(fake_detail())
|
||||
|
||||
# Row 1 (coarse fired, per-code silent) is the violation; row 2 is the
|
||||
# addition; row 3 agrees; row 4 is silent.
|
||||
expect_false(rel$holds)
|
||||
expect_equal(rel$n_violations, 1L)
|
||||
expect_equal(rel$n_additions, 1L)
|
||||
expect_equal(rel$n_coarse_fired, 2L)
|
||||
expect_equal(rel$n_percode_fired, 2L)
|
||||
expect_equal(rel$n_both, 1L)
|
||||
expect_equal(rel$n_queries, 4L)
|
||||
|
||||
# The violation must be NAMED down to (category, government, year), not
|
||||
# merely counted -- that is what makes it inspectable at Checkpoint R3.
|
||||
expect_equal(rel$violations$category, "Corrections")
|
||||
expect_equal(rel$violations$canonical_govid, "121011212191")
|
||||
expect_equal(rel$violations$coarse_gap_years, "2011")
|
||||
expect_equal(rel$violations$coarse_recipes, "corrections_combined")
|
||||
|
||||
# Inversion guard: an implementation that swapped the two directions
|
||||
# would report the addition as a violation and vice versa.
|
||||
expect_false("Other Taxes" %in% rel$violations$category)
|
||||
expect_equal(rel$additions$category, "Other Taxes")
|
||||
expect_false("Corrections" %in% rel$additions$category)
|
||||
|
||||
# Agreeing and silent queries belong to neither set.
|
||||
expect_false("Police" %in% c(rel$violations$category, rel$additions$category))
|
||||
expect_false("Fire" %in% c(rel$violations$category, rel$additions$category))
|
||||
})
|
||||
|
||||
test_that(".measure_subset_relation() reports holds = TRUE only when nothing fires coarse-only", {
|
||||
e <- harness_env()
|
||||
# Drop the violating row: coarse is now genuinely a subset of per-code.
|
||||
clean <- fake_detail()[-1L, , drop = FALSE]
|
||||
rel <- e$.measure_subset_relation(clean)
|
||||
|
||||
expect_true(rel$holds)
|
||||
expect_equal(rel$n_violations, 0L)
|
||||
expect_equal(nrow(rel$violations), 0L)
|
||||
expect_equal(rel$n_additions, 1L)
|
||||
})
|
||||
|
||||
test_that(".measure_subset_relation() validates its input rather than silently mis-reporting", {
|
||||
e <- harness_env()
|
||||
expect_error(e$.measure_subset_relation("not a data frame"), "must be a data frame")
|
||||
expect_error(e$.measure_subset_relation(fake_detail()[, c("category", "canonical_govid")]),
|
||||
"fired_coarse")
|
||||
bad <- fake_detail()
|
||||
bad$fired_percode[1] <- NA
|
||||
expect_error(e$.measure_subset_relation(bad), "non-NA logicals")
|
||||
})
|
||||
|
||||
test_that("the subset report NAMES a coarse-only firing as a violation", {
|
||||
e <- harness_env()
|
||||
txt <- paste(e$.measure_format_subset_report(e$.measure_subset_relation(fake_detail())),
|
||||
collapse = "\n")
|
||||
|
||||
# Stated plainly as a violation, not buried.
|
||||
expect_match(txt, "VIOLATED")
|
||||
expect_match(txt, "COVERAGE LOST")
|
||||
expect_no_match(txt, "HOLDS")
|
||||
# ...and the offending query named, so a human can go look at it.
|
||||
expect_match(txt, "Corrections")
|
||||
expect_match(txt, "121011212191")
|
||||
expect_match(txt, "2011")
|
||||
# ...and the delta explicitly flagged as a net of both directions.
|
||||
expect_match(txt, "NET")
|
||||
})
|
||||
|
||||
test_that("the subset report says HOLDS when coarse really is a subset", {
|
||||
e <- harness_env()
|
||||
rel <- e$.measure_subset_relation(fake_detail()[-1L, , drop = FALSE])
|
||||
txt <- paste(e$.measure_format_subset_report(rel), collapse = "\n")
|
||||
|
||||
expect_match(txt, "HOLDS")
|
||||
expect_no_match(txt, "VIOLATED")
|
||||
expect_no_match(txt, "COVERAGE LOST")
|
||||
})
|
||||
|
||||
test_that("a REAL coarse-fires/per-code-silent query is measured and reported as a violation", {
|
||||
skip_if_no_corpus()
|
||||
# Broward County FY2011, Corrections: E05/F05/G05 report SOLELY as
|
||||
# wide-era aggregate rows, which basis = "harmonized" excludes, so the
|
||||
# whole category result is empty -- coarse's trigger. Their modern-only
|
||||
# siblings E04/F04/G04 do not exist as codes at all before 2012, so no
|
||||
# OTHER component can supply per-code's covering evidence and per-code
|
||||
# is structurally unable to fire. This is the disjointness the harness
|
||||
# exists to surface, measured end-to-end through the real git-loaded
|
||||
# coarse arm and the live per-code arm (not a hand-built frame).
|
||||
e <- harness_env()
|
||||
con <- uscogdata:::cog_open()
|
||||
row <- e$.measure_one_query(
|
||||
con,
|
||||
coarse_env = e$.measure_load_git_impl("b0df1ec"),
|
||||
selfcov_env = e$.measure_load_git_impl("da72bf3"),
|
||||
category = "Corrections", category_type = "expenditure",
|
||||
govid = "121011212191", years = 2011L
|
||||
)
|
||||
|
||||
expect_true(row$fired_coarse)
|
||||
expect_false(row$fired_percode)
|
||||
expect_equal(row$n_result_rows, 0L)
|
||||
expect_equal(row$coarse_gap_years, "2011")
|
||||
|
||||
rel <- e$.measure_subset_relation(row)
|
||||
expect_false(rel$holds)
|
||||
expect_equal(rel$n_violations, 1L)
|
||||
expect_equal(rel$violations$canonical_govid, "121011212191")
|
||||
|
||||
txt <- paste(e$.measure_format_subset_report(rel), collapse = "\n")
|
||||
expect_match(txt, "VIOLATED")
|
||||
expect_match(txt, "121011212191")
|
||||
})
|
||||
+1
-169
@@ -9,9 +9,7 @@ test_that("all expected views register on session open", {
|
||||
expected <- c(
|
||||
"long", "spending_long", "revenue_long",
|
||||
"canonical_fips_xwalk", "summary_categories",
|
||||
"spending_annotated", "revenue_annotated",
|
||||
"ig_long", "ig_annotated",
|
||||
"ig_long_harmonized", "ig_annotated_harmonized"
|
||||
"spending_annotated", "revenue_annotated"
|
||||
)
|
||||
expect_true(all(expected %in% views$table_name))
|
||||
})
|
||||
@@ -112,70 +110,6 @@ test_that("inst/sql/22- and 23- harmonized views enforce every WHERE predicate (
|
||||
expect_equal(rev$amt, 225)
|
||||
})
|
||||
|
||||
test_that("inst/sql/24- and 25- IG views retain aggregates, COALESCE NULL harmonized_code, and exclude the L-- family total (real SQL text, synthetic parquet)", {
|
||||
# ig_long / ig_long_harmonized have the subtlest predicates in the package:
|
||||
# a deliberately ABSENT `NOT is_aggregate` (unlike every other *_long view),
|
||||
# and COALESCE(harmonized_code, item_code) instead of a plain
|
||||
# `harmonized_code IS NOT NULL` filter. The only end-to-end guard on this
|
||||
# today is bound to AL state / 2011 / Education K-12, where M12 happens to
|
||||
# be the sole IG code present -- regenerate the fixture without that one
|
||||
# row and the guard would die silently while staying green. As with the
|
||||
# 22-/23- test above, this reads the real inst/sql/24-/25- text off disk
|
||||
# and executes it against a synthetic hive-partitioned parquet tree, so a
|
||||
# regression in either predicate changes which rows survive.
|
||||
skip_if_no_corpus()
|
||||
|
||||
tmp <- withr::local_tempdir()
|
||||
part_dir <- file.path(tmp, "data", "long", "year=2004")
|
||||
dir.create(part_dir, recursive = TRUE)
|
||||
part_path <- file.path(part_dir, "part-0.parquet")
|
||||
|
||||
write_con <- DBI::dbConnect(duckdb::duckdb())
|
||||
on.exit(DBI::dbDisconnect(write_con, shutdown = TRUE), add = TRUE)
|
||||
DBI::dbExecute(write_con, sprintf("
|
||||
COPY (
|
||||
SELECT * FROM (VALUES
|
||||
('ig-A', 'M04', 100, false, 'M04'), -- control: passes through as-is
|
||||
('ig-B', 'M38', 50, false, 'M36'), -- fold control: real SB012 rule, renamed to M36 under harmonized basis
|
||||
('ig-C', 'M47', 99999, true, NULL), -- legacy aggregate, NO harmonized_code: must survive BOTH views
|
||||
('ig-D', 'L--', 55555, false, 'L--'), -- family total: excluded from BOTH views
|
||||
('ig-E', 'T29', 44444, false, 'T29') -- wrong prefix (revenue, not M/L): excluded from BOTH views
|
||||
) AS t(canonical_govid, item_code, amt, is_aggregate, harmonized_code)
|
||||
) TO %s (FORMAT PARQUET)
|
||||
", uscogdata:::.sql_lit_chr(part_path)))
|
||||
|
||||
sql_dir <- system.file("sql", package = "uscogdata")
|
||||
.read_view_sql <- function(filename) {
|
||||
txt <- paste(readLines(file.path(sql_dir, filename), warn = FALSE), collapse = "\n")
|
||||
gsub("\\{url\\}", paste0(tmp, "/"), txt, fixed = FALSE)
|
||||
}
|
||||
|
||||
con <- DBI::dbConnect(duckdb::duckdb())
|
||||
on.exit(DBI::dbDisconnect(con, shutdown = TRUE), add = TRUE)
|
||||
DBI::dbExecute(con, .read_view_sql("10-long.sql"))
|
||||
DBI::dbExecute(con, .read_view_sql("24-ig_long.sql"))
|
||||
DBI::dbExecute(con, .read_view_sql("25-ig_long_harmonized.sql"))
|
||||
|
||||
raw <- DBI::dbGetQuery(con,
|
||||
"SELECT item_code, SUM(amt) AS amt FROM ig_long
|
||||
GROUP BY item_code ORDER BY item_code"
|
||||
)
|
||||
# L-- (family total) and T29 (wrong prefix) are gone; the aggregate row
|
||||
# M47 survives -- proof `NOT is_aggregate` is absent from ig_long.
|
||||
expect_equal(raw$item_code, c("M04", "M38", "M47"))
|
||||
expect_equal(raw$amt, c(100, 50, 99999))
|
||||
|
||||
harmonized <- DBI::dbGetQuery(con,
|
||||
"SELECT item_code, SUM(amt) AS amt FROM ig_long_harmonized
|
||||
GROUP BY item_code ORDER BY item_code"
|
||||
)
|
||||
# M38 folds to M36 (real harmonized_code present); M47 keeps its raw code
|
||||
# via COALESCE(NULL, 'M47') -- proof the aggregate row is NOT dropped by
|
||||
# a plain `harmonized_code IS NOT NULL` filter. L-- and T29 stay excluded.
|
||||
expect_equal(harmonized$item_code, c("M04", "M36", "M47"))
|
||||
expect_equal(harmonized$amt, c(100, 50, 99999))
|
||||
})
|
||||
|
||||
test_that(".build_series_break_refs matches fin_code + break_year window", {
|
||||
# No series_breaks_pq row falls inside the bundled fixture's 2011-2020
|
||||
# window (data-verified; see the "series_break_refs" test in
|
||||
@@ -218,108 +152,6 @@ test_that("schema v5 harmonization views register when the corpus supports them"
|
||||
expect_true(all(expected_v5 %in% views$table_name))
|
||||
})
|
||||
|
||||
test_that(".harmonization_view_files guard is necessary: registration against a v4-shaped corpus (no harmonized_code column at all) succeeds only because the harmonized views are skipped", {
|
||||
# with_doctored_schema_version() (used elsewhere in this suite) only
|
||||
# rewrites manifest.json's schema_version -- the underlying `long` parquet
|
||||
# is still the bundled v6 fixture, which DOES have a harmonized_code
|
||||
# column, so it only proves the skip *happens*, not that it is *required*.
|
||||
# This test builds a genuinely v4-shaped corpus: `long` has no
|
||||
# harmonized_code column at all, matching a real pre-Phase-R2 publish
|
||||
# tree, and then shows two things: (1) the real .register_views(), gated
|
||||
# on manifest$schema_version, registers cleanly against it; (2) the exact
|
||||
# SQL text of a gated file (25-ig_long_harmonized.sql), executed directly
|
||||
# against the same corpus without the gate, fails -- proving the gate is
|
||||
# load-bearing, not incidental.
|
||||
tmp <- withr::local_tempdir()
|
||||
part_dir <- file.path(tmp, "data", "long", "year=2004")
|
||||
dir.create(part_dir, recursive = TRUE)
|
||||
part_path <- file.path(part_dir, "part-0.parquet")
|
||||
|
||||
write_con <- DBI::dbConnect(duckdb::duckdb())
|
||||
on.exit(DBI::dbDisconnect(write_con, shutdown = TRUE), add = TRUE)
|
||||
DBI::dbExecute(write_con, sprintf("
|
||||
COPY (
|
||||
SELECT * FROM (VALUES
|
||||
('gov-1', 'E36', 100, false, 500000, 2020)
|
||||
) AS t(canonical_govid, item_code, amt, is_aggregate, population, popyear)
|
||||
) TO %s (FORMAT PARQUET)
|
||||
", uscogdata:::.sql_lit_chr(part_path)))
|
||||
|
||||
xwalk_path <- file.path(tmp, "data", "canonical_fips_xwalk.parquet")
|
||||
DBI::dbExecute(write_con, sprintf("
|
||||
COPY (
|
||||
SELECT * FROM (VALUES
|
||||
('gov-1', 'Test Gov', 1, 'County', '01', '001', NULL, 500000)
|
||||
) AS t(canonical_govid, gov_name, govs_type, type_label, fips_state,
|
||||
fips_county, fips_place, population_acs)
|
||||
) TO %s (FORMAT PARQUET)
|
||||
", uscogdata:::.sql_lit_chr(xwalk_path)))
|
||||
|
||||
cats_path <- file.path(tmp, "data", "summary_categories.parquet")
|
||||
DBI::dbExecute(write_con, sprintf("
|
||||
COPY (
|
||||
SELECT * FROM (VALUES
|
||||
('E36', 'Test Category', 'expenditure', 'direct', NULL)
|
||||
) AS t(item_code, category, category_type, spend_subtype, revenue_subtype)
|
||||
) TO %s (FORMAT PARQUET)
|
||||
", uscogdata:::.sql_lit_chr(cats_path)))
|
||||
|
||||
# Confirm the synthetic `long` genuinely lacks harmonized_code (not just
|
||||
# NULL values -- the column itself must be absent) before trusting the
|
||||
# rest of this test.
|
||||
cols <- DBI::dbGetQuery(write_con, sprintf(
|
||||
"DESCRIBE SELECT * FROM read_parquet(%s)", uscogdata:::.sql_lit_chr(part_path)
|
||||
))$column_name
|
||||
expect_false("harmonized_code" %in% cols)
|
||||
|
||||
url <- paste0(tmp, "/")
|
||||
|
||||
# (1) Full .register_views() against this v4-shaped corpus must succeed --
|
||||
# this is the behavior the guard exists to protect.
|
||||
con <- DBI::dbConnect(duckdb::duckdb())
|
||||
on.exit(DBI::dbDisconnect(con, shutdown = TRUE), add = TRUE)
|
||||
expect_no_error(
|
||||
uscogdata:::.register_views(con, url, manifest = list(schema_version = 4L))
|
||||
)
|
||||
views <- DBI::dbGetQuery(con,
|
||||
"SELECT table_name FROM information_schema.tables
|
||||
WHERE table_schema = 'main' AND table_type = 'VIEW'")$table_name
|
||||
expect_true(all(c("ig_long", "ig_annotated", "spending_annotated") %in% views))
|
||||
expect_false(any(c("ig_long_harmonized", "ig_annotated_harmonized",
|
||||
"spending_long_harmonized") %in% views))
|
||||
|
||||
# (2) Prove the gate is load-bearing: the exact SQL text of the skipped
|
||||
# file, executed directly (bypassing .register_views()'s schema_version
|
||||
# check) against the SAME corpus, fails because it references
|
||||
# long.harmonized_code, a column this corpus's `long` does not have.
|
||||
sql_dir <- system.file("sql", package = "uscogdata")
|
||||
.read_view_sql <- function(filename) {
|
||||
txt <- paste(readLines(file.path(sql_dir, filename), warn = FALSE), collapse = "\n")
|
||||
gsub("\\{url\\}", url, txt, fixed = FALSE)
|
||||
}
|
||||
con2 <- DBI::dbConnect(duckdb::duckdb())
|
||||
on.exit(DBI::dbDisconnect(con2, shutdown = TRUE), add = TRUE)
|
||||
DBI::dbExecute(con2, .read_view_sql("10-long.sql"))
|
||||
expect_error(DBI::dbExecute(con2, .read_view_sql("25-ig_long_harmonized.sql")))
|
||||
|
||||
# Reconciling this test with the C2 guard (expenditure-concept review):
|
||||
# `ig_annotated`/`spending_annotated` registering cleanly above proves
|
||||
# only that CREATE VIEW binds against a `summary_categories` with no M/L
|
||||
# rows at all (this synthetic corpus's own summary_categories has a
|
||||
# single E36 row, see the COPY above) -- a LEFT JOIN never fails to
|
||||
# resolve regardless of what the joined-to table contains. It does NOT
|
||||
# mean querying expenditure_concept = "total" against this shape is safe:
|
||||
# exactly this corpus (schema_version reported as supported, but
|
||||
# summary_categories predates the M/L rows cog_pipeline PR #59 added) is
|
||||
# what .require_ig_categories() exists to catch at the *verb* level,
|
||||
# since PR #59 shipped those rows with no schema_version bump. Confirm
|
||||
# the new runtime guard actually fires against this same `con`.
|
||||
expect_error(
|
||||
uscogdata:::.require_ig_categories(con),
|
||||
class = "uscogdata_ig_categories_unsupported"
|
||||
)
|
||||
})
|
||||
|
||||
test_that("spending_long filters to E/F/G/K prefixes and excludes aggregates", {
|
||||
skip_if_no_corpus()
|
||||
con <- cog_open()
|
||||
|
||||
@@ -1,229 +0,0 @@
|
||||
---
|
||||
title: "Total spending: Direct, Total, and when each is right"
|
||||
output: rmarkdown::html_vignette
|
||||
vignette: >
|
||||
%\VignetteIndexEntry{Total spending: Direct, Total, and when each is right}
|
||||
%\VignetteEngine{knitr::rmarkdown}
|
||||
%\VignetteEncoding{UTF-8}
|
||||
---
|
||||
|
||||
```{r setup, include = FALSE}
|
||||
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
|
||||
```
|
||||
|
||||
# Two questions that sound the same but aren't
|
||||
|
||||
"Total spending" means two different things depending on whether the question
|
||||
is about one government or several:
|
||||
|
||||
1. **"What did my county spend in total, a decade ago vs today?"** — one
|
||||
government, tracked over time. Either `direct` or `total` spending answers
|
||||
this correctly, as long as the same concept is used for both years.
|
||||
2. **"How do all the counties in my state compare, a decade ago vs today,
|
||||
against the neighboring state?"** — several governments, summed together.
|
||||
Here only `direct` gives the right answer; summing `total` across
|
||||
governments double-counts money that passes between them.
|
||||
|
||||
`cog_spending()`'s `expenditure_concept` argument (`"direct"` or `"total"`)
|
||||
controls which of these a query answers. This vignette walks through both
|
||||
questions with code that actually runs against the package's bundled fixture
|
||||
corpus, then explains why the second question refuses `"total"` outright.
|
||||
|
||||
```{r}
|
||||
library(uscogdata)
|
||||
|
||||
# Point at the bundled offline fixture (years 2011, 2012, 2019, 2020, all 50
|
||||
# states) so this vignette knits without network access. In real use,
|
||||
# USCOGDATA_URL is instead set to the published corpus URL -- see README.md.
|
||||
Sys.setenv(USCOGDATA_URL = paste0(
|
||||
system.file("extdata/fixture_corpus", package = "uscogdata"), "/"
|
||||
))
|
||||
```
|
||||
|
||||
The fixture doesn't carry 2017 or the present year, so the examples below use
|
||||
the closest years it does ship -- **2012 and 2020** -- in place of "2017 vs
|
||||
today" / "ten years ago vs today". Point `USCOGDATA_URL` at the published
|
||||
corpus and swap in real years; the mechanics are identical.
|
||||
|
||||
# Archetype 1: one government's own trend
|
||||
|
||||
For a single government, `total` is a legitimate way to describe "everything
|
||||
this government spent, including money it handed to other governments to
|
||||
spend on its behalf":
|
||||
|
||||
```{r}
|
||||
al_total <- cog_spending(
|
||||
"010000226085", # Alabama, the state government
|
||||
years = c(2012, 2020),
|
||||
category = "Highways",
|
||||
expenditure_concept = "total"
|
||||
)
|
||||
al_total
|
||||
```
|
||||
|
||||
The `intergovernmental` rows are what `"total"` adds on top of `"direct"`
|
||||
(`capital` + `operations`): Alabama's own payments out to counties and
|
||||
cities for highway work. Because this query only ever concerns Alabama,
|
||||
including that piece is safe -- there's no other government's number it
|
||||
could be double-counted against.
|
||||
|
||||
`"direct"` (the default) answers the same trend question just as validly:
|
||||
|
||||
```{r}
|
||||
al_direct <- cog_spending(
|
||||
"010000226085", years = c(2012, 2020), category = "Highways"
|
||||
# expenditure_concept = "direct" is the default; shown here for contrast
|
||||
)
|
||||
al_direct
|
||||
```
|
||||
|
||||
Both are internally consistent series. What breaks the comparison is
|
||||
**switching concepts between the two years being compared** -- e.g. `direct`
|
||||
for 2012 and `total` for 2020 -- which manufactures a trend that isn't
|
||||
really there. Pick one concept for a given question and hold it fixed across
|
||||
every year in the series.
|
||||
|
||||
# Archetype 2: a cross-government rollup
|
||||
|
||||
`cog_geographic_rollup()` sums spending across state/county/city layers for
|
||||
a place. Its default -- and, as shown below, its *only* accepted value for
|
||||
`expenditure_concept` -- is `"direct"`:
|
||||
|
||||
```{r}
|
||||
fl_rollup <- cog_geographic_rollup(
|
||||
govids = list(
|
||||
state = "120000226351", # Florida
|
||||
county = c("121011212191", "121099101897") # Broward + Palm Beach
|
||||
),
|
||||
category = "Highways",
|
||||
years = c(2012, 2020)
|
||||
)
|
||||
fl_rollup
|
||||
```
|
||||
|
||||
For the neighboring state, the comparison is a single government, so it's a
|
||||
plain `cog_spending()` call rather than a rollup:
|
||||
|
||||
```{r}
|
||||
ga_state <- cog_spending(
|
||||
"130000226087", years = c(2012, 2020), category = "Highways" # Georgia
|
||||
)
|
||||
ga_state
|
||||
```
|
||||
|
||||
Now the same rollup, but asking for `expenditure_concept = "total"`:
|
||||
|
||||
```{r, error = TRUE}
|
||||
cog_geographic_rollup(
|
||||
govids = list(state = "120000226351", county = "121011212191"),
|
||||
category = "Highways",
|
||||
years = 2020,
|
||||
expenditure_concept = "total"
|
||||
)
|
||||
```
|
||||
|
||||
`cog_geographic_rollup()` (and `cog_peer_compare()`, for the same reason)
|
||||
refuses `"total"` outright rather than silently returning an inflated
|
||||
number. The next section is why.
|
||||
|
||||
# The mechanism
|
||||
|
||||
Suppose Alabama gives a county $10M toward a highway project. That $10M
|
||||
shows up **twice** in the underlying corpus:
|
||||
|
||||
- Once on Alabama's own record, coded `M44` ("to local governments,
|
||||
Highways") -- Alabama's intergovernmental leg.
|
||||
- Again on the county's record, coded `E44` / `F44` ("Highways, current
|
||||
operations" / "capital outlay") -- the county's direct spending, because
|
||||
the county is the government that actually lets the contract and pays the
|
||||
paving crew.
|
||||
|
||||
`direct` (item codes `E`/`F`/`G`) only ever counts the second of those --
|
||||
the government that actually did the spending. `total` (Direct plus the
|
||||
`M`/`L` intergovernmental legs) counts the first one *as well*, which is
|
||||
exactly right for describing Alabama's own budget: Alabama's `total`
|
||||
genuinely includes the $10M it committed to highways, whether it built the
|
||||
road itself or paid the county to. But sum `total` across Alabama **and**
|
||||
the county, and that $10M is counted twice -- once as Alabama's payment out,
|
||||
once as the county's spending in -- reporting $20M of highway work for $10M
|
||||
actually spent.
|
||||
|
||||
This is exactly the shape of query `cog_geographic_rollup()` exists to run
|
||||
(summing across layers of government), so it refuses `"total"` rather than
|
||||
silently overstating every multi-layer figure it produces.
|
||||
|
||||
# How big is the risk in practice
|
||||
|
||||
Intergovernmental transfers aren't evenly distributed by government type.
|
||||
Measured against the bundled fixture corpus (all 50 states, each of its
|
||||
four years -- 2011, 2012, 2019, 2020), intergovernmental spending as a
|
||||
share of a government's own Direct spending is:
|
||||
|
||||
| Government type | Intergovernmental / Direct |
|
||||
|---|---|
|
||||
| State | 16.7%-48.4% (varies by year; 24.0% pooled across all four) |
|
||||
| County | 3.4%-5.1% (varies by year) |
|
||||
| City | 2.6%-3.1% (varies by year) |
|
||||
|
||||
So the Direct/Total choice matters overwhelmingly for **state** governments
|
||||
-- a state's Total genuinely differs from its Direct by a meaningful margin,
|
||||
while for a county or city the two are close. The state range is also far
|
||||
wider than a single flat figure would suggest: legacy wide-era years (2011:
|
||||
48.4%) carry proportionally more intergovernmental spending than the modern
|
||||
era (2019-2020: 16.7%-17.0%), so a state's Direct/Total gap can be nearly
|
||||
3x larger a decade earlier than it is today. That's also why the mistake
|
||||
this vignette warns about is easy to make unnoticed at the county/city level
|
||||
and costly at the state level: rolling up every government in a state using
|
||||
`total` instead of `direct` overstates the true figure -- measured at 7.6%
|
||||
for Alabama in FY2019, and 11.6% nationally.
|
||||
|
||||
# Why Total = Direct + M + L, not Direct + M
|
||||
|
||||
It's tempting to assume `total` only needs to add `M`. But `M` and `L` are
|
||||
both money the queried government itself pays **out** -- they're not two
|
||||
different accounts of a receiving government's revenue. `M` is what it
|
||||
pays to other **local** governments (e.g. a county paying a city for a
|
||||
shared paving contract); `L` is what it pays **up** to its **state**
|
||||
government (e.g. a county's contribution to a state-administered program).
|
||||
A local government's Total genuinely includes both legs, because both are
|
||||
its own spending, just routed to a different kind of recipient. On the
|
||||
bundled fixture corpus (all 50 states, 2011/2012/2019/2020), `L` is 0 for
|
||||
state governments (a state has no "payments to the state government" leg of
|
||||
its own) but is 43%-51% the size of `M` for counties (varies by year) and
|
||||
144%-189% the size of `M` for cities (varies by year; 166% pooled across
|
||||
all four) -- so a `total` that omitted `L` would silently undercount Total
|
||||
specifically for local governments, and for cities `L` is often the
|
||||
*larger* of the two legs.
|
||||
`cog_spending(expenditure_concept = "total")` includes both legs (excluding
|
||||
the `L--` family-total rollup row, which would double-count its own
|
||||
components).
|
||||
|
||||
# Composition rules
|
||||
|
||||
- `expenditure_concept` (whose spending counts -- Direct vs Direct plus
|
||||
intergovernmental) is **orthogonal** to `basis` (which vintage of the
|
||||
item-code space a query resolves against -- `"harmonized"` vs `"raw"`).
|
||||
They combine freely: `expenditure_concept = "total", basis = "raw"` is a
|
||||
valid, meaningful query, and so is every other pairing.
|
||||
- `expenditure_concept = "total"` is **mutually exclusive** with `recipe`: a
|
||||
recipe already defines its own component codes (some recipes have their
|
||||
own matching intergovernmental counterpart recipe instead -- see
|
||||
`cog_recipes()` and the "firing suggestion" notes surfaced in
|
||||
`cog_spending()`'s provenance), so layering a second, generic `total`
|
||||
union on top of a recipe query has no well-defined meaning. Passing both
|
||||
together aborts with an error naming the conflict.
|
||||
- `expenditure_concept` is a **spending-only** concept: `cog_revenue()`
|
||||
doesn't expose it (revenue's own intergovernmental codes are a different
|
||||
axis -- see `?cog_revenue`).
|
||||
|
||||
# Summary
|
||||
|
||||
- Comparing one government to itself over time: `"direct"` or `"total"`
|
||||
both work -- pick one and hold it fixed across every year compared.
|
||||
- Comparing or summing across governments -- counties within a state, a
|
||||
state against its neighbor, cities against counties: use `"direct"`.
|
||||
`cog_geographic_rollup()` and `cog_peer_compare()` enforce this by
|
||||
refusing `"total"`.
|
||||
- `"total"` = Direct (`E`/`F`/`G`) + intergovernmental (`M` to local
|
||||
governments + `L` to the state government, excluding the `L--`
|
||||
family-total row).
|
||||
Reference in New Issue
Block a user