jared
4de915b557
Adds cog_recipes() to list the curated harmonization_recipes catalog (24 recipes / schema_version >= 5), and a recipe= argument on cog_spending()/ cog_revenue() that runs a recipe's generic multi-code join instead of the category view: SUM(amt * weight) across whichever component codes are present for a (year, canonical_govid), scoped by gov_type_scope. The join deliberately does not filter is_aggregate -- the wide era (<= 2011) exposes these split families (corrections 04+05, IG *89/*47, U4- rents, etc.) ONLY as aggregate rows, with leaf codes first appearing in 2012, so excluding aggregates would zero out the wide-era half of every recipe. This is safe by corpus construction: wide-era rows are aggregate-only, modern rows are leaf-only, and every component is year-scoped, so there is no double-counting. recipe= is mutually exclusive with category=; the result's subtype column reads "recipe" and category reads the recipe's label. Adds recipe-component-driven signposting: when a basis="harmonized" + category query comes back with zero rows in a requested year, and a harmonization recipe covering that category would actually produce rows for this government in that year (via the same join .run_recipe() uses), the recipe is surfaced in provenance$suggestions plus one cli::cli_inform() message. This is deliberately keyed off recipe components rather than harmonization_map's suggested_recipe_id column (which is empty on every live row -- the wide era's split families are NA-by-construction via aggregate exclusion, not an NA ruling to hang a suggestion off of). Also populates the previously-always-empty provenance$series_break_refs (schema v5 only: series_breaks_pq rows whose fin_code is among the observed codes and whose break_year falls in the requested span), and extends cog_explain() with Basis/Harmonization/Recipe/Suggestions/Series breaks sections.
303 lines
11 KiB
R
303 lines
11 KiB
R
# R/spending.R
|
|
|
|
#' Summarized spending by category
|
|
#'
|
|
#' One row per `(year, canonical_govid, spend_subtype, category)`. Amounts are
|
|
#' returned in **full U.S. dollars** (the raw corpus stores them in $1,000s;
|
|
#' this verb multiplies by 1000 so downstream code can freely rescale to
|
|
#' millions/billions). The conversion is recorded in the provenance attribute
|
|
#' under `transformations$units_conversion`.
|
|
#'
|
|
#' @param govid Character vector of `canonical_govid` values.
|
|
#' @param years Integer vector of years.
|
|
#' @param category Character vector of category names (from
|
|
#' `summary_categories.category`), or `NULL` for all categories.
|
|
#' @param per_capita If `TRUE`, adds `amt_per_capita_nominal` (and
|
|
#' `amt_per_capita_real` when `adjust_to_year` is set) using the per-year
|
|
#' Census F-33 population from `gov_population_yearly`. Result also gains
|
|
#' a `pop_source` column with values `"census_f33"` or `"unavailable"`
|
|
#' (the latter for gov types 4/5 and any row whose population is missing
|
|
#' in that year).
|
|
#' @param adjust_to_year Integer base year for CPI-U real-dollar conversion,
|
|
#' or `NULL` for nominal only.
|
|
#' @param basis `"harmonized"` (default) sums item codes through the
|
|
#' cross-vintage harmonization mapping (folding series-break-affected
|
|
#' codes onto a comparable target and excluding aggregate / discontinued
|
|
#' rows -- see the `harmonization` block in `cog_explain()`); `"raw"`
|
|
#' reproduces the pre-Phase-R2 behavior (published item codes, no
|
|
#' folding). On a corpus with `schema_version < 5` (no harmonization
|
|
#' tables), `basis` silently resolves to `"raw"` when left at its default
|
|
#' and the resolution is recorded in the provenance; explicitly passing
|
|
#' `basis = "harmonized"` on such a corpus aborts.
|
|
#' @param recipe Optional harmonization recipe id (see [cog_recipes()]) for
|
|
#' multi-code cross-vintage series that a 1:1 harmonized_code mapping
|
|
#' can't express (e.g. a wide-era aggregate that only splits into leaf
|
|
#' codes in the modern era). Mutually exclusive with `category`. The
|
|
#' result's subtype column reads `"recipe"` and `category` reads the
|
|
#' recipe's label. Requires `schema_version >= 5`.
|
|
#' @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`,
|
|
#' optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
|
|
#' Carries a `provenance` attribute matching `inst/schemas/provenance-v1.json`.
|
|
#' @export
|
|
cog_spending <- function(govid, years, category = NULL,
|
|
per_capita = FALSE, adjust_to_year = NULL,
|
|
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", "K"),
|
|
call = match.call(),
|
|
govid = govid,
|
|
years = years,
|
|
category = category,
|
|
per_capita = per_capita,
|
|
adjust_to_year = adjust_to_year,
|
|
basis = basis,
|
|
recipe = recipe
|
|
)
|
|
}
|
|
|
|
#' @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) {
|
|
basis_explicit <- length(basis) == 1L
|
|
basis <- match.arg(basis, c("harmonized", "raw"))
|
|
|
|
govid <- .coerce_govid_input(govid, arg = "govid")
|
|
.validate_verb_inputs(govid, years, category, per_capita, adjust_to_year,
|
|
recipe)
|
|
|
|
years <- as.integer(years)
|
|
if (!is.null(adjust_to_year)) adjust_to_year <- as.integer(adjust_to_year)
|
|
|
|
con <- .ensure_session()
|
|
manifest <- .uscogdata_env$manifest
|
|
scope <- .check_govids_in_scope(govid)
|
|
|
|
resolved <- .resolve_basis(basis, basis_explicit, manifest)
|
|
|
|
recipe_block <- NULL
|
|
category_for_prov <- category
|
|
if (!is.null(recipe)) {
|
|
.require_schema_v5(con, manifest, "recipe =")
|
|
.validate_recipe_id(con, recipe)
|
|
comps <- .recipe_components(con, recipe)
|
|
recipe_label <- comps$label[[1]]
|
|
result <- .run_recipe(con, recipe, govid, years)
|
|
sql <- attr(result, "sql_query")
|
|
result <- .shape_recipe_result(result, subtype_col, recipe_label)
|
|
recipe_block <- list(
|
|
recipe_id = recipe, label = recipe_label,
|
|
components = .df_to_row_list(comps)
|
|
)
|
|
category_for_prov <- recipe_label
|
|
} else {
|
|
view <- .select_view(view_base, resolved$basis)
|
|
sql <- .build_verb_sql(view, subtype_col, govid, years, category)
|
|
result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
|
}
|
|
|
|
if (per_capita) result <- .attach_per_capita(result, con, govid)
|
|
if (!is.null(adjust_to_year)) {
|
|
result <- .attach_real_dollars(result, adjust_to_year, per_capita)
|
|
}
|
|
|
|
result$notes <- .notes_column(result)
|
|
|
|
harmonization <- .build_harmonization_block(
|
|
con, govid, years, resolved, flow_prefixes
|
|
)
|
|
|
|
suggestions <- if (is.null(recipe)) {
|
|
.build_suggestions(con, govid, years, category, result, resolved$basis)
|
|
} else {
|
|
list()
|
|
}
|
|
|
|
prov <- .build_provenance(
|
|
verb = verb,
|
|
call = call,
|
|
govid = govid,
|
|
years = years,
|
|
category = category_for_prov,
|
|
per_capita = per_capita,
|
|
adjust_to_year = adjust_to_year,
|
|
result = result,
|
|
sql = sql,
|
|
subtype_col = subtype_col,
|
|
basis = resolved$basis,
|
|
basis_note = resolved$note,
|
|
harmonization = harmonization,
|
|
recipe = recipe_block,
|
|
suggestions = suggestions
|
|
)
|
|
prov$scope$govids_found <- scope$found
|
|
prov$scope$govids_missing <- scope$missing
|
|
attr(result, "provenance") <- prov
|
|
attr(result, ".popyear_range") <- NULL
|
|
|
|
if (length(suggestions) > 0L) .inform_suggestions(suggestions)
|
|
|
|
result
|
|
}
|
|
|
|
#' @noRd
|
|
.validate_verb_inputs <- function(govid, years, category,
|
|
per_capita, adjust_to_year, recipe = NULL) {
|
|
if (!is.character(govid) || length(govid) == 0L) {
|
|
cli::cli_abort("`govid` must be a non-empty character vector.")
|
|
}
|
|
if (!(is.integer(years) || is.numeric(years)) || length(years) == 0L) {
|
|
cli::cli_abort("`years` must be a non-empty integer vector.")
|
|
}
|
|
if (!is.null(category) && !is.character(category)) {
|
|
cli::cli_abort("`category` must be character or NULL.")
|
|
}
|
|
if (!is.logical(per_capita) || length(per_capita) != 1L) {
|
|
cli::cli_abort("`per_capita` must be a length-1 logical.")
|
|
}
|
|
if (!is.null(adjust_to_year)) {
|
|
if (!(is.integer(adjust_to_year) || is.numeric(adjust_to_year)) ||
|
|
length(adjust_to_year) != 1L) {
|
|
cli::cli_abort("`adjust_to_year` must be NULL or a length-1 integer.")
|
|
}
|
|
}
|
|
if (!is.null(recipe)) {
|
|
if (!is.character(recipe) || length(recipe) != 1L) {
|
|
cli::cli_abort("`recipe` must be NULL or a length-1 character string.")
|
|
}
|
|
if (!is.null(category)) {
|
|
cli::cli_abort(c(
|
|
"`recipe` and `category` are mutually exclusive.",
|
|
i = "Pass one or the other, not both."
|
|
), class = "uscogdata_recipe_category_conflict")
|
|
}
|
|
}
|
|
invisible(TRUE)
|
|
}
|
|
|
|
#' @noRd
|
|
.select_view <- function(view_base, basis) {
|
|
if (identical(basis, "harmonized")) paste0(view_base, "_harmonized") else view_base
|
|
}
|
|
|
|
#' @noRd
|
|
.sql_lit_chr <- function(x) {
|
|
safe <- gsub("'", "''", x, fixed = TRUE)
|
|
paste0("'", safe, "'", collapse = ",")
|
|
}
|
|
|
|
#' @noRd
|
|
.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)) {
|
|
""
|
|
} else {
|
|
sprintf("AND category IN (%s)", .sql_lit_chr(category))
|
|
}
|
|
|
|
sprintf(
|
|
"SELECT
|
|
year,
|
|
canonical_govid,
|
|
COALESCE(xwalk_gov_name, gov_name) AS gov_name,
|
|
%1$s,
|
|
category,
|
|
SUM(amt) * 1000.0 AS amt_nominal,
|
|
string_agg(DISTINCT item_code, ',' ORDER BY item_code) AS codes_included,
|
|
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, view, govid_lit, years_lit, category_pred
|
|
)
|
|
}
|
|
|
|
#' @noRd
|
|
.attach_per_capita <- function(result, con, govid) {
|
|
if (nrow(result) == 0L) {
|
|
result$amt_per_capita_nominal <- numeric(0)
|
|
result$pop_source <- character(0)
|
|
attr(result, ".popyear_range") <- integer(0)
|
|
return(result)
|
|
}
|
|
years_lit <- paste(unique(as.integer(result$year)), collapse = ",")
|
|
sql <- sprintf(
|
|
"SELECT canonical_govid, year, population, popyear
|
|
FROM gov_population_yearly
|
|
WHERE canonical_govid IN (%s)
|
|
AND year IN (%s)",
|
|
.sql_lit_chr(govid), years_lit
|
|
)
|
|
pops <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
|
result <- dplyr::left_join(result, pops,
|
|
by = c("canonical_govid", "year"))
|
|
result$amt_per_capita_nominal <- result$amt_nominal / result$population
|
|
result$pop_source <- ifelse(is.na(result$population),
|
|
"unavailable", "census_f33")
|
|
py <- result$popyear[!is.na(result$popyear)]
|
|
attr(result, ".popyear_range") <- if (length(py) > 0L) {
|
|
as.integer(c(min(py), max(py)))
|
|
} else {
|
|
integer(0)
|
|
}
|
|
result$population <- NULL
|
|
result$popyear <- NULL
|
|
result
|
|
}
|
|
|
|
#' @noRd
|
|
.attach_real_dollars <- function(result, adjust_to_year, per_capita) {
|
|
if (nrow(result) == 0L) {
|
|
result$amt_real <- numeric(0)
|
|
if (per_capita) result$amt_per_capita_real <- numeric(0)
|
|
return(result)
|
|
}
|
|
result$amt_real <- .inflate(result$amt_nominal, result$year, adjust_to_year)
|
|
if (per_capita && "amt_per_capita_nominal" %in% names(result)) {
|
|
result$amt_per_capita_real <- .inflate(
|
|
result$amt_per_capita_nominal, result$year, adjust_to_year
|
|
)
|
|
}
|
|
result
|
|
}
|
|
|
|
#' @noRd
|
|
.notes_column <- function(result) {
|
|
n <- nrow(result)
|
|
if (n == 0L) return(character(0))
|
|
parts <- vector("list", 2L)
|
|
agg <- result[["aggregate_fallback"]]
|
|
parts[[1]] <- if (!is.null(agg)) {
|
|
ifelse(agg %in% TRUE,
|
|
"Aggregate fallback applied; see cog_explain()",
|
|
NA_character_)
|
|
} else {
|
|
rep(NA_character_, n)
|
|
}
|
|
ps <- result[["pop_source"]]
|
|
parts[[2]] <- if (!is.null(ps)) {
|
|
ifelse(ps == "unavailable",
|
|
"No population denominator available for this gov type",
|
|
NA_character_)
|
|
} else {
|
|
rep(NA_character_, n)
|
|
}
|
|
out <- character(n)
|
|
for (i in seq_len(n)) {
|
|
pieces <- vapply(parts, `[[`, character(1), i)
|
|
pieces <- pieces[!is.na(pieces)]
|
|
out[i] <- if (length(pieces) == 0L) "" else paste(pieces, collapse = "; ")
|
|
}
|
|
out
|
|
}
|