Compare commits

...
Author SHA1 Message Date
jared 515ab3b019 docs: survey_weight is col 28 under schema v6 (was col 26 in v5)
R-CMD-check / check (push) Failing after 1m49s
Rebase onto the v6 main (bd53230) shifted survey_weight from col 26 to
col 28: v5→v6 inserted cog_legacy_state/cog_legacy_county at positions
10-11 (26→28 cols). Position confirmed against the regenerated v6
fixture and both corpus docs (reader-specification.md §3 'Long parquet
schema (28 columns)' row 28; data_dictionary.md '28-column schema v6'
row 28).
2026-07-23 12:22:25 -04:00
jared d238bc0a22 feat: report the coarse-vs-per-code subset relation in the signposting harness
The coarse and per-code signposting checks are partly DISJOINT, not nested:
coarse fires on queries per-code does not, so the coarse -> percode move
both adds and removes signposting. Every `*_delta_pp` the harness reports is
therefore a NET that can mask a coverage loss in either direction. The
staged-corpus headline (+1.875 pp, coarse 1/640 -> percode 13/640) sits on
top of Corrections losing coverage outright (0.05 -> 0.00, -5 pp).

The cause is structural, not sampling: coarse's coverage test is at recipe
grain and self-coverage-permissive, while per-code requires a DIFFERENT
component of the same recipe. When a whole category is empty in a year --
coarse's own trigger -- and the only covering evidence is the gapped
component's own wide-era aggregate row, per-code cannot fire by
construction. That case is already pinned as intended behaviour in
test-recipes.R; this change measures what it costs, it does not change it.

Measurement and disclosure only. R/suggestions.R is untouched -- which arm
ships is the human ruling at Checkpoint R3.

- header: replace the "noise trade" framing with an explicit statement that
  the checks are partly disjoint and every delta is a net
- .measure_subset_relation(): split the disagreement into violations
  (coarse fired, per-code silent -- coverage LOST) and additions, returning
  the offending rows, not just counts. No assertion: the violation set is
  genuinely non-empty and a stopifnot() would only break the harness that
  is supposed to surface it
- .measure_format_subset_report(): prominent HOLDS / *** VIOLATED ***
  section naming each offending (category, government, year)
- detail gains coarse_gap_years / coarse_recipes / percode_recipes;
  by_category gains n_coarse_only / n_percode_only so the two netted flows
  are visible per category
- new test-signposting-harness.R pins the reporting, including inversion
  guards and an end-to-end case (Broward FY2011 Corrections) where coarse
  fires and per-code does not

Tests: 518 PASS / 0 FAIL / 0 WARN / 0 SKIP (was 476). Mutation-checked:
inverting the violation direction fails 18 assertions, removing the
violation reporting fails 9.
2026-07-23 12:22:24 -04:00
jared e53aeb9643 docs: warn raw-parquet readers that survey_weight is not an aggregation weight
The v5 schema passes the legacy IndFin Weight column through verbatim as
survey_weight. Census documents it as informational-only, and its encoding
is inconsistent across vintages (reciprocal scale most years, direct in
2003, placeholder 1 in 1967-2001 gap years, all-0 in 2007-2012, NA modern),
so weighting amt by it produces silently wrong totals. No uscogdata function
reads the column; this warning is for direct DuckDB/arrow consumers.
Evidence: cog_pipeline/.superpowers/sdd/weight-semantics-findings.md.
2026-07-23 12:22:24 -04:00
jared 9244e08085 feat: add self-coverage decomposition arm to signposting harness
Adds a third comparison arm to measure_signposting_rate(): Task 19c's
first per-code pass (git ref da72bf3, self-coverage allowed) alongside
the existing coarse (b0df1ec) and live corrected per-code arms, pulled
verbatim via the same git-show mechanism (renamed
.measure_load_coarse_impl -> .measure_load_git_impl since it now loads
more than the coarse arm).

Reports both the original delta (self-coverage-allowed rate minus
coarse) and the corrected delta (live per-code rate minus coarse), plus
the self-coverage share of the original delta (queries that fired ONLY
because a component's own aggregate row satisfied its own coverage
check). Verifies percode-fired is always a subset of selfcov-fired
(stopifnot) -- the corrected arm is a strict narrowing of the buggy one,
so the decomposition is exact rather than approximate.
2026-07-23 12:22:23 -04:00
jared 1b2294e3a0 fix: require a DIFFERENT recipe component to cover a per-code gap
.recipe_coverage()'s covered_years were computed once per recipe as a
union across ALL of its components (aggregate rows included), without
excluding the component currently being tested for a gap. So a code
whose only representation in a year was its own wide-era aggregate row
satisfied its own "covered" check -- self-coverage, not the "other
components" review-doc 0.3's criterion actually specifies ("...has no
rows ... but other components do").

.recipe_coverage() now returns (recipe_id, component_code, year)
triples instead of collapsing across components, and
.recipe_component_gapped() excludes the component under test before
checking coverage, so a gap only fires when a genuinely different
sibling component has data in that year.

Adds the boundary test this gap in coverage let slip through untested:
Broward FY2011 alone, where E05/F05/G05 each report solely as their own
wide-era aggregate row and E04/F04/G04 don't exist as codes before 2012
corpus-wide, so none of the three Corrections recipes have any OTHER
component to cover them -- must produce zero suggestions. The existing
2011-2012 combined test still passes, now firing because of the 2012
E05-gapped/E04-covers pair rather than 2011's self-coverage. Updates the
header comment to state the other-component requirement explicitly.
2026-07-23 12:22:23 -04:00
jared 91b64b9b8b feat: add coarse-vs-per-code signposting rate measurement harness
data-raw/measure_signposting_rate.R runs every summary_categories
category x a (seeded, deterministic) sample of up to 20 governments x
the widest pre/post-2012 year span the active corpus actually supports,
through both the R2 coarse .build_suggestions() (pulled verbatim from
git ref b0df1ec, evaluated in an isolated env parented on the uscogdata
namespace) and the current per-code version, and reports the suggestion
rate and delta under each, overall and by category.

Parameterized by USCOGDATA_URL (defaults to the bundled fixture when
unset) so it can be re-run against the staged/full corpus later. Detects
and reports when the active corpus can't fill a full 3-year pre/3-year
post-2012 design instead of padding or fabricating years. This script
measures the coarse-vs-per-code tradeoff; it does not rule on what
suggestion-rate increase is an acceptable amount of added noise -- that
is Jared's call at Checkpoint R3.
2026-07-23 12:22:22 -04:00
jared 267bc24fee feat: narrow harmonization signposting to per-code gap detection
.build_suggestions() previously flagged a recipe only when the WHOLE
category result had zero rows in a requested year, so a multi-code
category where one recipe component was genuinely gapped never fired
if any sibling code (same recipe or not) had data that year. Each
recipe's own in-category component is now checked individually -- a
component fires when it has no rows in a requested (in-scope) year the
recipe's own generic join otherwise covers, even when the overall
category result looks complete.

Decomposes .build_suggestions() into .category_recipe_components/
.recipe_meta/.component_presence/.recipe_coverage/.recipe_component_gapped
helpers, drops the now-unused `result` param, and rewrites the header
comment to describe the new, deliberately wider scope plus the
per-government `covered` guard that still filters recipes with no data
at all (ordinary reporting variance vs. a real format-boundary gap).

Tests pin the multi-code case the coarse check missed (Cleburne County
FY2012: G05 gapped, G04 covers, masked because E04/E05 have data) next
to the still-guarded no-recipe-coverage case (F04/F05 both absent), and
update the Broward 2019-2020 case to its new, correct expectation (fires
for corrections_combined/corrections_other_capital_combined, still
silent for corrections_capital_combined) plus a fresh true-full-coverage
negative case (Maricopa County).
2026-07-23 12:22:22 -04:00
jared fa40266d07 Merge pull request 'Regenerate fixture corpus from the Option B (single-flavor aggregate) publish tree' (#7) from fix/fixture-option-b-aggregates into main
R-CMD-check / check (push) Successful in 2m34s
Reviewed-on: #7
2026-07-23 12:21:22 -04:00
jared 3583c05852 chore: regenerate fixture corpus from the Option B (single-flavor aggregate) publish tree
R-CMD-check / check (push) Successful in 2m49s
R-CMD-check / check (pull_request) Successful in 2m38s
Source: cog_pipeline publish_cache built 2026-07-23T16:06:45Z at 4f992a0
(pipeline PR #43, issue #28 Option B ruling: legacy aggregate families now
publish only the H2-designated Direct flavor; Census Total = code + M-code).

Fixture delta, verified against the prior partition: year=2011 loses
173,394 non-designated aggregate rows (3,037,606 -> 2,864,212; -05 max
rows/gov 2 -> 1), leaf rows byte-identical; 2012/2019/2020 partitions,
metadata parquets, and docs unchanged. manifest.json resyncs sha256 /
row_count / size_bytes for the changed partition.

Full suite vs the regenerated fixture: 467 PASS / 0 FAIL / 0 WARN / 0 SKIP
— zero pin adjudications needed (reader verbs filter is_aggregate rows and
no main test pins legacy aggregate counts).
2026-07-23 12:16:05 -04:00
jared bd53230ae7 Merge branch 'feat/schema-v6-support'
R-CMD-check / check (push) Successful in 19m38s
2026-07-22 13:16:11 -04:00
jaredandClaude Opus 4.8 e813ffd3aa feat: accept corpus schema v6 (FIPS geography harmonization); v6 fixture
Schema v6 (cog_pipeline 2026-07-22) renamed the long table's
fips_state_code/fips_county_code to fips_state_asof/fips_county_asof and added
cog_legacy_state/cog_legacy_county (26 -> 28 cols). This package references
none of those columns and its geography always came from
canonical_fips_xwalk (already present-based), so acceptance is a version-set
bump: supported = c(4L, 5L) -> c(4L, 5L, 6L) in .validate_schema() and
cog_open(). A prominent note in .validate_schema() documents the SILENT
semantic change for raw-long readers: long fips_state/fips_county are now
PRESENT/harmonized geography (carried back per government), not as-of-year.

Fixture regenerated from the published v6 tree (schema_version 6, 28 cols).
Test updates:
  * test-manifest.R: v6 accepted; boundary rejection moves to v7.
  * test-spending.R: the na_rows_excluded pin (0) predated the Task 18 map
    extension, which added E/F/G-prefix discontinued_na rulings (E21/F21/G21,
    Education NEC local, SB184-186). Broward's 2011 partition zero-pads
    exactly those codes: 3 NA-harmonized rows excluded, all amt=0, so the
    excluded AMOUNT pin stays 0. Data-verified against the v6 fixture.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-07-22 13:16:11 -04:00
jared b0df1ec668 Merge pull request 'Phase R2: basis= harmonized/raw, recipes, signposting (schema 4/5 dual-accept)' (#5) from feat/phase-r2-harmonization into main
R-CMD-check / check (push) Successful in 2m47s
Reviewed-on: #5
2026-07-19 11:05:05 -04:00
jared 77f48047b1 fix: exercise real harmonized-view SQL in tests; unambiguous recipe provenance
R-CMD-check / check (pull_request) Successful in 3m5s
R-CMD-check / check (push) Successful in 3m1s
test-views.R's harmonized-view test previously ran a hand-rolled REPLACE
query with no WHERE clause, so a regression in any of
inst/sql/22-spending_long_harmonized.sql / 23-revenue_long_harmonized.sql's
three predicates (NOT is_aggregate, harmonized_code IS NOT NULL, the
E/F/G/K or T/A/U/B/C/D prefix filter) would go uncaught. Replaced it with a
test that reads the real SQL files off disk, substitutes {url} exactly as
.register_views() does, and executes them (plus their 10-long.sql
dependency) against a synthetic hive-partitioned parquet tree written via
DuckDB's own COPY ... TO (FORMAT PARQUET) (no arrow dependency, matching
this package's existing convention). Ten rows are crafted so each predicate
is independently falsifiable by a specific row; manually broke each
predicate in turn to confirm the test fails exactly as expected, then
restored the SQL files (see the task report for the RED-phase transcript).

Also fixes a provenance ambiguity: a recipe= query bypasses
spending_annotated(_harmonized)/revenue_annotated(_harmonized) entirely
(.run_recipe() joins `long` directly), so basis= has no effect on it, but
provenance was still reporting basis = "harmonized"/"raw" (whatever the
argument resolved to) with harmonization$applied = FALSE alongside it --
misleading, since it looks like harmonization was evaluated and found
nothing to exclude rather than "not applicable here." Recipe results now
report basis = "recipe" with an inert harmonization block carrying an
explicit note, regardless of what basis= was passed.
2026-07-18 23:55:48 -04:00
jared 4de915b557 feat: cog_recipes + recipe= + signposting suggestions
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.
2026-07-18 23:33:02 -04:00
jared 7818cd2b1a feat: basis= harmonized/raw with v4/v5 dual-accept
Adds schema_version 5 support alongside the existing v4 corpus:
.validate_schema() now accepts a supported set (4, 5) instead of a single
expected version, and cog_spending()/cog_revenue() gain basis =
c("harmonized", "raw"). Harmonized basis routes to new
spending_annotated_harmonized / revenue_annotated_harmonized views built on
spending_long_harmonized / revenue_long_harmonized (REPLACE(harmonized_code
AS item_code), excluding aggregate and NA-harmonized rows); raw basis is
byte-identical to the pre-Phase-R2 behavior. On a v4 corpus, an unspecified
basis silently resolves to "raw" with a provenance note; an explicit
basis = "harmonized" aborts with an actionable message.

Provenance gains basis, basis_note, and a harmonization block
(applied/na_rows_excluded/na_amount_excluded). The five new schema-v5-only
SQL views (harmonized long/annotated views, harmonization_map,
harmonization_recipes, series_breaks_pq) are registered conditionally on
manifest$schema_version >= 5, since DuckDB's read_parquet() errors eagerly
at CREATE VIEW time when the backing file doesn't exist on a v4 corpus.

Fixture corpus regenerated to schema_version 5 / years 2011, 2012, 2019,
2020 (2011->2012 spans the wide-aggregate -> modern-leaf format boundary
needed for the harmonization/recipe work), with the harmonization_map /
harmonization_recipes / series_breaks parquet tables bundled alongside the
existing metadata registries.
2026-07-18 23:19:17 -04:00
jared 3b725770d2 Merge pull request 'Phase R1: cog_manifest() accessor + CPI coverage pins' (#4) from feat/phase-r1-forward into main
R-CMD-check / check (push) Successful in 2m40s
Reviewed-on: #4
2026-07-18 18:07:13 -04:00
jared 4d61692f05 feat: export cog_manifest() accessor + pin CPI coverage 1967-present
R-CMD-check / check (push) Successful in 2m47s
R-CMD-check / check (pull_request) Successful in 2m57s
2026-07-18 13:40:54 -04:00
jared 70cf553828 chore: regenerate fixture corpus from cog_pipeline Phase Q4 publish (a082b26)
R-CMD-check / check (push) Successful in 2m18s
Metadata tables refreshed from the Phase Q4 corpus (schema 4, pipeline_commit
a082b26): canonical_fips_xwalk.parquet now carries the extended population
bridge (pop_confidence exact 15.7% -> 97.3%); canonical_alias.parquet reflects
the Q3 rename continuations. 2019/2020 long partitions unchanged (continuations
remap only pre-2017 predecessor rows). Suite 336 PASS / 0 FAIL / 0 WARN.
2026-07-13 19:36:10 -04:00
jared 3c55447308 Merge feat/phase-p-schema-4: corpus schema_version 4 (Phase P canonical ids)
R-CMD-check / check (push) Successful in 2m14s
2026-07-11 14:11:53 -04:00
jared 92c9a7382e test: re-baseline canonical_govid literals to 12-char namespace
Swaps every hardcoded 9-char canonical_govid literal (Broward County,
Fort Lauderdale City, Florida/Alabama state govts, Bexar/Tarrant/Wayne
counties, San Diego/Oakland/Miami/Austin cities) for its 12-char Phase P
equivalent, resolved by name+type+state against the regenerated fixture
xwalk. Also updates two gov_name search patterns that no longer match
under Phase P canonical naming ("FLORIDA STATE GOVT" -> "FLORIDA"; the
"Miami" substring test now pins type = "city" since MIAMI-DADE COUNTY's
canonical name now also contains "Miami", which would otherwise make the
match ambiguous across govs_types instead of resolving via largest-pop).
Underlying per-year population figures for Broward County and Alabama
are unchanged, so no expected data-value literals needed recomputation.
Suite: 126 test blocks / 336 expectations, 0 FAIL / 0 WARN / 0 SKIP.
2026-07-11 09:32:02 -04:00
jared 570a9408a2 feat: regenerate fixture corpus from Phase P publish tree + committed regen script
Adds data-raw/regenerate_fixture_corpus.R, parameterized by publish-cache
path, so the fixture is never a manual rebuild again. Regenerates the
2019/2020 long partitions (byte-for-byte copy), the full 39,377-row
canonical_fips_xwalk master, the new 117,503-row canonical_alias lookup
table, and summary_categories from the Phase P publish tree; resyncs the
four fixture docs; and hand-builds manifest.json with schema_version 4
and freshly computed sha256/row_count/size_bytes for every shipped file.
Fixture grows from 3.7MB to 5.5MB, well under the 25MB budget.
2026-07-11 09:31:49 -04:00
jared e635a1fc9e feat!: require corpus schema_version 4 (Phase P canonical ids)
BREAKING CHANGE: canonical_govid is now uniformly 12 characters across
every vintage; corpora built against schema_version 3 are rejected.
Bumps MinCorpusSchema/MaxCorpusSchema to 4 and expected_version in
cog_open(). canonical_fips_xwalk grows to the 14-column Phase P master
schema (adds legacy_govs_id, census_geoid, id_source; confidence is
renamed to pop_confidence); .empty_xwalk_tibble() is rewritten to match.
2026-07-11 09:31:33 -04:00
jared 874347242b fix(manifest): actionable errors when USCOGDATA_URL is unset or returns non-JSON
R-CMD-check / check (push) Successful in 2m5s
`cog_gov_search()` (and every other verb) used to fail with a cryptic
`jsonlite` lexical error when the package's placeholder default URL was
hit and the server returned an HTML welcome page that got cached as
`manifest.json`. Three guards added:

1. `.check_url_configured()` aborts with class `uscogdata_url_not_configured`
   when the resolved URL is empty or still contains the
   `REPLACE_WITH_SHARE_TOKEN` sentinel. Message names both
   `Sys.setenv(USCOGDATA_URL = ...)` and `options(uscogdata.url = ...)`
   remediations and points at the bundled fixture.
2. `.fetch_or_cache_manifest()` parses the response body before persisting
   it. Non-JSON payloads raise class `uscogdata_invalid_manifest` (URL,
   Content-Type, parse error) and never touch the on-disk cache.
3. Cache writes are atomic via a sibling tempfile + `file.rename`, and
   existing caches with non-JSON content are silently refetched instead
   of returning a parse error to the caller.

Local-path manifests that aren't valid JSON now surface the same
`uscogdata_invalid_manifest` class with file context.
2026-05-27 11:57:31 -04:00
jared 0dd3f15ada fix(ci): use knitr::rmarkdown vignette engine + ignore gitea/CLAUDE
R-CMD-check / check (push) Successful in 1m44s
R CMD build (run by rcmdcheck before R CMD check) rebuilds vignettes
from source regardless of --no-vignettes. Our vignette declared
%\VignetteEngine{knitr::knitr} which requires the 'markdown' package
that isn't in CI's dependency tree. Switch to %\VignetteEngine{knitr::rmarkdown},
which uses the already-Suggests-listed 'rmarkdown' package and matches
the output: rmarkdown::html_vignette directive in the YAML header.

Also add ^\.gitea$ and ^CLAUDE\.md$ to .Rbuildignore so R CMD check
stops emitting the "hidden file" / "non-standard top-level file" notes.

Local rcmdcheck (mirroring CI's exact args) now reports
0 errors / 0 warnings / 0 notes.

The pdflatex notice in the build log is unrelated — R CMD build prints
"Not building PDF manual" and continues; with --no-manual it's silenced
entirely.
2026-04-29 19:25:16 -04:00
jared 919548685b polish(per-year-pop): expand popyear in cog_explain + propagate pop_range
R-CMD-check / check (push) Failing after 1m30s
Final-review followups:

1. cog_explain rendered the popyear range as raw 2-digit values
   ("popyear range: 19-20"), which a user could read as the years 19-20.
   Added .expand_popyear() helper to format as 4-digit calendar years
   (2019-2020). Pivot at 70 to handle pre-2000 vintages if the corpus
   ever extends backward.

2. cog_peer_compare provenance was missing pop_range and is_ratio,
   omitted from the spec-required reproducibility metadata.
   cog_find_peers now stamps both as tibble attributes; cog_peer_compare
   reads them through to provenance$pop_range and provenance$is_ratio.

Test coverage extended: explain test asserts the 4-digit format and
rejects the old 2-digit form; peer-compare test asserts pop_range +
is_ratio propagate end-to-end.

326 PASS / 0 FAIL.
2026-04-29 19:16:48 -04:00
jared 716cfe25e5 build: ignore vignette build artifacts (doc/, Meta/)
Auto-added by devtools::document() during the per-year-population
documentation pass.
2026-04-29 19:10:15 -04:00
jared 33c0274727 docs(news): per-year population denominators (unreleased)
Summarizes the per-capita and peer-cohort behavior changes for users
upgrading from earlier 0.1 snapshots.
2026-04-29 19:09:00 -04:00
jared c46354f049 docs(vignette): population denominators rationale + usage
Explains the four population sources, why F-33 is the default, type-4/5
coverage gap, the popyear quirk, and how to build moving-window peer
cohorts manually.
2026-04-29 19:05:38 -04:00
jared 916212c327 feat(explain): render new per-capita provenance fields
cog_explain() now prints denominator_source, popyear_range, and
pop_source_counts under the Transformations section.
2026-04-29 19:02:37 -04:00
jared a2ced368f5 feat(provenance): record per-year denominator metadata
Updates transformations\$per_capita with the new denominator_source string,
popyear_range, and pop_source_counts. .attach_per_capita stashes
popyear_range on the result; .verb_spendrev strips the helper attr after
provenance is built.
2026-04-29 19:00:16 -04:00
jared b7ebb4cd88 feat(rollup): drop unavailable-pop rows + provenance audit
cog_geographic_rollup(per_capita = TRUE) now drops rows whose government
has no observed population for that year (pop_source == 'unavailable'),
matching the spec's exclusion rule. Records included/excluded govids in
provenance$rollup.
2026-04-29 17:50:59 -04:00
jared c334be7706 test(rollup): per-year denominator + provenance expectations (failing) 2026-04-29 17:50:07 -04:00
jared cadce8d528 docs(peers): document cohort_year on cog_peer_compare return 2026-04-29 17:45:05 -04:00
jared a92450ff76 feat(peers): stamp cohort_year on cog_peer_compare results
Reads attr(peers, 'cohort_year') when the caller passed a cog_find_peers()
tibble; NA when the caller passed a bare character vector. Stamped as a
constant column on the result and recorded in provenance alongside the
cohort govids.
2026-04-29 17:44:25 -04:00
jared 54dd40a61d feat(peers): cog_find_peers uses per-year population
Adds optional 'year' argument (defaults to most recent observed year for
the target). Filters and ranks candidates by gov_population_yearly.population
at that year. Returned column renamed population_acs -> population.
Cohort year attached as attr(x, 'cohort_year').

Adds .resolve_cohort_year() helper. Updates test assertions to use
'population' column name. Regenerates man/cog_find_peers.Rd.
2026-04-29 17:26:32 -04:00
jared 807ed35cb7 test(peers): per-year cohort expectations (failing)
Three RED tests that drive Task 6's cog_find_peers() rewrite:
- defaults year to most recent observed (expects cohort_year attr + population column)
- honors explicit year= argument (expects cohort_year attr)
- errors with "no observed population" for unobserved year
2026-04-29 17:17:52 -04:00
jared 9ae46746c0 refactor(notes): simplify aggregate-fallback predicate in .notes_column
The plan-supplied predicate combined three redundant checks
(is.null + any + %in% TRUE). Element-wise behavior was correct via
scalar recycling, but the form was confusing — a code-quality reviewer
misread it as a multi-row false-positive bug. Simplify to mirror the
parts[[2]] structure: gate on column presence, then element-wise
%in% TRUE check. Equivalent semantics, fewer ways to misread.
2026-04-29 17:08:56 -04:00
jared 9238b04b69 feat(notes): concatenate notes; flag unavailable population
.notes_column now joins multiple per-row notes with '; '. Adds the
'No population denominator available for this gov type' note when
pop_source is 'unavailable'. Gracefully handles absent pop_source
(per_capita = FALSE). Two new tests: one corpus-level (census_f33
branch) and one synthetic unit test covering multi-note concatenation.
2026-04-29 17:03:05 -04:00
jared cbc867bed1 docs(per-capita): refresh roxygen for per-year denominator + pop_source 2026-04-29 16:58:27 -04:00
jared 4ea0583d3a feat(per-capita): use per-year F-33 population in spending verbs
cog_spending(per_capita = TRUE) and cog_revenue(per_capita = TRUE) now
divide each year's amount by that gov-year's population from
gov_population_yearly (drawn from long.population) instead of a single
static ACS 2018-2022 value. Adds pop_source column with values
'census_f33' or 'unavailable'.
2026-04-29 16:36:22 -04:00
jared e4a105013e test(spending): document fixture-pop origin in per-year-denominator test 2026-04-29 16:29:24 -04:00
jared 21b3d66c0e test(spending): per-year denominator expectation (failing)
Adds a RED test asserting that cog_spending(per_capita = TRUE) divides
by the per-year F-33 population (Broward 2019: 1,935,878; 2020: 1,952,778)
rather than the static ACS value (1,940,907). Uses absolute-tolerance
expect_true(abs(...) < 1) instead of expect_equal(tolerance=1) because
testthat 3 treats the tolerance argument as relative.
2026-04-29 16:20:41 -04:00
jared df3fe3731b test(views): document hardcoded fixture-pop origin in gov_population_yearly test 2026-04-29 15:37:05 -04:00
jared ed9658d267 feat(sql): add gov_population_yearly view
Exposes one row per (year, canonical_govid) drawn from long.population.
Used by per-capita denominators and peer matching.
2026-04-29 15:12:53 -04:00
jared a28fb2e19b chore(fixture): regenerate against cog_pipeline Layer 1 + Layer 2 fixes
Refreshes the bundled fixture corpus against the upstream resolver fix
(gate place-less fallback to states/counties only) and the Phase O
extended FIPS xwalk (post-2012 incorporations, Utah metro townships,
Connecticut planning regions). After regeneration:

- Salt Lake County now resolves to 20 distinct cities/townships instead
  of collapsing six into Midvale's canonical_govid.
- Zero govs with conflicting populations within (year, canonical_govid).
- 593 new fips_extended canonical_govids in the xwalk (377 cities, 214
  townships, 2 counties).
- Sentinel count drops from 20-39/year to 2-3/year (the residual
  reflects type-2/3 entities with GOVS legacy_id but no FIPS triplet —
  a separate gap, documented in cog_pipeline).

manifest.json updated with fresh SHAs, sizes, row counts, and pipeline
commit reference.

All 283 uscogdata tests pass against the new fixture.
2026-04-29 15:05:38 -04:00
jared 24e4449be7 docs(plan): per-year population denominator implementation plan
15-task TDD plan covering: gov_population_yearly view, .attach_per_capita
per-year join, pop_source column + multi-note concatenation, cog_find_peers
year arg, cog_peer_compare cohort_year, rollup unavailable-pop exclusion,
provenance updates, cog_explain rendering, vignette, cog_pipeline data
dictionary, and NEWS entry.

Also corrects spec to match existing rollup semantics (side-by-side, not
summed) and adds /plans to .Rbuildignore.
2026-04-29 09:40:05 -04:00
jared cfcda04e0c docs(spec): correct cog_peer_compare signature in per-year-pop spec
Existing function takes a peers argument (caller supplies cohort) rather
than building one internally. Cohort year flows through via an attr on
the peers tibble produced by cog_find_peers.
2026-04-29 09:17:24 -04:00
jared a25ba5f348 docs: spec for per-year population denominators
Design doc for switching cog_spending / cog_revenue / cog_geographic_rollup
per-capita calculations from a static ACS 2018-2022 population to per-year
F-33 population already present in long.population. Covers shifting peer
matching to a user-selectable cohort year (defaulting to most recent
observed year), type-4/5 NA policy, provenance updates, and a new vignette
enumerating denominator sources for future extensibility.

Specs live in /specs (added to .Rbuildignore) since docs/ is reserved for
pkgdown output.
2026-04-29 09:12:32 -04:00
jared e7fa51eec7 Merge pull request 'feat(search): basket mode for cog_gov_search()' (#1) from feat/cog-gov-search-basket-mode into main
R-CMD-check / check (push) Successful in 1m34s
2026-04-28 15:09:44 -04:00
64 changed files with 5240 additions and 234 deletions
+6
View File
@@ -10,3 +10,9 @@
^\.gitignore$ ^\.gitignore$
\.gitkeep$ \.gitkeep$
^vignettes$ ^vignettes$
^specs$
^plans$
^doc$
^Meta$
^\.gitea$
^CLAUDE\.md$
+2 -2
View File
@@ -31,5 +31,5 @@ Suggests:
Config/testthat/edition: 3 Config/testthat/edition: 3
VignetteBuilder: knitr VignetteBuilder: knitr
RoxygenNote: 7.3.3 RoxygenNote: 7.3.3
MinCorpusSchema: 3 MinCorpusSchema: 4
MaxCorpusSchema: 3 MaxCorpusSchema: 5
+2
View File
@@ -7,7 +7,9 @@ export(cog_explain)
export(cog_find_peers) export(cog_find_peers)
export(cog_geographic_rollup) export(cog_geographic_rollup)
export(cog_gov_search) export(cog_gov_search)
export(cog_manifest)
export(cog_mirror) export(cog_mirror)
export(cog_peer_compare) export(cog_peer_compare)
export(cog_recipes)
export(cog_revenue) export(cog_revenue)
export(cog_spending) export(cog_spending)
+79
View File
@@ -1,5 +1,84 @@
# uscogdata 0.1.0 (development) # uscogdata 0.1.0 (development)
## Breaking: corpus schema_version 4 (Phase P canonical ids)
* The package now requires corpus `schema_version = 4` (`MinCorpusSchema` /
`MaxCorpusSchema` in `DESCRIPTION` are both `4`); older corpora built
against schema 3 are rejected by `cog_open()` with a clear version-mismatch
error. `canonical_govid` is now uniformly 12 characters across every
vintage the corpus covers (previously a mix of 9-char legacy ids and
12-char FIPS ids depending on source year) — **every hardcoded
`canonical_govid` literal from a pre-Phase-P corpus is now invalid** and
must be re-resolved via `cog_gov_search()` or the new `canonical_alias`
lookup table. `canonical_fips_xwalk` gains four columns
(`legacy_govs_id`, `census_geoid`, `id_source`; `confidence` is renamed to
`pop_confidence`) and a companion `canonical_alias` table ships in the
corpus for mapping legacy/alternate ids onto the current canonical
namespace. The bundled fixture corpus (`inst/extdata/fixture_corpus/`) has
been regenerated against the Phase P publish tree, now ships the full
`canonical_fips_xwalk` and `canonical_alias` master tables alongside the
2019-2020 long partitions, and is reproducible via
`data-raw/regenerate_fixture_corpus.R`.
## Clearer errors when `USCOGDATA_URL` is unconfigured or returns non-JSON
* `cog_open()` now aborts with the `uscogdata_url_not_configured` error
class when the resolved corpus URL still contains the placeholder
`REPLACE_WITH_SHARE_TOKEN` sentinel (or is empty). The message lists both
remediation paths (`Sys.setenv(USCOGDATA_URL = ...)` and
`options(uscogdata.url = ...)`) and points at the bundled fixture for
offline testing. Previously the package proceeded to fetch the placeholder
URL, cached the resulting HTML welcome page, and failed downstream with a
cryptic `jsonlite` lexical-error.
* `.fetch_or_cache_manifest()` now parses the HTTP response body before
persisting it. Non-JSON responses (login pages, 404 HTML) raise
`uscogdata_invalid_manifest` with the URL, Content-Type, and underlying
parse error — and never write to the on-disk cache.
* Manifest cache writes are now atomic (write to `manifest.json.tmp.<pid>`
in `cache_dir`, then `file.rename` over the target), so an interrupted
fetch cannot replace a previously-good cache.
* Existing caches with non-JSON content (poisoned by the prior code path)
are silently refetched instead of returning a parse error to the caller.
* Local `USCOGDATA_URL` paths whose `manifest.json` is not valid JSON now
surface the same `uscogdata_invalid_manifest` class with file context.
## Per-capita denominators now use per-year Census F-33 population
* `cog_spending()` and `cog_revenue()` previously divided all years' amounts
by a single ACS 2018-2022 estimate (`canonical_fips_xwalk.population_acs`),
producing biased per-capita values for time-series analysis. They now
divide by the F-33 `population` recorded on each gov-year via the new
`gov_population_yearly` view. Result tibbles gain a `pop_source` column
with values `"census_f33"` or `"unavailable"`. `notes` is updated to
concatenate multiple notes with `"; "`.
## Peer cohorts can be set to a chosen year
* `cog_find_peers()` adds a `year` argument (default: most recent year for
which the target has an observed population in `gov_population_yearly`).
The returned column previously named `population_acs` is now `population`
and reflects the cohort year's vintage. The cohort year is attached to the
returned tibble as `attr(x, "cohort_year")`.
* `cog_peer_compare()` now stamps a `cohort_year` column on its result (read
from the peers tibble's attribute) and records `cohort_year` plus
`cohort_govids` in provenance. When the caller supplies a bare character
vector instead of a `cog_find_peers()` result, `cohort_year` is `NA`.
## Rollups exclude govs missing population
* `cog_geographic_rollup(per_capita = TRUE)` drops rows whose government has
`pop_source == "unavailable"` and records the dropped govids in
`provenance$rollup$excluded_govids`. This excludes special districts
(type 4) and school districts (type 5) from per-capita rollups by design.
## New: vignette and provenance metadata
* New vignette `population-denominators` covers the four population sources,
the type-4/5 coverage gap, the popyear quirk, and how to build moving-window
peer cohorts manually.
* Provenance gains `transformations$per_capita$popyear_range` and
`pop_source_counts`. `cog_explain()` renders both.
## New features ## New features
* `cog_gov_search()` gains a **basket mode**: passing vector `name` * `cog_gov_search()` gains a **basket mode**: passing vector `name`
+78
View File
@@ -0,0 +1,78 @@
# R/basis.R
# basis= resolution (harmonized/raw, with v4/v5 dual-accept) and the
# harmonization exclusion-count block attached to provenance.
#' Resolve the requested `basis` against the active corpus's schema_version.
#'
#' On a `schema_version >= 5` corpus, the requested basis is used as-is. On
#' an older (`schema_version == 4`) corpus, which has no harmonization
#' tables: a caller who left `basis` at its default (`"harmonized"`, so
#' `explicit` is `FALSE`) silently gets `"raw"` back, with a note recorded
#' for provenance; a caller who explicitly asked for
#' `basis = "harmonized"` gets a hard abort instead of a silent downgrade.
#'
#' @param basis `"harmonized"` or `"raw"` (already resolved via `match.arg`).
#' @param explicit `TRUE` if the caller passed `basis` explicitly (as
#' opposed to relying on the default `c("harmonized", "raw")`).
#' @param manifest The active session's parsed manifest list.
#' @return List with `basis` (the resolved value) and `note` (character or
#' `NA_character_`).
#' @noRd
.resolve_basis <- function(basis, explicit, manifest) {
schema_version <- suppressWarnings(as.integer(manifest$schema_version %||% 0L))
if (schema_version >= 5L) {
return(list(basis = basis, note = NA_character_))
}
if (identical(basis, "harmonized") && explicit) {
cli::cli_abort(c(
"basis = \"harmonized\" requires corpus schema_version >= 5.",
x = "Active corpus has schema_version {schema_version}.",
i = "Use basis = \"raw\" (the default on this corpus), or point USCOGDATA_URL at a schema_version >= 5 corpus."
), class = "uscogdata_basis_unsupported")
}
list(
basis = "raw",
note = sprintf(
"basis resolved to \"raw\": corpus schema_version %d < 5 (harmonization tables unavailable)",
schema_version
)
)
}
#' Count + sum item-level rows that basis="harmonized" excludes because they
#' carry no harmonized_code (discontinued / not-yet-ruled codes) within the
#' requested flow type (spending or revenue), govids, and years. Only
#' meaningful when the resolved basis is "harmonized"; returns an
#' applied = FALSE stub otherwise (raw basis never excludes rows this way).
#' @noRd
.build_harmonization_block <- function(con, govid, years, resolved, flow_prefixes) {
if (!identical(resolved$basis, "harmonized")) {
return(list(
applied = FALSE,
na_rows_excluded = 0L,
na_amount_excluded = 0,
note = resolved$note
))
}
sql <- sprintf(
"SELECT COUNT(*) AS n, COALESCE(SUM(amt), 0) * 1000.0 AS amt
FROM long
WHERE canonical_govid IN (%s) AND year IN (%s)
AND NOT is_aggregate AND harmonized_code IS NULL
AND LEFT(item_code, 1) IN (%s)",
.sql_lit_chr(govid), paste(as.integer(years), collapse = ","),
.sql_lit_chr(flow_prefixes)
)
na <- DBI::dbGetQuery(con, sql)
list(
applied = TRUE,
na_rows_excluded = as.integer(na$n),
na_amount_excluded = as.numeric(na$amt),
note = resolved$note
)
}
+86
View File
@@ -51,6 +51,15 @@ cog_explain <- function(result, format = c("print", "list")) {
cli::cli_text("Category: (all)") cli::cli_text("Category: (all)")
} }
if (!is.null(prov$basis)) {
note <- if (!is.null(prov$basis_note) && !is.na(prov$basis_note)) {
sprintf(" (%s)", prov$basis_note)
} else {
""
}
cli::cli_text("Basis: {prov$basis}{note}")
}
cli::cli_h2("Codes observed") cli::cli_h2("Codes observed")
codes <- prov$codes_summed$observed codes <- prov$codes_summed$observed
if (length(codes) == 0L) { if (length(codes) == 0L) {
@@ -66,6 +75,39 @@ cog_explain <- function(result, format = c("print", "list")) {
) )
} }
h <- prov$harmonization
if (!is.null(h) && isTRUE(h$applied)) {
cli::cli_h2("Harmonization")
cli::cli_text(
"Excluded {h$na_rows_excluded} row(s) with no harmonized_code (${format(h$na_amount_excluded, big.mark = ',')})"
)
}
rc <- prov$recipe
if (!is.null(rc)) {
cli::cli_h2("Recipe")
cli::cli_text("{rc$recipe_id}: {rc$label}")
comp_lines <- vapply(rc$components, function(x) {
sprintf("%s (%s, %s-%s, weight=%s)", x$component_code, x$gov_type_scope,
x$year_min, x$year_max, x$weight)
}, character(1))
cli::cli_ul(comp_lines)
}
if (length(prov$suggestions) > 0L) {
cli::cli_h2("Suggestions")
sugg_lines <- vapply(prov$suggestions, function(s) {
sprintf("%s -- %s (years %s-%s): %s", s$recipe_id, s$label,
s$available_years[1], s$available_years[2], s$hint)
}, character(1))
cli::cli_ul(sugg_lines)
}
if (length(prov$series_break_refs) > 0L) {
cli::cli_h2("Series breaks")
cli::cli_ul(.series_break_story_lines(prov$series_break_refs))
}
cli::cli_h2("Transformations") cli::cli_h2("Transformations")
uc <- prov$transformations$units_conversion uc <- prov$transformations$units_conversion
if (isTRUE(uc$applied)) { if (isTRUE(uc$applied)) {
@@ -74,6 +116,16 @@ cog_explain <- function(result, format = c("print", "list")) {
pc <- prov$transformations$per_capita pc <- prov$transformations$per_capita
if (isTRUE(pc$applied)) { if (isTRUE(pc$applied)) {
cli::cli_text("Per-capita denominator: {pc$denominator_source}") cli::cli_text("Per-capita denominator: {pc$denominator_source}")
if (length(pc$popyear_range) == 2L) {
lo <- .expand_popyear(pc$popyear_range[1])
hi <- .expand_popyear(pc$popyear_range[2])
cli::cli_text(" popyear range: {lo}-{hi}")
}
if (!is.null(pc$pop_source_counts)) {
cli::cli_text(
" pop_source counts: census_f33={pc$pop_source_counts$census_f33}, unavailable={pc$pop_source_counts$unavailable}"
)
}
} }
infl <- prov$transformations$inflation infl <- prov$transformations$inflation
if (isTRUE(infl$applied)) { if (isTRUE(infl$applied)) {
@@ -98,3 +150,37 @@ cog_explain <- function(result, format = c("print", "list")) {
invisible(NULL) invisible(NULL)
} }
# One "break-story" line per referenced break_id: "SB109 (2005): <join_advice>".
# Re-queries series_breaks_pq for the detail (break_year, join_advice) that
# provenance$series_break_refs deliberately doesn't carry (the schema keeps
# that field to a plain id array). Falls back to bare ids if no session is
# available (e.g. explaining a result after cog_close()) rather than
# erroring cog_explain() over a cosmetic detail.
#' @noRd
.series_break_story_lines <- function(break_ids) {
con <- tryCatch(.ensure_session(), error = function(e) NULL)
if (is.null(con) || !DBI::dbIsValid(con)) return(break_ids)
detail <- tryCatch(
DBI::dbGetQuery(con, sprintf(
"SELECT break_id, break_year, join_advice FROM series_breaks_pq
WHERE break_id IN (%s) ORDER BY break_id",
.sql_lit_chr(break_ids)
)),
error = function(e) NULL
)
if (is.null(detail) || nrow(detail) == 0L) return(break_ids)
sprintf("%s (%s): %s", detail$break_id, detail$break_year, detail$join_advice)
}
# Expand a 2-digit Census popyear (e.g. 19) to a 4-digit calendar year (2019).
# F-33 metadata stores popyear as 2 digits; pivot at 70 to handle a future
# corpus that ever spans pre-1970 vintages, though current scope is 2000+.
#' @noRd
.expand_popyear <- function(yy) {
yy <- as.integer(yy)
if (length(yy) == 0L || is.na(yy)) return(NA_integer_)
if (yy >= 100L) return(yy) # already 4-digit
if (yy < 70L) return(2000L + yy)
1900L + yy
}
+127 -10
View File
@@ -1,5 +1,66 @@
# R/manifest.R # R/manifest.R
# Sentinel substring baked into the placeholder default URL. If we see this
# in the resolved URL, the user hasn't configured USCOGDATA_URL yet.
.PLACEHOLDER_TOKEN <- "REPLACE_WITH_SHARE_TOKEN"
#' Abort with actionable guidance when the resolved corpus URL is still the
#' placeholder shipped with the package (or any URL containing the sentinel).
#' Called from `cog_open()` before any I/O so users see a clear message
#' instead of a downstream JSON parse error.
#' @noRd
.check_url_configured <- function(url) {
if (!is.character(url) || length(url) != 1L || !nzchar(url)) {
cli::cli_abort(c(
"USCOGDATA_URL is not configured.",
i = "Set the corpus location via one of:",
"*" = "{.code Sys.setenv(USCOGDATA_URL = \"<url-or-local-path>/\")}",
"*" = "{.code options(uscogdata.url = \"<url-or-local-path>/\")}",
i = "For an offline smoke test, use the bundled fixture: {.code system.file(\"extdata/fixture_corpus\", package = \"uscogdata\")}."
), class = "uscogdata_url_not_configured")
}
if (grepl(.PLACEHOLDER_TOKEN, url, fixed = TRUE)) {
sentinel <- .PLACEHOLDER_TOKEN
cli::cli_abort(c(
"USCOGDATA_URL is not configured (placeholder URL detected).",
x = "Current value contains the sentinel {.val {sentinel}}: {.url {url}}",
i = "Set the corpus location via one of:",
"*" = "{.code Sys.setenv(USCOGDATA_URL = \"<url-or-local-path>/\")}",
"*" = "{.code options(uscogdata.url = \"<url-or-local-path>/\")}",
i = "For an offline smoke test, use the bundled fixture: {.code system.file(\"extdata/fixture_corpus\", package = \"uscogdata\")}.",
i = "For the live Civilytics corpus, request the Nextcloud share URL from the package maintainer."
), class = "uscogdata_url_not_configured")
}
invisible(url)
}
#' Try to parse a JSON file. Returns parsed object on success, NULL on
#' any parse failure (so callers can decide whether to refetch).
#' @noRd
.try_parse_manifest_file <- function(path) {
tryCatch(
jsonlite::fromJSON(path, simplifyVector = FALSE),
error = function(e) NULL
)
}
#' Abort with a clear, classified error when a manifest payload (string or
#' file) cannot be parsed as JSON. Surfaces the URL, content-type if known,
#' and the underlying parse error.
#' @noRd
.abort_invalid_manifest <- function(source, content_type = NA_character_, parse_error = NULL) {
ct <- if (is.na(content_type) || !nzchar(content_type)) "<unknown>" else content_type
pmsg <- if (is.null(parse_error)) "" else conditionMessage(parse_error)
cli::cli_abort(c(
"Corpus manifest is not valid JSON.",
x = "Source: {source}",
i = "Content-Type: {ct}",
i = "Likely causes: USCOGDATA_URL points at a login page, a 404 HTML page, or the wrong share; or the corpus has not been published yet.",
i = "Set USCOGDATA_URL to a directory (local path or HTTPS) that serves manifest.json directly.",
if (nzchar(pmsg)) c(">" = "Parse error: {pmsg}") else NULL
), class = "uscogdata_invalid_manifest")
}
#' Fetch manifest.json from URL (or read from a local fixture path), #' Fetch manifest.json from URL (or read from a local fixture path),
#' cache locally, validate TTL. #' cache locally, validate TTL.
#' @noRd #' @noRd
@@ -11,23 +72,54 @@
if (!file.exists(local_manifest)) { if (!file.exists(local_manifest)) {
cli::cli_abort("Local fixture has no manifest.json at {local_manifest}") cli::cli_abort("Local fixture has no manifest.json at {local_manifest}")
} }
return(jsonlite::fromJSON(local_manifest, simplifyVector = FALSE)) return(tryCatch(
jsonlite::fromJSON(local_manifest, simplifyVector = FALSE),
error = function(e) .abort_invalid_manifest(source = local_manifest, parse_error = e)
))
} }
cache_path <- file.path(cache_dir, "manifest.json") cache_path <- file.path(cache_dir, "manifest.json")
ttl <- as.integer(.cfg("manifest_ttl_secs")) ttl <- as.integer(.cfg("manifest_ttl_secs"))
needs_fetch <- !file.exists(cache_path) || cache_fresh <- file.exists(cache_path) &&
difftime(Sys.time(), file.info(cache_path)$mtime, units = "secs") > ttl difftime(Sys.time(), file.info(cache_path)$mtime, units = "secs") <= ttl
# Honor a fresh cache only if its contents still parse as JSON. A previous
# version of this package could write HTML directly into the cache; treat
# such poisoned caches as if they were missing so the next call recovers.
if (cache_fresh) {
parsed <- .try_parse_manifest_file(cache_path)
if (!is.null(parsed)) return(parsed)
}
if (needs_fetch) {
resp <- httr2::request(paste0(url, "manifest.json")) |> resp <- httr2::request(paste0(url, "manifest.json")) |>
httr2::req_error(is_error = function(r) httr2::resp_status(r) >= 400) |> httr2::req_error(is_error = function(r) httr2::resp_status(r) >= 400) |>
httr2::req_perform() httr2::req_perform()
writeLines(httr2::resp_body_string(resp), cache_path) body <- httr2::resp_body_string(resp)
}
jsonlite::fromJSON(cache_path, simplifyVector = FALSE) # Parse BEFORE persisting. If the server returned HTML / a login page /
# any non-JSON body with a 2xx status, we must not write it to the cache.
parsed <- tryCatch(
jsonlite::fromJSON(body, simplifyVector = FALSE),
error = function(e) {
ct <- tryCatch(httr2::resp_content_type(resp), error = function(e2) NA_character_)
.abort_invalid_manifest(
source = paste0(url, "manifest.json"),
content_type = ct,
parse_error = e
)
}
)
# Atomic write: tmp file alongside cache_path (same filesystem -> no EXDEV)
# then rename. Ensures a partial write or interrupted process never
# replaces a previously-good cache.
if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE)
tmp <- paste0(cache_path, ".tmp.", Sys.getpid())
on.exit(if (file.exists(tmp)) unlink(tmp), add = TRUE)
writeLines(body, tmp)
file.rename(tmp, cache_path)
parsed
} }
#' @noRd #' @noRd
@@ -36,11 +128,21 @@
} }
#' @noRd #' @noRd
.validate_schema <- function(manifest, expected_version) { #' Schema v6 (FIPS geography harmonization, 2026-07-22) is accepted alongside
if (manifest$schema_version != expected_version) { #' 4/5. v6 renamed the long table's fips_state_code/fips_county_code to
#' fips_state_asof/fips_county_asof and added cog_legacy_state/
#' cog_legacy_county (26 -> 28 cols); this package references NONE of those
#' columns, so no code change was needed. NOTE the SILENT semantic change for
#' any consumer of the raw long table: long fips_state/fips_county are now
#' PRESENT/harmonized geography (current county identity carried back to every
#' year, matching canonical_fips_xwalk) rather than as-of-year; as-of-year
#' moved to the *_asof columns. This package's own geography always came from
#' the xwalk (already present-based), so behaviour is unchanged.
.validate_schema <- function(manifest, supported = c(4L, 5L, 6L)) {
if (!manifest$schema_version %in% supported) {
cli::cli_abort(c( cli::cli_abort(c(
"Corpus schema version mismatch.", "Corpus schema version mismatch.",
x = "Package expects schema_version = {expected_version}; corpus has {manifest$schema_version}.", x = "Package supports schema_version in {paste(supported, collapse = ', ')}; corpus has {manifest$schema_version}.",
i = "Update uscogdata (install.packages or pak::pkg_install) or re-publish corpus." i = "Update uscogdata (install.packages or pak::pkg_install) or re-publish corpus."
)) ))
} }
@@ -54,3 +156,18 @@
} }
`%||%` <- function(a, b) if (is.null(a) || (length(a) == 1 && is.na(a))) b else a `%||%` <- function(a, b) if (is.null(a) || (length(a) == 1 && is.na(a))) b else a
#' Return the parsed corpus manifest for the active session.
#'
#' Opens a session (connecting to the configured corpus) if none is active,
#' then returns the manifest exactly as parsed from `manifest.json`. Useful
#' for consumers that need the published year range (`years` block, schema
#' v5+) or the partition list without issuing a data query.
#'
#' @return Named list: `schema_version`, `built_at`, `pipeline_commit`,
#' `data_vintage`, `scope`, `years` (schema v5+), `schema`, `files`.
#' @export
cog_manifest <- function() {
.ensure_session()
.uscogdata_env$manifest
}
+87 -31
View File
@@ -2,31 +2,33 @@
#' Find peer governments by similarity criteria #' Find peer governments by similarity criteria
#' #'
#' Selects peer governments from `canonical_fips_xwalk` by combinations of #' Selects peer governments by combinations of government type, state, and
#' government type, state, and population range. Peers are ordered by #' population range at a chosen `year`. Peers are ordered by `|log(pop_ratio)|`
#' `|log(pop_ratio)|` ascending (closest to the target's population first). #' ascending (closest to the target's population first).
#' #'
#' @param target_govid Character scalar — `canonical_govid` of the target. #' @param target_govid Character scalar — `canonical_govid` of the target.
#' @param year Integer scalar. Cohort vintage. When `NULL` (default), uses the
#' most recent year for which the target has an observed population in
#' `gov_population_yearly`.
#' @param same_type If `TRUE` (default) restrict peers to the target's #' @param same_type If `TRUE` (default) restrict peers to the target's
#' `govs_type`. #' `govs_type`.
#' @param same_state If `TRUE` restrict peers to the target's `fips_state`. #' @param same_state If `TRUE` restrict peers to the target's `fips_state`.
#' Default `FALSE`. #' Default `FALSE`.
#' @param pop_range Length-2 numeric vector giving lower/upper bounds. #' @param pop_range Length-2 numeric vector giving lower/upper bounds.
#' @param is_ratio If `TRUE` (default) `pop_range` is multiplied by the #' @param is_ratio If `TRUE` (default) `pop_range` is multiplied by the
#' target's `population_acs` to produce absolute bounds. If `FALSE`, #' target's population at `year` to produce absolute bounds. If `FALSE`,
#' `pop_range` is interpreted as absolute population counts. #' `pop_range` is interpreted as absolute population counts.
#' @param pop_year Reserved for future use (selecting ACS vintage). Currently
#' the corpus has a single snapshot so this argument has no effect.
#' @param max_peers Integer cap on the number of peers returned. #' @param max_peers Integer cap on the number of peers returned.
#' @return Tibble with columns `canonical_govid`, `gov_name`, `fips_state`, #' @return Tibble with columns `canonical_govid`, `gov_name`, `fips_state`,
#' `population_acs`, `pop_ratio`, `rank`. #' `population`, `pop_ratio`, `rank`. The cohort year is attached as
#' `attr(x, "cohort_year")`.
#' @export #' @export
cog_find_peers <- function(target_govid, cog_find_peers <- function(target_govid,
year = NULL,
same_type = TRUE, same_type = TRUE,
same_state = FALSE, same_state = FALSE,
pop_range = c(0.7, 1.3), pop_range = c(0.7, 1.3),
is_ratio = TRUE, is_ratio = TRUE,
pop_year = NULL,
max_peers = 10L) { max_peers = 10L) {
if (!is.character(target_govid) || length(target_govid) != 1L) { if (!is.character(target_govid) || length(target_govid) != 1L) {
cli::cli_abort("`target_govid` must be a length-1 character string.") cli::cli_abort("`target_govid` must be a length-1 character string.")
@@ -35,58 +37,96 @@ cog_find_peers <- function(target_govid,
pop_range[1] >= pop_range[2]) { pop_range[1] >= pop_range[2]) {
cli::cli_abort("`pop_range` must be a length-2 numeric with lo < hi.") cli::cli_abort("`pop_range` must be a length-2 numeric with lo < hi.")
} }
if (!is.null(year) &&
(!(is.numeric(year) || is.integer(year)) || length(year) != 1L)) {
cli::cli_abort("`year` must be NULL or a length-1 integer.")
}
con <- .ensure_session() con <- .ensure_session()
target_sql <- sprintf( # Confirm target exists in the xwalk and pull govs_type / fips_state.
"SELECT canonical_govid, gov_name, govs_type, fips_state, population_acs meta_sql <- sprintf(
"SELECT canonical_govid, gov_name, govs_type, fips_state
FROM canonical_fips_xwalk FROM canonical_fips_xwalk
WHERE canonical_govid = %s", WHERE canonical_govid = %s",
.sql_lit_chr(target_govid) .sql_lit_chr(target_govid)
) )
target <- DBI::dbGetQuery(con, target_sql) meta <- DBI::dbGetQuery(con, meta_sql)
if (nrow(target) == 0L) { if (nrow(meta) == 0L) {
cli::cli_abort(c( cli::cli_abort(c(
"govid {target_govid} not found in corpus.", "govid {target_govid} not found in corpus.",
i = "v0.1 covers types 0-3 only (state/county/city/township); see vignette('coverage-scope')." i = "v0.1 covers types 0-3 only (state/county/city/township); see vignette('coverage-scope')."
)) ))
} }
if (is.na(target$population_acs) || target$population_acs <= 0) {
cli::cli_abort("Target {target_govid} has missing or non-positive population; cannot build pop_ratio band.") cohort_year <- .resolve_cohort_year(con, target_govid, year)
pop_sql <- sprintf(
"SELECT population FROM gov_population_yearly
WHERE canonical_govid = %s AND year = %d",
.sql_lit_chr(target_govid), as.integer(cohort_year)
)
target_pop <- DBI::dbGetQuery(con, pop_sql)$population
if (length(target_pop) == 0L || is.na(target_pop) || target_pop <= 0) {
cli::cli_abort(c(
"Target {target_govid} has no observed population in {cohort_year}.",
i = "Use a year for which population is observed; see gov_population_yearly."
))
} }
if (isTRUE(is_ratio)) { if (isTRUE(is_ratio)) {
lo <- target$population_acs * pop_range[1] lo <- target_pop * pop_range[1]
hi <- target$population_acs * pop_range[2] hi <- target_pop * pop_range[2]
} else { } else {
lo <- pop_range[1]; hi <- pop_range[2] lo <- pop_range[1]; hi <- pop_range[2]
} }
preds <- c( preds <- c(
sprintf("canonical_govid != %s", .sql_lit_chr(target_govid)), sprintf("p.canonical_govid != %s", .sql_lit_chr(target_govid)),
sprintf("population_acs BETWEEN %.6f AND %.6f", lo, hi) sprintf("p.year = %d", as.integer(cohort_year)),
sprintf("p.population BETWEEN %.6f AND %.6f", lo, hi)
) )
if (isTRUE(same_type)) preds <- c(preds, sprintf("govs_type = %d", target$govs_type)) if (isTRUE(same_type)) preds <- c(preds, sprintf("x.govs_type = %d", meta$govs_type))
if (isTRUE(same_state)) preds <- c(preds, sprintf("fips_state = %s", .sql_lit_chr(target$fips_state))) if (isTRUE(same_state)) preds <- c(preds, sprintf("x.fips_state = %s", .sql_lit_chr(meta$fips_state)))
peers_sql <- sprintf( peers_sql <- sprintf(
"SELECT canonical_govid, gov_name, fips_state, population_acs, "SELECT p.canonical_govid, x.gov_name, x.fips_state, p.population,
population_acs / %.6f AS pop_ratio p.population / %.6f AS pop_ratio
FROM canonical_fips_xwalk FROM gov_population_yearly p
JOIN canonical_fips_xwalk x USING (canonical_govid)
WHERE %s WHERE %s
ORDER BY ABS(LN(CAST(population_acs AS DOUBLE) / %.6f)) ORDER BY ABS(LN(CAST(p.population AS DOUBLE) / %.6f))
LIMIT %d", LIMIT %d",
target$population_acs, target_pop,
paste(preds, collapse = " AND "), paste(preds, collapse = " AND "),
target$population_acs, target_pop,
as.integer(max_peers) as.integer(max_peers)
) )
peers <- tibble::as_tibble(DBI::dbGetQuery(con, peers_sql)) peers <- tibble::as_tibble(DBI::dbGetQuery(con, peers_sql))
if (nrow(peers) > 0L) peers$rank <- seq_len(nrow(peers)) peers$rank <- if (nrow(peers) > 0L) seq_len(nrow(peers)) else integer(0)
else peers$rank <- integer(0) attr(peers, "cohort_year") <- as.integer(cohort_year)
attr(peers, "pop_range") <- as.numeric(pop_range)
attr(peers, "is_ratio") <- isTRUE(is_ratio)
peers peers
} }
#' @noRd
.resolve_cohort_year <- function(con, target_govid, year) {
if (!is.null(year)) return(as.integer(year))
sql <- sprintf(
"SELECT MAX(year) AS y FROM gov_population_yearly
WHERE canonical_govid = %s",
.sql_lit_chr(target_govid)
)
y <- DBI::dbGetQuery(con, sql)$y
if (length(y) == 0L || is.na(y)) {
cli::cli_abort(
"Target {target_govid} has no observed population in any year."
)
}
as.integer(y)
}
#' Compare a target government against a peer set #' Compare a target government against a peer set
#' #'
#' Pulls spending for the target plus a peer set (either a #' Pulls spending for the target plus a peer set (either a
@@ -105,9 +145,12 @@ cog_find_peers <- function(target_govid,
#' @param adjust_to_year Integer base year for CPI-U conversion or `NULL`. #' @param adjust_to_year Integer base year for CPI-U conversion or `NULL`.
#' @return Tibble matching [cog_spending()]'s columns, plus a `role` #' @return Tibble matching [cog_spending()]'s columns, plus a `role`
#' column taking values `"target"`, `"peer"`, `"summary_p25"`, #' column taking values `"target"`, `"peer"`, `"summary_p25"`,
#' `"summary_p50"`, or `"summary_p75"`, and `target_rank` (target's rank #' `"summary_p50"`, or `"summary_p75"`, `target_rank` (target's rank
#' among target+peers at `max(years)`, NA for other rows). Provenance #' among target+peers at `max(years)`, NA for other rows), and
#' attribute reports `verb = "cog_peer_compare"` and `peer_count`. #' `cohort_year` (the year used to build the peer cohort, read from
#' `attr(peers, "cohort_year")`; `NA` when `peers` was a bare character
#' vector). Provenance reports `verb = "cog_peer_compare"`, `peer_count`,
#' `cohort_year`, and `cohort_govids`.
#' @export #' @export
cog_peer_compare <- function(target_govid, peers, category, years, cog_peer_compare <- function(target_govid, peers, category, years,
per_capita = TRUE, adjust_to_year = NULL) { per_capita = TRUE, adjust_to_year = NULL) {
@@ -115,6 +158,14 @@ cog_peer_compare <- function(target_govid, peers, category, years,
if (!is.character(target_govid) || length(target_govid) != 1L) { if (!is.character(target_govid) || length(target_govid) != 1L) {
cli::cli_abort("`target_govid` must be a length-1 character string.") cli::cli_abort("`target_govid` must be a length-1 character string.")
} }
cohort_year <- if (is.data.frame(peers)) {
ay <- attr(peers, "cohort_year")
if (is.null(ay)) NA_integer_ else as.integer(ay)
} else {
NA_integer_
}
pop_range <- if (is.data.frame(peers)) attr(peers, "pop_range") else NULL
is_ratio <- if (is.data.frame(peers)) attr(peers, "is_ratio") else NULL
peer_govids <- if (is.data.frame(peers)) { peer_govids <- if (is.data.frame(peers)) {
as.character(peers$canonical_govid) as.character(peers$canonical_govid)
} else { } else {
@@ -132,11 +183,16 @@ cog_peer_compare <- function(target_govid, peers, category, years,
out <- dplyr::bind_rows(r, summary_rows) out <- dplyr::bind_rows(r, summary_rows)
rank_val <- .peer_target_rank(r, target_govid, years, value_col) rank_val <- .peer_target_rank(r, target_govid, years, value_col)
out$target_rank <- ifelse(out$role == "target", rank_val, NA_integer_) out$target_rank <- ifelse(out$role == "target", rank_val, NA_integer_)
out$cohort_year <- cohort_year
prov <- attr(r, "provenance") %||% list() prov <- attr(r, "provenance") %||% list()
prov$verb <- "cog_peer_compare" prov$verb <- "cog_peer_compare"
prov$call <- paste(deparse(call), collapse = " ") prov$call <- paste(deparse(call), collapse = " ")
prov$peer_count <- length(peer_govids) prov$peer_count <- length(peer_govids)
prov$cohort_year <- cohort_year
prov$cohort_govids <- peer_govids
prov$pop_range <- pop_range
prov$is_ratio <- is_ratio
prov$target <- list( prov$target <- list(
canonical_govid = target_govid, canonical_govid = target_govid,
gov_name = unique(r$gov_name[r$role == "target"]) gov_name = unique(r$gov_name[r$role == "target"])
+40 -3
View File
@@ -4,7 +4,10 @@
#' @noRd #' @noRd
.build_provenance <- function(verb, call, govid, years, category, .build_provenance <- function(verb, call, govid, years, category,
per_capita, adjust_to_year, result, sql, per_capita, adjust_to_year, result, sql,
subtype_col) { subtype_col, basis = NA_character_,
basis_note = NA_character_,
harmonization = NULL, recipe = NULL,
suggestions = list()) {
manifest <- .uscogdata_env$manifest manifest <- .uscogdata_env$manifest
codes <- result[["codes_included"]] codes <- result[["codes_included"]]
@@ -29,6 +32,14 @@
unique(result$gov_name) unique(result$gov_name)
} }
schema_version <- suppressWarnings(as.integer(manifest$schema_version %||% 0L))
con <- .uscogdata_env$con
break_refs <- if (!is.null(con) && DBI::dbIsValid(con)) {
.build_series_break_refs(con, codes_observed, years, schema_version)
} else {
character(0)
}
list( list(
verb = verb, verb = verb,
call = paste(deparse(call), collapse = " "), call = paste(deparse(call), collapse = " "),
@@ -38,6 +49,14 @@
), ),
years = as.integer(years), years = as.integer(years),
category = category, category = category,
basis = basis,
basis_note = basis_note,
harmonization = harmonization %||% list(
applied = FALSE, na_rows_excluded = 0L, na_amount_excluded = 0,
note = NA_character_
),
recipe = recipe,
suggestions = suggestions,
scope = list( scope = list(
gov_types_included = as.integer(unlist(manifest$scope$gov_types_included)), gov_types_included = as.integer(unlist(manifest$scope$gov_types_included)),
gov_types_excluded = as.integer(unlist(manifest$scope$gov_types_excluded)), gov_types_excluded = as.integer(unlist(manifest$scope$gov_types_excluded)),
@@ -61,9 +80,27 @@
per_capita = list( per_capita = list(
applied = isTRUE(per_capita), applied = isTRUE(per_capita),
denominator_source = if (isTRUE(per_capita)) { denominator_source = if (isTRUE(per_capita)) {
"ACS 2018-2022 B01003_001 (population_acs from canonical_fips_xwalk)" "Census F-33 population (per-year, from long.population)"
} else { } else {
NA_character_ NA_character_
},
popyear_range = if (isTRUE(per_capita)) {
attr(result, ".popyear_range") %||% integer(0)
} else {
integer(0)
},
pop_source_counts = if (isTRUE(per_capita)) {
ps <- result[["pop_source"]]
if (is.null(ps) || length(ps) == 0L) {
list(census_f33 = 0L, unavailable = 0L)
} else {
list(
census_f33 = sum(ps == "census_f33", na.rm = TRUE),
unavailable = sum(ps == "unavailable", na.rm = TRUE)
)
}
} else {
NULL
} }
), ),
inflation = list( inflation = list(
@@ -72,7 +109,7 @@
index = if (is.null(adjust_to_year)) NA_character_ else "CPI-U (BLS CPIAUCSL annual average, bundled)" index = if (is.null(adjust_to_year)) NA_character_ else "CPI-U (BLS CPIAUCSL annual average, bundled)"
) )
), ),
series_break_refs = character(0), series_break_refs = break_refs,
manifest = list( manifest = list(
schema_version = as.integer(manifest$schema_version), schema_version = as.integer(manifest$schema_version),
pipeline_commit = manifest$pipeline_commit %||% NA_character_, pipeline_commit = manifest$pipeline_commit %||% NA_character_,
+167
View File
@@ -0,0 +1,167 @@
# R/recipes.R
# Harmonization recipes: multi-code, cross-vintage series built by summing a
# fixed set of component item codes with per-component weights and
# year/gov-type scoping (see the `harmonization_recipes` view, registered
# from data/harmonization_recipes.parquet, schema_version >= 5 only).
#
# Recipes exist because some cross-vintage series can't be expressed as a
# 1:1 harmonized_code mapping (basis = "harmonized"): the wide era (pre-2012)
# publishes only a combined aggregate row for these families (e.g.
# corrections functions 04+05), while the modern era splits them into leaf
# codes. A recipe's generic join sums whichever of its component codes are
# present for a given year, so the resulting series is continuous across
# that format boundary.
#' List available harmonization recipes
#'
#' Recipes are multi-code cross-vintage series (see [cog_spending()]'s
#' `recipe` argument) catalogued in the corpus's `harmonization_recipes`
#' table. Use this to discover valid `recipe` ids.
#'
#' @param pattern Optional regex matched case-insensitively against
#' `recipe_id` or `label`.
#' @return Tibble with columns `recipe_id`, `label`, `n_components`,
#' `year_min`, `year_max` (the min/max component year coverage), sorted by
#' `recipe_id`.
#' @export
cog_recipes <- function(pattern = NULL) {
if (!is.null(pattern) &&
(!is.character(pattern) || length(pattern) != 1L)) {
cli::cli_abort("`pattern` must be a length-1 character string or NULL.")
}
con <- .ensure_session()
.require_schema_v5(con, .uscogdata_env$manifest, "cog_recipes()")
where <- if (is.null(pattern)) {
""
} else {
sprintf(
"WHERE regexp_matches(recipe_id, %1$s, 'i') OR regexp_matches(label, %1$s, 'i')",
.sql_lit_chr(pattern)
)
}
sql <- paste(
"SELECT recipe_id, any_value(label) AS label,
COUNT(*) AS n_components,
MIN(year_min) AS year_min, MAX(year_max) AS year_max
FROM harmonization_recipes",
where,
"GROUP BY recipe_id
ORDER BY recipe_id"
)
out <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
out$year_min <- as.integer(out$year_min)
out$year_max <- as.integer(out$year_max)
out$n_components <- as.integer(out$n_components)
out
}
#' Abort unless the active corpus has schema_version >= 5.
#' @noRd
.require_schema_v5 <- function(con, manifest, what) {
sv <- suppressWarnings(as.integer(manifest$schema_version %||% 0L))
if (sv < 5L) {
cli::cli_abort(c(
sprintf("%s requires corpus schema_version >= 5.", what),
x = "Active corpus has schema_version {sv}.",
i = "Point USCOGDATA_URL at a schema_version >= 5 corpus to use harmonization recipes."
), class = "uscogdata_schema_unsupported")
}
invisible(sv)
}
#' Abort with the valid id list unless `recipe_id` exists in the catalog.
#' @noRd
.validate_recipe_id <- function(con, recipe_id) {
ids <- DBI::dbGetQuery(
con, "SELECT DISTINCT recipe_id FROM harmonization_recipes"
)$recipe_id
if (!recipe_id %in% ids) {
cli::cli_abort(c(
"Unknown recipe = {.val {recipe_id}}.",
i = "Valid ids: {paste(sort(ids), collapse = ', ')}",
i = "See cog_recipes() for labels and year coverage."
), class = "uscogdata_unknown_recipe")
}
invisible(TRUE)
}
#' Fetch the component rows for one recipe (label, component codes, scope,
#' year ranges, weights) -- both for running the recipe and for the
#' `recipe` provenance block.
#' @noRd
.recipe_components <- function(con, recipe_id) {
sql <- sprintf(
"SELECT recipe_id, label, component_code, gov_type_scope,
year_min, year_max, weight, source_break_ids, notes
FROM harmonization_recipes
WHERE recipe_id = %s
ORDER BY component_code",
.sql_lit_chr(recipe_id)
)
tibble::as_tibble(DBI::dbGetQuery(con, sql))
}
#' Run a recipe's generic join: sum `amt * weight` across whichever
#' component codes are present for each (year, canonical_govid), scoped by
#' gov_type_scope. Deliberately does NOT filter `NOT is_aggregate`: in the
#' wide era (<= 2011) these families' component codes exist ONLY as
#' aggregate rows (leaves first appear 2012), so excluding aggregates would
#' zero out the wide-era half of every recipe. This is safe by corpus
#' construction -- wide-era rows for these codes are aggregate-only, modern
#' rows are leaf-only, and every component row is year-scoped via
#' `year_min`/`year_max` -- so there is no double-counting. (Checkpoint
#' review docs/phase_r_harmonization_review.md § 0.2.)
#' @noRd
.run_recipe <- function(con, recipe_id, govid, years) {
sql <- sprintf(
"SELECT l.year, l.canonical_govid,
COALESCE(x.gov_name, l.gov_name) AS gov_name,
SUM(l.amt * r.weight) * 1000.0 AS amt_nominal,
string_agg(DISTINCT l.item_code, ',' ORDER BY l.item_code) AS codes_included
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))
LEFT JOIN canonical_fips_xwalk x USING (canonical_govid)
WHERE r.recipe_id = %1$s
AND l.canonical_govid IN (%2$s)
AND l.year IN (%3$s)
GROUP BY 1, 2, 3
ORDER BY 1, 2",
.sql_lit_chr(recipe_id), .sql_lit_chr(govid),
paste(as.integer(years), collapse = ",")
)
result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
attr(result, "sql_query") <- sql
result
}
#' Shape a raw .run_recipe() result into the standard cog_spending()/
#' cog_revenue() column layout: subtype = "recipe", category = the recipe's
#' label, aggregate_fallback = FALSE (recipes resolve coverage gaps by
#' construction, not by falling back to an aggregate row).
#' @noRd
.shape_recipe_result <- function(result, subtype_col, label) {
sql_query <- attr(result, "sql_query")
n <- nrow(result)
result[[subtype_col]] <- rep("recipe", n)
result$category <- rep(label, n)
result$aggregate_fallback <- rep(FALSE, n)
result <- result[, c(
"year", "canonical_govid", "gov_name", subtype_col, "category",
"amt_nominal", "codes_included", "aggregate_fallback"
), drop = FALSE]
attr(result, "sql_query") <- sql_query
result
}
#' Turn a small data.frame into a list-of-lists (one list per row), the
#' shape used for the `recipe$components` provenance block.
#' @noRd
.df_to_row_list <- function(df) {
lapply(seq_len(nrow(df)), function(i) as.list(df[i, , drop = FALSE]))
}
+8 -4
View File
@@ -11,19 +11,23 @@
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`, #' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
#' `revenue_subtype`, `category`, `amt_nominal`, optional `amt_real`, #' `revenue_subtype`, `category`, `amt_nominal`, optional `amt_real`,
#' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`, #' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
#' `codes_included`, `aggregate_fallback`, `notes`. #' optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
#' @export #' @export
cog_revenue <- function(govid, years, category = NULL, cog_revenue <- function(govid, years, category = NULL,
per_capita = FALSE, adjust_to_year = NULL) { per_capita = FALSE, adjust_to_year = NULL,
basis = c("harmonized", "raw"), recipe = NULL) {
.verb_spendrev( .verb_spendrev(
verb = "cog_revenue", verb = "cog_revenue",
view = "revenue_annotated", view_base = "revenue_annotated",
subtype_col = "revenue_subtype", subtype_col = "revenue_subtype",
flow_prefixes = c("T", "A", "U", "B", "C", "D"),
call = match.call(), call = match.call(),
govid = govid, govid = govid,
years = years, years = years,
category = category, category = category,
per_capita = per_capita, per_capita = per_capita,
adjust_to_year = adjust_to_year adjust_to_year = adjust_to_year,
basis = basis,
recipe = recipe
) )
} }
+27 -7
View File
@@ -8,28 +8,35 @@
#' "place portraits" that compare a city to the surrounding county and #' "place portraits" that compare a city to the surrounding county and
#' containing state on one set of axes. #' containing state on one set of axes.
#' #'
#' When `per_capita = TRUE`, rows whose government has no observed
#' population in that year (`pop_source == "unavailable"`) are dropped from
#' the result. The dropped govids are recorded in
#' `provenance$rollup$excluded_govids`. This excludes special districts
#' (gov type 4) and school districts (gov type 5) from per-capita rollups
#' by design — see `vignette('population-denominators')`.
#'
#' @param govids Named list with any non-empty subset of elements named #' @param govids Named list with any non-empty subset of elements named
#' `state`, `county`, `city`. Each element is a character vector of #' `state`, `county`, `city`. Each element is a character vector of
#' `canonical_govid` values. At least one layer required. #' `canonical_govid` values. At least one layer required.
#' @param category Single category name or character vector (passed through #' @param category Single category name or character vector (passed through
#' to [cog_spending()]). #' to [cog_spending()]).
#' @param years Integer vector of years. #' @param years Integer vector of years.
#' @param per_capita If `TRUE`, per-capita uses each layer's own population #' @param per_capita If `TRUE`, per-capita uses each gov's own per-year
#' from `canonical_fips_xwalk.population_acs`. #' 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 adjust_to_year Integer base year for CPI-U conversion, or `NULL`.
#' @return Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`, #' @return Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real` / #' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
#' `amt_per_capita_nominal` / `amt_per_capita_real`, `codes_included`, #' `amt_per_capita_nominal` / `amt_per_capita_real`, optional `pop_source`,
#' `aggregate_fallback`, `scope_note`, `notes`. Carries a `provenance` #' `codes_included`, `aggregate_fallback`, `scope_note`, `notes`. Carries a
#' attribute with `verb = "cog_geographic_rollup"` and `layers`. #' `provenance` attribute with `verb = "cog_geographic_rollup"`, `layers`,
#' and `rollup$included_govids` / `rollup$excluded_govids`.
#' @export #' @export
cog_geographic_rollup <- function(govids, category, years, cog_geographic_rollup <- function(govids, category, years,
per_capita = FALSE, adjust_to_year = NULL) { per_capita = FALSE, adjust_to_year = NULL) {
call <- match.call() call <- match.call()
.validate_rollup_layers(govids) .validate_rollup_layers(govids)
# Accept character vector OR a data.frame with canonical_govid per layer,
# so cog_gov_search() output can be piped into one of the layer slots.
govids <- lapply(govids, .coerce_govid_input, arg = "govids[[layer]]") govids <- lapply(govids, .coerce_govid_input, arg = "govids[[layer]]")
if (any(lengths(govids) == 0L)) { if (any(lengths(govids) == 0L)) {
cli::cli_abort("Each layer in `govids` must be non-empty after coercion.") cli::cli_abort("Each layer in `govids` must be non-empty after coercion.")
@@ -45,12 +52,25 @@ cog_geographic_rollup <- function(govids, category, years,
r <- dplyr::left_join(r, layer_map, by = "canonical_govid", r <- dplyr::left_join(r, layer_map, by = "canonical_govid",
relationship = "many-to-many") relationship = "many-to-many")
r$scope_note <- .rollup_scope_note(r$layer) r$scope_note <- .rollup_scope_note(r$layer)
excluded <- character(0)
if (isTRUE(per_capita) && "pop_source" %in% names(r)) {
drop <- r$pop_source == "unavailable"
excluded <- unique(r$canonical_govid[drop])
r <- r[!drop, , drop = FALSE]
}
included <- unique(r$canonical_govid)
r <- .reorder_rollup_cols(r) r <- .reorder_rollup_cols(r)
prov <- attr(r, "provenance") prov <- attr(r, "provenance")
prov$verb <- "cog_geographic_rollup" prov$verb <- "cog_geographic_rollup"
prov$call <- paste(deparse(call), collapse = " ") prov$call <- paste(deparse(call), collapse = " ")
prov$layers <- layer_names prov$layers <- layer_names
prov$rollup <- list(
included_govids = included,
excluded_govids = excluded
)
attr(r, "provenance") <- prov attr(r, "provenance") <- prov
r r
+4 -3
View File
@@ -126,9 +126,10 @@ cog_gov_search <- function(name = NULL, state = NULL, type = NULL) {
canonical_govid = character(0), gov_name = character(0), canonical_govid = character(0), gov_name = character(0),
govs_type = integer(0), type_label = character(0), govs_type = integer(0), type_label = character(0),
fips_state = character(0), fips_county = character(0), fips_state = character(0), fips_county = character(0),
fips_place = character(0), first_year = integer(0), fips_place = character(0), legacy_govs_id = character(0),
last_year = integer(0), population_acs = integer(0), first_year = integer(0), last_year = integer(0),
confidence = character(0) census_geoid = character(0), population_acs = integer(0),
pop_confidence = character(0), id_source = character(0)
) )
} }
+22
View File
@@ -0,0 +1,22 @@
# R/series_breaks.R
# Populates prov$series_break_refs (schema in inst/schemas/provenance-v1.json
# defines the field; it was always present but always empty pre-Phase-R2)
# with the ids of any catalogued series break whose fin_code appears among
# the result's observed item codes and whose break_year falls inside the
# requested year span -- the "break warnings in the provenance envelope"
# spec § 5 promises downstream consumers (cog-api passes provenance through
# verbatim). schema_version >= 5 only: series_breaks_pq isn't registered on
# an older corpus.
#' @noRd
.build_series_break_refs <- function(con, codes_observed, years, schema_version) {
if (schema_version < 5L || length(codes_observed) == 0L) return(character(0))
sql <- sprintf(
"SELECT DISTINCT break_id
FROM series_breaks_pq
WHERE fin_code IN (%s) AND break_year BETWEEN %d AND %d
ORDER BY break_id",
.sql_lit_chr(codes_observed), min(as.integer(years)), max(as.integer(years))
)
DBI::dbGetQuery(con, sql)$break_id
}
+2 -1
View File
@@ -5,13 +5,14 @@
#' @noRd #' @noRd
cog_open <- function(url = .resolve_url(), cog_open <- function(url = .resolve_url(),
cache_dir = .resolve_cache_dir()) { cache_dir = .resolve_cache_dir()) {
.check_url_configured(url)
if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE) if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE)
con <- DBI::dbConnect(duckdb::duckdb()) con <- DBI::dbConnect(duckdb::duckdb())
DBI::dbExecute(con, "INSTALL httpfs; LOAD httpfs;") DBI::dbExecute(con, "INSTALL httpfs; LOAD httpfs;")
manifest <- .fetch_or_cache_manifest(url, cache_dir) manifest <- .fetch_or_cache_manifest(url, cache_dir)
.validate_schema(manifest, expected_version = 3L) .validate_schema(manifest, supported = c(4L, 5L, 6L))
.validate_scope(manifest) .validate_scope(manifest)
.register_views(con, url, manifest) .register_views(con, url, manifest)
+167 -25
View File
@@ -13,46 +13,101 @@
#' @param category Character vector of category names (from #' @param category Character vector of category names (from
#' `summary_categories.category`), or `NULL` for all categories. #' `summary_categories.category`), or `NULL` for all categories.
#' @param per_capita If `TRUE`, adds `amt_per_capita_nominal` (and #' @param per_capita If `TRUE`, adds `amt_per_capita_nominal` (and
#' `amt_per_capita_real` when `adjust_to_year` is set) using #' `amt_per_capita_real` when `adjust_to_year` is set) using the per-year
#' `population_acs` from the canonical xwalk. #' 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, #' @param adjust_to_year Integer base year for CPI-U real-dollar conversion,
#' or `NULL` for nominal only. #' 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. Ignored when `recipe`
#' is set (see below).
#' @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`. A recipe query bypasses
#' `basis` entirely (it joins `long` directly rather than going through
#' the `*_annotated`/`*_annotated_harmonized` views), so the `basis`
#' 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.
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`, #' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real`, #' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
#' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`, #' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
#' `codes_included`, `aggregate_fallback`, `notes`. Carries a `provenance` #' optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
#' attribute matching `inst/schemas/provenance-v1.json`. #' Carries a `provenance` attribute matching `inst/schemas/provenance-v1.json`.
#' @export #' @export
cog_spending <- function(govid, years, category = NULL, cog_spending <- function(govid, years, category = NULL,
per_capita = FALSE, adjust_to_year = NULL) { per_capita = FALSE, adjust_to_year = NULL,
basis = c("harmonized", "raw"), recipe = NULL) {
.verb_spendrev( .verb_spendrev(
verb = "cog_spending", verb = "cog_spending",
view = "spending_annotated", view_base = "spending_annotated",
subtype_col = "spend_subtype", subtype_col = "spend_subtype",
flow_prefixes = c("E", "F", "G", "K"),
call = match.call(), call = match.call(),
govid = govid, govid = govid,
years = years, years = years,
category = category, category = category,
per_capita = per_capita, per_capita = per_capita,
adjust_to_year = adjust_to_year adjust_to_year = adjust_to_year,
basis = basis,
recipe = recipe
) )
} }
#' @noRd #' @noRd
.verb_spendrev <- function(verb, view, subtype_col, call, .verb_spendrev <- function(verb, view_base, subtype_col, flow_prefixes, call,
govid, years, category, govid, years, category,
per_capita, adjust_to_year) { 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") govid <- .coerce_govid_input(govid, arg = "govid")
.validate_verb_inputs(govid, years, category, per_capita, adjust_to_year) .validate_verb_inputs(govid, years, category, per_capita, adjust_to_year,
recipe)
years <- as.integer(years) years <- as.integer(years)
if (!is.null(adjust_to_year)) adjust_to_year <- as.integer(adjust_to_year) if (!is.null(adjust_to_year)) adjust_to_year <- as.integer(adjust_to_year)
con <- .ensure_session() con <- .ensure_session()
manifest <- .uscogdata_env$manifest
scope <- .check_govids_in_scope(govid) 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) sql <- .build_verb_sql(view, subtype_col, govid, years, category)
result <- tibble::as_tibble(DBI::dbGetQuery(con, sql)) result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
}
if (per_capita) result <- .attach_per_capita(result, con, govid) if (per_capita) result <- .attach_per_capita(result, con, govid)
if (!is.null(adjust_to_year)) { if (!is.null(adjust_to_year)) {
@@ -61,27 +116,64 @@ cog_spending <- function(govid, years, category = NULL,
result$notes <- .notes_column(result) 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
# count (which is itself computed from `long`, independent of which view
# a non-recipe query used) would describe a code path this result never
# took. Rather than report a technically-still-computed but misleading
# basis = "harmonized"/"raw" + harmonization$applied combo, recipe
# results report basis = "recipe" and an explicit, inert harmonization
# block pointing at the `recipe` block instead. Task 12 (cog-api) passes
# provenance through verbatim, so this needs to be unambiguous rather
# than technically-defensible-but-confusing.
if (!is.null(recipe)) {
basis_for_prov <- "recipe"
basis_note_for_prov <- NA_character_
harmonization <- list(
applied = FALSE, na_rows_excluded = 0L, na_amount_excluded = 0,
note = "basis/harmonization not applicable to recipe results; see the recipe block instead"
)
suggestions <- list()
} else {
basis_for_prov <- resolved$basis
basis_note_for_prov <- resolved$note
harmonization <- .build_harmonization_block(
con, govid, years, resolved, flow_prefixes
)
suggestions <- .build_suggestions(con, govid, years, category, resolved$basis)
}
prov <- .build_provenance( prov <- .build_provenance(
verb = verb, verb = verb,
call = call, call = call,
govid = govid, govid = govid,
years = years, years = years,
category = category, category = category_for_prov,
per_capita = per_capita, per_capita = per_capita,
adjust_to_year = adjust_to_year, adjust_to_year = adjust_to_year,
result = result, result = result,
sql = sql, sql = sql,
subtype_col = subtype_col subtype_col = subtype_col,
basis = basis_for_prov,
basis_note = basis_note_for_prov,
harmonization = harmonization,
recipe = recipe_block,
suggestions = suggestions
) )
prov$scope$govids_found <- scope$found prov$scope$govids_found <- scope$found
prov$scope$govids_missing <- scope$missing prov$scope$govids_missing <- scope$missing
attr(result, "provenance") <- prov attr(result, "provenance") <- prov
attr(result, ".popyear_range") <- NULL
if (length(suggestions) > 0L) .inform_suggestions(suggestions)
result result
} }
#' @noRd #' @noRd
.validate_verb_inputs <- function(govid, years, category, .validate_verb_inputs <- function(govid, years, category,
per_capita, adjust_to_year) { per_capita, adjust_to_year, recipe = NULL) {
if (!is.character(govid) || length(govid) == 0L) { if (!is.character(govid) || length(govid) == 0L) {
cli::cli_abort("`govid` must be a non-empty character vector.") cli::cli_abort("`govid` must be a non-empty character vector.")
} }
@@ -100,9 +192,25 @@ cog_spending <- function(govid, years, category = NULL,
cli::cli_abort("`adjust_to_year` must be NULL or a length-1 integer.") 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) invisible(TRUE)
} }
#' @noRd
.select_view <- function(view_base, basis) {
if (identical(basis, "harmonized")) paste0(view_base, "_harmonized") else view_base
}
#' @noRd #' @noRd
.sql_lit_chr <- function(x) { .sql_lit_chr <- function(x) {
safe <- gsub("'", "''", x, fixed = TRUE) safe <- gsub("'", "''", x, fixed = TRUE)
@@ -143,18 +251,32 @@ cog_spending <- function(govid, years, category = NULL,
.attach_per_capita <- function(result, con, govid) { .attach_per_capita <- function(result, con, govid) {
if (nrow(result) == 0L) { if (nrow(result) == 0L) {
result$amt_per_capita_nominal <- numeric(0) result$amt_per_capita_nominal <- numeric(0)
result$pop_source <- character(0)
attr(result, ".popyear_range") <- integer(0)
return(result) return(result)
} }
years_lit <- paste(unique(as.integer(result$year)), collapse = ",")
sql <- sprintf( sql <- sprintf(
"SELECT canonical_govid, population_acs "SELECT canonical_govid, year, population, popyear
FROM canonical_fips_xwalk FROM gov_population_yearly
WHERE canonical_govid IN (%s)", WHERE canonical_govid IN (%s)
.sql_lit_chr(govid) AND year IN (%s)",
.sql_lit_chr(govid), years_lit
) )
pops <- tibble::as_tibble(DBI::dbGetQuery(con, sql)) pops <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
result <- dplyr::left_join(result, pops, by = "canonical_govid") result <- dplyr::left_join(result, pops,
result$amt_per_capita_nominal <- result$amt_nominal / result$population_acs by = c("canonical_govid", "year"))
result$population_acs <- NULL 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 result
} }
@@ -176,10 +298,30 @@ cog_spending <- function(govid, years, category = NULL,
#' @noRd #' @noRd
.notes_column <- function(result) { .notes_column <- function(result) {
if (nrow(result) == 0L) return(character(0)) n <- nrow(result)
ifelse( if (n == 0L) return(character(0))
isTRUE(result$aggregate_fallback) | result$aggregate_fallback %in% TRUE, parts <- vector("list", 2L)
agg <- result[["aggregate_fallback"]]
parts[[1]] <- if (!is.null(agg)) {
ifelse(agg %in% TRUE,
"Aggregate fallback applied; see cog_explain()", "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
} }
+215
View File
@@ -0,0 +1,215 @@
# R/suggestions.R
# Recipe-component-driven signposting: when a basis = "harmonized" query for
# 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
# suggested_recipe_id (the corpus's wide era exposes split families like
# corrections functions 04+05 ONLY as aggregate rows, which basis =
# "harmonized" excludes by construction -- there's no NA ruling to hang a
# 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 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), 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.
#' 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
.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)
))
}
#' 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
WHERE recipe_id IN (%s)
GROUP BY recipe_id",
.sql_lit_chr(candidates)
)))
}
#' 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
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(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 (!.recipe_component_gapped(rid, requested, present, covered, years_int)) next
m <- meta[meta$recipe_id == rid, ]
suggestions[[length(suggestions) + 1L]] <- list(
recipe_id = rid,
label = m$label[[1]],
available_years = c(as.integer(m$year_min), as.integer(m$year_max)),
hint = sprintf("re-run with recipe = '%s'", rid)
)
}
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.
#' @noRd
.inform_suggestions <- function(suggestions) {
bullets <- vapply(suggestions, function(s) {
sprintf("%s (%d-%d): %s", s$recipe_id,
s$available_years[1], s$available_years[2], s$hint)
}, character(1))
cli::cli_inform(c(
i = "Coverage gap detected for the requested years; a harmonization recipe may fill it:",
stats::setNames(bullets, rep("*", length(bullets)))
))
}
+23 -1
View File
@@ -1,11 +1,33 @@
# R/views.R # R/views.R
# SQL files whose view definitions read schema-v5-only parquet tables
# (harmonization_map.parquet, harmonization_recipes.parquet,
# 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",
"33-harmonization_map.sql",
"34-harmonization_recipes.sql",
"35-series_breaks_pq.sql",
"42-spending_annotated_harmonized.sql",
"43-revenue_annotated_harmonized.sql"
)
#' Register DuckDB views from inst/sql/ SQL files #' Register DuckDB views from inst/sql/ SQL files
#' @noRd #' @noRd
.register_views <- function(con, url, manifest) { .register_views <- function(con, url, manifest) {
sql_dir <- system.file("sql", package = "uscogdata") sql_dir <- system.file("sql", package = "uscogdata")
files <- list.files(sql_dir, pattern = "\\.sql$", full.names = TRUE) files <- sort(list.files(sql_dir, pattern = "\\.sql$", full.names = TRUE))
schema_version <- suppressWarnings(as.integer(manifest$schema_version %||% 0L))
for (f in files) { for (f in files) {
if (basename(f) %in% .harmonization_view_files && schema_version < 5L) next
sql <- paste(readLines(f, warn = FALSE), collapse = "\n") sql <- paste(readLines(f, warn = FALSE), collapse = "\n")
sql <- gsub("\\{url\\}", url, sql, fixed = FALSE) sql <- gsub("\\{url\\}", url, sql, fixed = FALSE)
DBI::dbExecute(con, sql) DBI::dbExecute(con, sql)
+16
View File
@@ -25,6 +25,22 @@ package implements.
- `USCOGDATA_CACHE_DIR` — optional override for the manifest cache directory - `USCOGDATA_CACHE_DIR` — optional override for the manifest cache directory
- `USCOGDATA_MANIFEST_TTL_SECS` — optional manifest re-fetch TTL (default 3600) - `USCOGDATA_MANIFEST_TTL_SECS` — optional manifest re-fetch TTL (default 3600)
## Raw-parquet caveat: `survey_weight` is not an aggregation weight
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 ## Developer notes
### Testing ### Testing
+563
View File
@@ -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")
}
+234
View File
@@ -0,0 +1,234 @@
# data-raw/regenerate_fixture_corpus.R
#
# Regenerate inst/extdata/fixture_corpus/ from a cog_pipeline publish tree.
#
# What this does:
# 1. Copies each requested year's long partition as-is (byte-for-byte)
# from <publish_cache>/data/long/ into the fixture. Default years are
# c(2011L, 2012L, 2019L, 2020L): 2011/2012 straddle the wide-aggregate
# -> modern-leaf format boundary (the harmonization/recipe seam), and
# 2019/2020 are the pre-existing per-capita/CPI regression anchors.
# Each partition is a full year (all states/govs) as published, so
# Broward County FL and every other previously-pinned government stay
# covered without any per-gov slicing logic.
# 2. Copies the full canonical_fips_xwalk.parquet, canonical_alias.parquet,
# summary_categories.parquet, harmonization_map.parquet,
# harmonization_recipes.parquet, and series_breaks.parquet metadata
# tables as-is (these are small cross-vintage registries, not
# partitioned by year, so the fixture ships the complete tables rather
# than a year-scoped subset).
# 3. Resyncs the four reference docs (data_dictionary.md,
# reader-specification.md, README.md, series_breaks.md) from the
# publish tree's docs/.
# 4. Hand-builds manifest.json for just the files the fixture ships,
# following the shape of the previous fixture manifest but with
# schema_version bumped to whatever the source manifest reports, and
# freshly computed sha256 / row_count / size_bytes for every fixture
# file (never copied from the source manifest, since paths and byte
# layout can differ subtly between a full corpus and a fixture).
#
# This is never a manual job: run it whenever cog_pipeline publishes a new
# corpus vintage that the fixture should track.
#
# Usage (from the uscogdata package root):
# Rscript data-raw/regenerate_fixture_corpus.R
# Rscript data-raw/regenerate_fixture_corpus.R /path/to/publish_cache
#
# Or from R:
# source("data-raw/regenerate_fixture_corpus.R")
# regenerate_fixture_corpus(publish_cache_dir = "/path/to/publish_cache")
regenerate_fixture_corpus <- function(
publish_cache_dir = file.path(
"..", "cog_pipeline", "_targets", "publish_cache"
),
fixture_dir = file.path("inst", "extdata", "fixture_corpus"),
fixture_years = c(2011L, 2012L, 2019L, 2020L)) {
stopifnot(
requireNamespace("digest", quietly = TRUE),
requireNamespace("jsonlite", quietly = TRUE),
requireNamespace("duckdb", quietly = TRUE),
requireNamespace("DBI", quietly = TRUE)
)
publish_cache_dir <- normalizePath(publish_cache_dir, mustWork = TRUE)
if (!dir.exists(fixture_dir)) dir.create(fixture_dir, recursive = TRUE)
source_manifest <- jsonlite::fromJSON(
file.path(publish_cache_dir, "manifest.json"),
simplifyVector = TRUE
)
.copy_long_partitions(publish_cache_dir, fixture_dir, fixture_years)
.copy_metadata_parquets(publish_cache_dir, fixture_dir)
.copy_docs(publish_cache_dir, fixture_dir)
manifest <- .build_fixture_manifest(
fixture_dir, source_manifest, fixture_years
)
manifest_path <- file.path(fixture_dir, "manifest.json")
writeLines(
jsonlite::toJSON(manifest, auto_unbox = TRUE, pretty = TRUE, null = "null"),
manifest_path
)
size_bytes <- sum(file.info(
list.files(fixture_dir, recursive = TRUE, full.names = TRUE)
)$size)
message(sprintf(
"Fixture corpus regenerated at %s (%.2f MB total).",
fixture_dir, size_bytes / 1024^2
))
invisible(manifest)
}
# Copy each requested year's partition directory (just the parquet file
# inside it) from the publish tree into the fixture, as-is.
#' @noRd
.copy_long_partitions <- function(publish_cache_dir, fixture_dir, years) {
for (yr in years) {
part_rel <- file.path("data", "long", sprintf("year=%d", yr), "part-0.parquet")
src <- file.path(publish_cache_dir, part_rel)
dst <- file.path(fixture_dir, part_rel)
if (!file.exists(src)) {
stop(sprintf("Source partition missing: %s", src))
}
dir.create(dirname(dst), recursive = TRUE, showWarnings = FALSE)
ok <- file.copy(src, dst, overwrite = TRUE)
if (!ok) stop(sprintf("Failed to copy %s -> %s", src, dst))
}
invisible(NULL)
}
# Copy the full (not year-scoped) canonical_fips_xwalk, canonical_alias,
# summary_categories, and (schema v5+) harmonization_map/
# harmonization_recipes/series_breaks parquet tables.
#' @noRd
.copy_metadata_parquets <- function(publish_cache_dir, fixture_dir) {
files <- c(
"canonical_fips_xwalk.parquet",
"canonical_alias.parquet",
"summary_categories.parquet",
"harmonization_map.parquet",
"harmonization_recipes.parquet",
"series_breaks.parquet"
)
for (f in files) {
src <- file.path(publish_cache_dir, "data", f)
dst <- file.path(fixture_dir, "data", f)
if (!file.exists(src)) {
stop(sprintf("Source metadata file missing: %s", src))
}
dir.create(dirname(dst), recursive = TRUE, showWarnings = FALSE)
ok <- file.copy(src, dst, overwrite = TRUE)
if (!ok) stop(sprintf("Failed to copy %s -> %s", src, dst))
}
invisible(NULL)
}
# Resync the four reference docs shipped alongside the fixture.
#' @noRd
.copy_docs <- function(publish_cache_dir, fixture_dir) {
docs <- c(
"data_dictionary.md", "reader-specification.md",
"README.md", "series_breaks.md"
)
dst_dir <- file.path(fixture_dir, "docs")
dir.create(dst_dir, recursive = TRUE, showWarnings = FALSE)
for (f in docs) {
src <- file.path(publish_cache_dir, "docs", f)
if (!file.exists(src)) {
stop(sprintf("Source doc missing: %s", src))
}
ok <- file.copy(src, file.path(dst_dir, f), overwrite = TRUE)
if (!ok) stop(sprintf("Failed to copy doc %s", f))
}
invisible(NULL)
}
# Count rows in a parquet file via an ephemeral DuckDB connection.
#' @noRd
.parquet_row_count <- function(path) {
con <- DBI::dbConnect(duckdb::duckdb())
on.exit(DBI::dbDisconnect(con, shutdown = TRUE), add = TRUE)
DBI::dbGetQuery(con, sprintf(
"SELECT COUNT(*) AS n FROM read_parquet(%s)",
.sql_quote(path)
))$n
}
#' @noRd
.sql_quote <- function(x) paste0("'", gsub("'", "''", x), "'")
# Hand-build manifest.json following the shape of the previous fixture
# manifest: schema_version / built_at / pipeline_commit / fixture_note /
# data_vintage / scope / schema / files.long_partitions / files.metadata /
# series_breaks_ref / reader_spec_ref. Every sha256 / row_count / size_bytes
# is freshly computed against the files actually written into fixture_dir.
#' @noRd
.build_fixture_manifest <- function(fixture_dir, source_manifest, years) {
long_partitions <- lapply(years, function(yr) {
rel <- file.path("data", "long", sprintf("year=%d", yr), "part-0.parquet")
path <- file.path(fixture_dir, rel)
list(
year = as.integer(yr),
path = gsub("\\\\", "/", rel),
sha256 = digest::digest(path, algo = "sha256", file = TRUE),
row_count = as.integer(.parquet_row_count(path)),
size_bytes = as.integer(file.info(path)$size)
)
})
metadata_files <- c(
"canonical_alias.parquet",
"canonical_fips_xwalk.parquet",
"summary_categories.parquet",
"harmonization_map.parquet",
"harmonization_recipes.parquet",
"series_breaks.parquet"
)
metadata <- lapply(metadata_files, function(f) {
rel <- file.path("data", f)
path <- file.path(fixture_dir, rel)
list(
path = gsub("\\\\", "/", rel),
sha256 = digest::digest(path, algo = "sha256", file = TRUE),
description = f
)
})
list(
schema_version = as.integer(source_manifest$schema_version),
built_at = format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ", tz = "UTC"),
pipeline_commit = source_manifest$pipeline_commit,
fixture_note = paste(
"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_manifest$data_vintage,
scope = source_manifest$scope,
schema = source_manifest$schema,
files = list(
long_partitions = long_partitions,
metadata = metadata
),
series_breaks_ref = source_manifest$series_breaks_ref,
reader_spec_ref = source_manifest$reader_spec_ref
)
}
if (identical(environment(), globalenv()) && sys.nframe() == 0L) {
args <- commandArgs(trailingOnly = TRUE)
if (length(args) >= 1L) {
regenerate_fixture_corpus(publish_cache_dir = args[[1]])
} else {
regenerate_fixture_corpus()
}
}
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
+63 -49
View File
@@ -1,83 +1,97 @@
{ {
"schema_version": 3, "schema_version": 6,
"built_at": "2026-04-27T16:43:46Z", "built_at": "2026-07-23T16:14:30Z",
"pipeline_commit": "899af37", "pipeline_commit": "4f992a0",
"fixture_note": "Two-year (2019-2020) fixture for uscogdata tests. Full corpus available via USCOGDATA_URL.", "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": { "data_vintage": {
"census_source_downloaded": "unknown", "source_vintages": {
"cpi_vintage": "FRED CPIAUCSL", "2012": "10162019",
"2013": "10162019",
"2014": "10162019",
"2015": "10162019",
"2016": "10162019",
"2017": "06102021",
"2018": "06102021",
"2019": "06102021",
"2020": "06122023",
"2021": "06122023",
"2022": "06052025",
"2023": "06052025"
},
"registry_rows": 148,
"acs_vintage": "ACS 2018-2022 5-year" "acs_vintage": "ACS 2018-2022 5-year"
}, },
"scope": { "scope": {
"gov_types_included": [ "gov_types_included": [0, 1, 2, 3],
0, "gov_types_excluded": [4, 5],
1,
2,
3
],
"gov_types_excluded": [
4,
5
],
"scope_note": "v0.1 covers state, county, city/municipality, and township governments. Special districts (type 4) and school districts (type 5) are excluded pending validation in a future cycle." "scope_note": "v0.1 covers state, county, city/municipality, and township governments. Special districts (type 4) and school districts (type 5) are excluded pending validation in a future cycle."
}, },
"schema": { "schema": {
"long_column_count": 24, "long_column_count": 28,
"long_columns": [ "long_columns": ["fips_state", "type", "fips_county", "govid", "gov_blank", "gov_name", "county_name", "fips_state_asof", "fips_county_asof", "cog_legacy_state", "cog_legacy_county", "fips_place_code", "population", "popyear", "enrollment", "enrollyear", "function_code", "sch_level_code", "fiscal_year_end", "srvy_year", "item_code", "amt", "srv_data", "impute_flag", "is_aggregate", "canonical_govid", "harmonized_code", "survey_weight"],
"fips_state",
"type",
"fips_county",
"govid",
"gov_blank",
"gov_name",
"county_name",
"fips_state_code",
"fips_county_code",
"fips_place_code",
"population",
"popyear",
"enrollment",
"enrollyear",
"function_code",
"sch_level_code",
"fiscal_year_end",
"srvy_year",
"item_code",
"amt",
"srv_data",
"impute_flag",
"is_aggregate",
"canonical_govid"
],
"data_dictionary": "docs/data_dictionary.md" "data_dictionary": "docs/data_dictionary.md"
}, },
"files": { "files": {
"long_partitions": [ "long_partitions": [
{
"year": 2011,
"path": "data/long/year=2011/part-0.parquet",
"sha256": "84302ab364dc9fc3b3fbbc3c3f8b826e3508b4d73ff7c42d094d3863cd1e37b5",
"row_count": 2864212,
"size_bytes": 3845911
},
{
"year": 2012,
"path": "data/long/year=2012/part-0.parquet",
"sha256": "b82ac82d5e35f844b26c887445601f3748438c52c998ba4e403b025941a6f170",
"row_count": 1163338,
"size_bytes": 5929917
},
{ {
"year": 2019, "year": 2019,
"path": "data/long/year=2019/part-0.parquet", "path": "data/long/year=2019/part-0.parquet",
"sha256": "e1c9f426c6d7d3c51d06b3a652473b987b304836619c213f019cee4887714daa", "sha256": "5cbd4726dcc7d0dab5c2a05a64702e979533ae119ed0587073cd31c089e0d737",
"row_count": 318139, "row_count": 318139,
"size_bytes": 1424231 "size_bytes": 1719548
}, },
{ {
"year": 2020, "year": 2020,
"path": "data/long/year=2020/part-0.parquet", "path": "data/long/year=2020/part-0.parquet",
"sha256": "9b795853a848e8c955c80261b96b79630fc77394dcfb1a1ca288e2cd634053a3", "sha256": "ee548fec80bf1beda844fe03916ac145f10dd34c45968407cc330ec260935f00",
"row_count": 317500, "row_count": 317500,
"size_bytes": 1427150 "size_bytes": 1722918
} }
], ],
"metadata": [ "metadata": [
{
"path": "data/canonical_alias.parquet",
"sha256": "3f617051c23a99bea322889857f7106df0c92954564afeec181df7083ee6698e",
"description": "canonical_alias.parquet"
},
{ {
"path": "data/canonical_fips_xwalk.parquet", "path": "data/canonical_fips_xwalk.parquet",
"sha256": "86e53e04a35f6f90bb74bb1a273e053392afa782d6f518e3e3da9c976d47f7af", "sha256": "f98742f941269dacf8f7de5c273aa4dd4e75017a5bb70c054da35852a95a8d46",
"description": "canonical_fips_xwalk.parquet" "description": "canonical_fips_xwalk.parquet"
}, },
{ {
"path": "data/summary_categories.parquet", "path": "data/summary_categories.parquet",
"sha256": "60045e22bc2723318fa2cb73f8e5038250dc54d24b3447c6750dfe29035335b8", "sha256": "8e6fcd4dd9bb4723841a67233b19388c9762dfc23b4479501183cebf7ea3c1b5",
"description": "summary_categories.parquet" "description": "summary_categories.parquet"
},
{
"path": "data/harmonization_map.parquet",
"sha256": "4cf32d0f817079ba4f28dc0ce65450d3247ebbf08d94c0c26c0d02af597bf812",
"description": "harmonization_map.parquet"
},
{
"path": "data/harmonization_recipes.parquet",
"sha256": "1133e9a0b02f8f34f5f936e55c5ecd596bb8a55d8425dcce76767f0f3203581c",
"description": "harmonization_recipes.parquet"
},
{
"path": "data/series_breaks.parquet",
"sha256": "b0b6794b6887a4f300079adfa10029c2a77109faa4952fbff1c5a270793cc02b",
"description": "series_breaks.parquet"
} }
] ]
}, },
+5
View File
@@ -10,6 +10,11 @@
"target": { "type": "object" }, "target": { "type": "object" },
"years": { "type": "array", "items": { "type": "integer" } }, "years": { "type": "array", "items": { "type": "integer" } },
"category": { "type": ["string", "array", "null"] }, "category": { "type": ["string", "array", "null"] },
"basis": { "type": ["string", "null"] },
"basis_note": { "type": ["string", "null"] },
"harmonization": { "type": "object" },
"recipe": { "type": ["object", "null"] },
"suggestions": { "type": "array" },
"scope": { "type": "object" }, "scope": { "type": "object" },
"codes_summed": { "type": "object" }, "codes_summed": { "type": "object" },
"aggregate_fallback": { "type": ["object", "null"] }, "aggregate_fallback": { "type": ["object", "null"] },
+6
View File
@@ -0,0 +1,6 @@
CREATE OR REPLACE VIEW spending_long_harmonized AS
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', 'K');
+6
View File
@@ -0,0 +1,6 @@
CREATE OR REPLACE VIEW revenue_long_harmonized AS
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 ('T', 'A', 'U', 'B', 'C', 'D');
+8
View File
@@ -0,0 +1,8 @@
CREATE OR REPLACE VIEW gov_population_yearly AS
SELECT DISTINCT
year,
canonical_govid,
population,
popyear
FROM long
WHERE population IS NOT NULL;
+3
View File
@@ -0,0 +1,3 @@
CREATE OR REPLACE VIEW harmonization_map AS
SELECT *
FROM read_parquet('{url}data/harmonization_map.parquet');
+3
View File
@@ -0,0 +1,3 @@
CREATE OR REPLACE VIEW harmonization_recipes AS
SELECT *
FROM read_parquet('{url}data/harmonization_recipes.parquet');
+3
View File
@@ -0,0 +1,3 @@
CREATE OR REPLACE VIEW series_breaks_pq AS
SELECT *
FROM read_parquet('{url}data/series_breaks.parquet');
@@ -0,0 +1,16 @@
CREATE OR REPLACE VIEW spending_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 spending_long_harmonized s
LEFT JOIN canonical_fips_xwalk x USING (canonical_govid)
LEFT JOIN summary_categories c USING (item_code);
@@ -0,0 +1,16 @@
CREATE OR REPLACE VIEW revenue_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.revenue_subtype
FROM revenue_long_harmonized s
LEFT JOIN canonical_fips_xwalk x USING (canonical_govid)
LEFT JOIN summary_categories c USING (item_code);
+11 -9
View File
@@ -6,17 +6,21 @@
\usage{ \usage{
cog_find_peers( cog_find_peers(
target_govid, target_govid,
year = NULL,
same_type = TRUE, same_type = TRUE,
same_state = FALSE, same_state = FALSE,
pop_range = c(0.7, 1.3), pop_range = c(0.7, 1.3),
is_ratio = TRUE, is_ratio = TRUE,
pop_year = NULL,
max_peers = 10L max_peers = 10L
) )
} }
\arguments{ \arguments{
\item{target_govid}{Character scalar — `canonical_govid` of the target.} \item{target_govid}{Character scalar — `canonical_govid` of the target.}
\item{year}{Integer scalar. Cohort vintage. When `NULL` (default), uses the
most recent year for which the target has an observed population in
`gov_population_yearly`.}
\item{same_type}{If `TRUE` (default) restrict peers to the target's \item{same_type}{If `TRUE` (default) restrict peers to the target's
`govs_type`.} `govs_type`.}
@@ -26,20 +30,18 @@ Default `FALSE`.}
\item{pop_range}{Length-2 numeric vector giving lower/upper bounds.} \item{pop_range}{Length-2 numeric vector giving lower/upper bounds.}
\item{is_ratio}{If `TRUE` (default) `pop_range` is multiplied by the \item{is_ratio}{If `TRUE` (default) `pop_range` is multiplied by the
target's `population_acs` to produce absolute bounds. If `FALSE`, target's population at `year` to produce absolute bounds. If `FALSE`,
`pop_range` is interpreted as absolute population counts.} `pop_range` is interpreted as absolute population counts.}
\item{pop_year}{Reserved for future use (selecting ACS vintage). Currently
the corpus has a single snapshot so this argument has no effect.}
\item{max_peers}{Integer cap on the number of peers returned.} \item{max_peers}{Integer cap on the number of peers returned.}
} }
\value{ \value{
Tibble with columns `canonical_govid`, `gov_name`, `fips_state`, Tibble with columns `canonical_govid`, `gov_name`, `fips_state`,
`population_acs`, `pop_ratio`, `rank`. `population`, `pop_ratio`, `rank`. The cohort year is attached as
`attr(x, "cohort_year")`.
} }
\description{ \description{
Selects peer governments from `canonical_fips_xwalk` by combinations of Selects peer governments by combinations of government type, state, and
government type, state, and population range. Peers are ordered by population range at a chosen `year`. Peers are ordered by `|log(pop_ratio)|`
`|log(pop_ratio)|` ascending (closest to the target's population first). ascending (closest to the target's population first).
} }
+15 -5
View File
@@ -22,17 +22,19 @@ to [cog_spending()]).}
\item{years}{Integer vector of years.} \item{years}{Integer vector of years.}
\item{per_capita}{If `TRUE`, per-capita uses each layer's own population \item{per_capita}{If `TRUE`, per-capita uses each gov's own per-year
from `canonical_fips_xwalk.population_acs`.} 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{adjust_to_year}{Integer base year for CPI-U conversion, or `NULL`.}
} }
\value{ \value{
Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`, Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real` / `spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
`amt_per_capita_nominal` / `amt_per_capita_real`, `codes_included`, `amt_per_capita_nominal` / `amt_per_capita_real`, optional `pop_source`,
`aggregate_fallback`, `scope_note`, `notes`. Carries a `provenance` `codes_included`, `aggregate_fallback`, `scope_note`, `notes`. Carries a
attribute with `verb = "cog_geographic_rollup"` and `layers`. `provenance` attribute with `verb = "cog_geographic_rollup"`, `layers`,
and `rollup$included_govids` / `rollup$excluded_govids`.
} }
\description{ \description{
Wraps [cog_spending()], tags each row with its layer, and attaches a Wraps [cog_spending()], tags each row with its layer, and attaches a
@@ -41,3 +43,11 @@ human-readable `scope_note` documenting geographic-scope caveats (e.g.
"place portraits" that compare a city to the surrounding county and "place portraits" that compare a city to the surrounding county and
containing state on one set of axes. containing state on one set of axes.
} }
\details{
When `per_capita = TRUE`, rows whose government has no observed
population in that year (`pop_source == "unavailable"`) are dropped from
the result. The dropped govids are recorded in
`provenance$rollup$excluded_govids`. This excludes special districts
(gov type 4) and school districts (gov type 5) from per-capita rollups
by design — see `vignette('population-denominators')`.
}
+18
View File
@@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/manifest.R
\name{cog_manifest}
\alias{cog_manifest}
\title{Return the parsed corpus manifest for the active session.}
\usage{
cog_manifest()
}
\value{
Named list: `schema_version`, `built_at`, `pipeline_commit`,
`data_vintage`, `scope`, `years` (schema v5+), `schema`, `files`.
}
\description{
Opens a session (connecting to the configured corpus) if none is active,
then returns the manifest exactly as parsed from `manifest.json`. Useful
for consumers that need the published year range (`years` block, schema
v5+) or the partition list without issuing a data query.
}
+6 -3
View File
@@ -31,9 +31,12 @@ population.}
\value{ \value{
Tibble matching [cog_spending()]'s columns, plus a `role` Tibble matching [cog_spending()]'s columns, plus a `role`
column taking values `"target"`, `"peer"`, `"summary_p25"`, column taking values `"target"`, `"peer"`, `"summary_p25"`,
`"summary_p50"`, or `"summary_p75"`, and `target_rank` (target's rank `"summary_p50"`, or `"summary_p75"`, `target_rank` (target's rank
among target+peers at `max(years)`, NA for other rows). Provenance among target+peers at `max(years)`, NA for other rows), and
attribute reports `verb = "cog_peer_compare"` and `peer_count`. `cohort_year` (the year used to build the peer cohort, read from
`attr(peers, "cohort_year")`; `NA` when `peers` was a bare character
vector). Provenance reports `verb = "cog_peer_compare"`, `peer_count`,
`cohort_year`, and `cohort_govids`.
} }
\description{ \description{
Pulls spending for the target plus a peer set (either a Pulls spending for the target plus a peer set (either a
+22
View File
@@ -0,0 +1,22 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/recipes.R
\name{cog_recipes}
\alias{cog_recipes}
\title{List available harmonization recipes}
\usage{
cog_recipes(pattern = NULL)
}
\arguments{
\item{pattern}{Optional regex matched case-insensitively against
`recipe_id` or `label`.}
}
\value{
Tibble with columns `recipe_id`, `label`, `n_components`,
`year_min`, `year_max` (the min/max component year coverage), sorted by
`recipe_id`.
}
\description{
Recipes are multi-code cross-vintage series (see [cog_spending()]'s
`recipe` argument) catalogued in the corpus's `harmonization_recipes`
table. Use this to discover valid `recipe` ids.
}
+33 -4
View File
@@ -9,7 +9,9 @@ cog_revenue(
years, years,
category = NULL, category = NULL,
per_capita = FALSE, per_capita = FALSE,
adjust_to_year = NULL adjust_to_year = NULL,
basis = c("harmonized", "raw"),
recipe = NULL
) )
} }
\arguments{ \arguments{
@@ -21,17 +23,44 @@ cog_revenue(
`summary_categories.category`), or `NULL` for all categories.} `summary_categories.category`), or `NULL` for all categories.}
\item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and \item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and
`amt_per_capita_real` when `adjust_to_year` is set) using `amt_per_capita_real` when `adjust_to_year` is set) using the per-year
`population_acs` from the canonical xwalk.} 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).}
\item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion, \item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion,
or `NULL` for nominal only.} or `NULL` for nominal only.}
\item{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. Ignored when `recipe`
is set (see below).}
\item{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`. A recipe query bypasses
`basis` entirely (it joins `long` directly rather than going through
the `*_annotated`/`*_annotated_harmonized` views), so the `basis`
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.}
} }
\value{ \value{
Tibble with columns `year`, `canonical_govid`, `gov_name`, Tibble with columns `year`, `canonical_govid`, `gov_name`,
`revenue_subtype`, `category`, `amt_nominal`, optional `amt_real`, `revenue_subtype`, `category`, `amt_nominal`, optional `amt_real`,
optional `amt_per_capita_nominal`, optional `amt_per_capita_real`, optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
`codes_included`, `aggregate_fallback`, `notes`. optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
} }
\description{ \description{
Mirror of [cog_spending()] for revenue categories. One row per Mirror of [cog_spending()] for revenue categories. One row per
+34 -5
View File
@@ -9,7 +9,9 @@ cog_spending(
years, years,
category = NULL, category = NULL,
per_capita = FALSE, per_capita = FALSE,
adjust_to_year = NULL adjust_to_year = NULL,
basis = c("harmonized", "raw"),
recipe = NULL
) )
} }
\arguments{ \arguments{
@@ -21,18 +23,45 @@ cog_spending(
`summary_categories.category`), or `NULL` for all categories.} `summary_categories.category`), or `NULL` for all categories.}
\item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and \item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and
`amt_per_capita_real` when `adjust_to_year` is set) using `amt_per_capita_real` when `adjust_to_year` is set) using the per-year
`population_acs` from the canonical xwalk.} 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).}
\item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion, \item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion,
or `NULL` for nominal only.} or `NULL` for nominal only.}
\item{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. Ignored when `recipe`
is set (see below).}
\item{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`. A recipe query bypasses
`basis` entirely (it joins `long` directly rather than going through
the `*_annotated`/`*_annotated_harmonized` views), so the `basis`
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.}
} }
\value{ \value{
Tibble with columns `year`, `canonical_govid`, `gov_name`, Tibble with columns `year`, `canonical_govid`, `gov_name`,
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real`, `spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
optional `amt_per_capita_nominal`, optional `amt_per_capita_real`, optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
`codes_included`, `aggregate_fallback`, `notes`. Carries a `provenance` optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
attribute matching `inst/schemas/provenance-v1.json`. Carries a `provenance` attribute matching `inst/schemas/provenance-v1.json`.
} }
\description{ \description{
One row per `(year, canonical_govid, spend_subtype, category)`. Amounts are One row per `(year, canonical_govid, spend_subtype, category)`. Amounts are
File diff suppressed because it is too large Load Diff
@@ -0,0 +1,285 @@
# Per-year population denominators in uscogdata
**Date:** 2026-04-29
**Status:** Design — pending implementation
**Scope:** uscogdata 0.1 (pre-release; no version bump)
**Related:** cog_pipeline (data dictionary updates)
## Problem
`uscogdata::cog_spending(per_capita = TRUE)` and `cog_revenue(per_capita = TRUE)`
currently divide every year's nominal amount by a single static population value
— `canonical_fips_xwalk.population_acs`, the ACS 2018-2022 5-year estimate.
For a 24-year corpus (2000–2023) this introduces a systematic bias proportional
to each government's population change over that span. Fast-growing places have
their early-year per-capita numbers understated; shrinking places have theirs
overstated. The bias commonly exceeds 20% and can exceed 50% for cities like
Detroit. Provenance currently advertises this denominator explicitly, so the
error is visible to careful users — but the default behavior produces wrong
numbers.
`cog_geographic_rollup()` has the same bug. `cog_find_peers()` /
`cog_peer_compare()` use the same static value to define peer cohorts, which
is defensible for matching but is no longer necessary now that per-year
population is available.
## Background — population sources
| Source | What it is | Where it lives |
|---|---|---|
| **Census F-33 `population`** | Population value Census uses on each COG row to compute its own per-capita tables. Almost always a Population Estimates Program (PEP) estimate; sometimes lagged a year for fiscal-year alignment, recorded in `popyear` | `long.population`, `long.popyear` (per row) |
| **PEP** (raw) | Census Bureau's official annual intercensal estimates. Distinct from F-33 because F-33 sometimes uses a lagged vintage | Not in corpus; available via tidycensus |
| **ACS 5-year** | American Community Survey 5-year rolling average. Different methodology, includes margin of error, only available 2005-2009 onward | `canonical_fips_xwalk.population_acs` (one fixed vintage) |
| **Decennial** | Actual count, every 10 years | Not in corpus |
F-33 `population` is the right default: it's what Census itself uses, so per-
capita results published by uscogdata reconcile with Census's own published
tables.
## Approach
Use the per-row `population` already present in `long`, joined on
`(canonical_govid, year)`. No new external data dependency. Coverage:
- **Types 0–3** (state, county, city, township): observed every year by design
- **Types 4–5** (special districts, schools): always NA — masked in
`cog_pipeline/R/read_modern.R` because the F-33 schema does not carry a
population value for these gov types
Type-4 and type-5 govs return `NA` per-capita with a `pop_source = "unavailable"`
flag and a note. No silent substitution.
The architecture leaves the door open for future denominators (PEP, ACS,
decennial) by surfacing `pop_source` as a first-class result column. Adding a
new source later is a join change, not an API change.
## Detailed design
### New view: `gov_population_yearly`
```sql
-- inst/sql/32-gov_population_yearly.sql
CREATE OR REPLACE VIEW gov_population_yearly AS
SELECT DISTINCT
year,
canonical_govid,
population,
popyear
FROM long
WHERE population IS NOT NULL;
```
`SELECT DISTINCT` collapses the metadata column duplicated across each gov-year's
item rows. A test asserts `(year, canonical_govid)` is unique to catch any
future source-data divergence.
### `cog_spending()` and `cog_revenue()`
`.attach_per_capita()` (in `R/spending.R`) is rewritten to:
1. Query `gov_population_yearly` for the requested govids and years.
2. `LEFT JOIN` on `(canonical_govid, year)` so missing rows produce NA.
3. Compute `amt_per_capita_nominal = amt_nominal / population`. NA when
population is NA.
4. Drop `population` from the returned tibble (keep `pop_source` instead).
Result tibble gains one new column when `per_capita = TRUE`:
- `pop_source`: `"census_f33"` when a denominator was found, `"unavailable"`
when NA.
`notes` is extended: when `pop_source == "unavailable"`, append
`"No population denominator available for this gov type"`. The `notes` column
is updated to concatenate multiple notes with `"; "` (it currently holds at
most one).
`amt_per_capita_real` is NA whenever `amt_per_capita_nominal` is NA.
### `cog_geographic_rollup()`
The current implementation does **not** sum amounts within a layer — it returns
one row per `(year, canonical_govid, subtype, category)` tagged with its
layer, intended for side-by-side "place portrait" comparisons (a city, the
county containing it, the state containing both). That semantics is preserved.
The only behavior change in this work is per-row exclusion when `per_capita = TRUE`:
1. After `cog_spending()` returns with the per-row per-year denominator from
Task 3, drop rows where `pop_source == "unavailable"` so the result never
contains NA per-capita rows.
2. Record the dropped `canonical_govid`s in `provenance$rollup$excluded_govids`
and the kept ones in `provenance$rollup$included_govids`.
Documentation states explicitly: *Per-capita rollups include only governments
observed in both the finance and population panels for the given year. Special
districts and school districts (gov types 4 and 5) are therefore excluded from
per-capita rollups by design.*
Provenance gains:
- `rollup.included_govids` — `canonical_govid`s present in the result
- `rollup.excluded_govids` — `canonical_govid`s dropped for missing pop
### `cog_find_peers()`
Signature: `cog_find_peers(target_govid, year = NULL, pop_range = c(0.5, 2), ...)`
- `year` is a single integer. When `NULL`, defaults to the most recent year
present in `gov_population_yearly` for the target.
- Looks up target's `population` at `year`. Errors if NA, with a message
listing nearby years where target *is* observed.
- Filters candidates by `gov_population_yearly.population` at the same `year`,
within `pop_range[1] * target_pop` and `pop_range[2] * target_pop`.
- Orders by `|log(pop_ratio)|` ascending.
Returned columns: `canonical_govid`, `gov_name`, `govs_type`, `fips_state`,
`population`, `pop_ratio`, `rank`. The column previously named `population_acs`
is renamed to `population`.
The cohort year is attached as a tibble attribute: `attr(x, "cohort_year")`.
### `cog_peer_compare()`
Existing signature unchanged:
`cog_peer_compare(target_govid, peers, category, years, per_capita = TRUE, adjust_to_year = NULL)`.
The caller supplies `peers` (either a `cog_find_peers()` result tibble or a
character vector of `canonical_govid`). The cohort year is implicit in
whichever year the caller used to call `cog_find_peers()`.
Behavior changes:
- When `peers` is a tibble carrying `attr(peers, "cohort_year")`,
`cog_peer_compare()` reads it and stamps every result row with a constant
`cohort_year` column.
- When `peers` is a bare character vector, `cohort_year` in the result is `NA`.
- Provenance gets `cohort_year` (scalar or NA) and the cohort govids list.
Users who want time-varying cohorts call `cog_find_peers()` per year and
stitch the `cog_peer_compare()` results themselves — documented in the
vignette with a worked example.
### Provenance updates
`provenance$transformations$per_capita` becomes:
```r
list(
applied = TRUE,
denominator_source = "Census F-33 population (per-year, from long.population)",
popyear_range = c(<min>, <max>),
pop_source_counts = list(census_f33 = N1, unavailable = N2)
)
```
For peer compare results, additional provenance:
```r
list(
cohort_year = <int>,
cohort_govids = <character>,
pop_range = c(<lo>, <hi>)
)
```
For rollup results, additional provenance:
```r
list(
rollup = list(
included_govids = <character>,
excluded_govids = <character>
)
)
```
`R/explain.R` is updated to render the new fields.
### Documentation
**New vignette** `vignettes/population-denominators.Rmd`:
1. The four population sources explained
2. Why F-33 is the default — and how it reconciles with Census's own per-capita
tables
3. The `popyear` quirk: Census sometimes uses a lagged estimate for fiscal-year
alignment. Recorded in provenance, not in the result.
4. Worked example showing the bias from the old static-ACS approach versus
per-year F-33 (e.g., Detroit 2003 vs. 2023)
5. Worked example of a rolling-cohort peer comparison built by looping
`cog_peer_compare()` per year
6. Future direction: `pop_source` is structured so PEP, ACS time-series, or
decennial denominators can be added later without API changes
**`cog_pipeline/docs/data_dictionary.md`** entry for `long.population` and
`long.popyear`: definition, source (F-33 fixed-width files, byte ranges),
type-4/5 masking rule, relationship to PEP.
### Tests
- `gov_population_yearly` returns one row per `(year, canonical_govid)` (uniqueness)
- `cog_spending(per_capita = TRUE)` returns different denominators for
different years for a known gov in the fixture (use any gov whose population
changes between 2019 and 2020)
- Type-4 and type-5 govids in the fixture return `pop_source = "unavailable"`
and `NA` per-capita with the expected note
- `cog_geographic_rollup(per_capita = TRUE)` excludes missing-pop govs and
records them in provenance
- `cog_find_peers()` defaults `year` to the most recent year for a target
with known population history
- `cog_find_peers()` errors with a helpful message when target has no observed
population in the requested year
- `cog_peer_compare()` defaults `cohort_year` and produces a result with a
constant `cohort_year` column
- Provenance carries `denominator_source`, `popyear_range`, and
`pop_source_counts`
- Regression test against a fixed govid+year showing the new per-capita value
differs from the old (static-ACS) by exactly the ratio of `population_acs`
to `long.population` for that gov-year
### Migration
Pre-release; no version bump. `NEWS.md` Unreleased entry:
> **Per-capita denominators now use per-year Census F-33 population.**
> Previously, `cog_spending()` and `cog_revenue()` divided all years' amounts
> by a single ACS 2018-2022 population, producing biased per-capita values
> for time-series. They now divide by the F-33 `population` recorded for each
> gov-year. Type-4 (special districts) and type-5 (school districts) govs
> return `NA` per-capita with `pop_source = "unavailable"`.
>
> **Peer matching now uses per-year population.** `cog_find_peers()` gains a
> `year` argument (defaults to most recent observed year). `cog_peer_compare()`
> gains `cohort_year`. Cohorts are still fixed for a single peer-compare call;
> users wanting moving cohorts loop themselves.
>
> **Rollups exclude govs with missing population.** `cog_geographic_rollup()`
> per-capita totals include only govs where both the finance variable and
> population are observed in that year; excluded govids are recorded in
> provenance.
>
> Returned column `population_acs` from `cog_find_peers()` is renamed to
> `population` and reflects the cohort-year vintage.
### File impact
| File | Change |
|---|---|
| `inst/sql/32-gov_population_yearly.sql` | New |
| `R/spending.R` (`.attach_per_capita`, `.notes_column`) | Per-year join, `pop_source`, multi-note concat |
| `R/peers.R` (`cog_find_peers`, `cog_peer_compare`) | `year` / `cohort_year` args, query new view, column rename |
| `R/rollup.R` | Skip-with-record for missing-pop govs |
| `R/provenance.R` | New denominator/cohort/rollup fields |
| `R/explain.R` | Render new fields |
| `vignettes/population-denominators.Rmd` | New |
| `tests/testthat/` | Per-year denominator, type-4/5, rollup exclusion, peer cohort, provenance |
| `cog_pipeline/docs/data_dictionary.md` | Document `long.population`, `long.popyear`, masking |
| `NEWS.md` | Unreleased entry |
## Out of scope
- PEP/ACS/decennial denominators — architected for, not implemented
- `per_pupil` denominator using `long.enrollment` for type-5 — deferred
- Covering-county fallback for type-4 — deliberately not done
- Backfilling population for type-4/5 from any external source
- Changes to `cog_explorer` callers — separate follow-up, after this lands
+31
View File
@@ -26,3 +26,34 @@ with_fixture_corpus <- function(code) {
}, add = TRUE) }, add = TRUE)
force(code) force(code)
} }
# Copy the bundled fixture to a temp dir with manifest.json's schema_version
# patched to `version`, then run `code` against it with a clean session
# (mirrors with_fixture_corpus()). Used to exercise the v4/v5 dual-accept
# path without a second physical fixture tree: a real v4 corpus has no
# harmonization_map/harmonization_recipes/series_breaks parquet files, but
# .register_views() only *reads* those when schema_version >= 5 (see
# R/views.R), so a doctored copy of the (v5) bundled fixture with the
# manifest's schema_version knocked down to 4 is a faithful stand-in.
with_doctored_schema_version <- function(version, code) {
src <- fixture_corpus_path()
tmp <- withr::local_tempdir(.local_envir = parent.frame())
file.copy(list.files(src, full.names = TRUE), tmp, recursive = TRUE)
manifest_path <- file.path(tmp, "manifest.json")
m <- jsonlite::fromJSON(manifest_path, simplifyVector = FALSE)
m$schema_version <- as.integer(version)
writeLines(
jsonlite::toJSON(m, auto_unbox = TRUE, pretty = TRUE, null = "null"),
manifest_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)
}
+7
View File
@@ -41,3 +41,10 @@ test_that(".inflate preserves NA amounts", {
expect_true(is.na(result[2])) expect_true(is.na(result[2]))
expect_false(any(is.na(result[c(1, 3)]))) expect_false(any(is.na(result[c(1, 3)])))
}) })
test_that("bundled CPI covers the full 1967+ corpus era through this year", {
cpi <- .cpi_table()
expect_lte(min(cpi$year), 1967L)
expect_gte(max(cpi$year), as.integer(format(Sys.Date(), "%Y")))
expect_false(any(is.na(cpi$cpi)))
})
+61 -4
View File
@@ -1,6 +1,6 @@
test_that("cog_explain prints verb header and target", { test_that("cog_explain prints verb header and target", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", 2020L, "Corrections") r <- cog_spending("121011212191", 2020L, "Corrections")
# cli writes to stderr; capture both stdout and message streams. # cli writes to stderr; capture both stdout and message streams.
txt <- paste(c( txt <- paste(c(
capture.output(cog_explain(r)), capture.output(cog_explain(r)),
@@ -8,19 +8,19 @@ test_that("cog_explain prints verb header and target", {
), collapse = "\n") ), collapse = "\n")
expect_true(grepl("cog_spending", txt)) expect_true(grepl("cog_spending", txt))
expect_true(grepl("Corrections", txt)) expect_true(grepl("Corrections", txt))
expect_true(grepl("101006006", txt)) expect_true(grepl("121011212191", txt))
}) })
test_that("cog_explain format='list' returns structured provenance", { test_that("cog_explain format='list' returns structured provenance", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", 2020L, "Corrections") r <- cog_spending("121011212191", 2020L, "Corrections")
prov <- cog_explain(r, format = "list") prov <- cog_explain(r, format = "list")
expect_identical(prov, attr(r, "provenance")) expect_identical(prov, attr(r, "provenance"))
}) })
test_that("cog_explain returns result invisibly for chaining", { test_that("cog_explain returns result invisibly for chaining", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", 2020L, "Corrections") r <- cog_spending("121011212191", 2020L, "Corrections")
res <- withVisible(cog_explain(r)) res <- withVisible(cog_explain(r))
expect_false(res$visible) expect_false(res$visible)
expect_identical(res$value, r) expect_identical(res$value, r)
@@ -30,3 +30,60 @@ test_that("cog_explain errors on non-verb input", {
df <- tibble::tibble(a = 1) df <- tibble::tibble(a = 1)
expect_error(cog_explain(df), "provenance") expect_error(cog_explain(df), "provenance")
}) })
test_that("cog_explain prints basis + harmonization block", {
skip_if_no_corpus()
r <- cog_spending("121011212191", 2020L, "Corrections")
txt <- paste(c(
capture.output(cog_explain(r)),
capture.output(cog_explain(r), type = "message")
), collapse = "\n")
expect_true(grepl("Basis: harmonized", txt))
expect_true(grepl("Harmonization", txt))
expect_true(grepl("Excluded 0 row", txt))
})
test_that("cog_explain prints a Recipe section for recipe = results", {
skip_if_no_corpus()
r <- cog_spending("121011212191", c(2011L, 2012L), recipe = "corrections_combined")
txt <- paste(c(
capture.output(cog_explain(r)),
capture.output(cog_explain(r), type = "message")
), collapse = "\n")
expect_true(grepl("Recipe", txt))
expect_true(grepl("corrections_combined", txt))
expect_true(grepl("E04", txt))
expect_true(grepl("E05", txt))
})
test_that("cog_explain prints a Suggestions section when the provenance has one", {
skip_if_no_corpus()
r <- suppressMessages(
cog_spending("121011212191", c(2011L, 2012L), category = "Corrections")
)
txt <- paste(c(
capture.output(cog_explain(r)),
capture.output(cog_explain(r), type = "message")
), collapse = "\n")
expect_true(grepl("Suggestions", txt))
expect_true(grepl("corrections_combined", txt))
expect_true(grepl("re-run with recipe", txt))
})
test_that("cog_explain prints denominator + popyear_range + counts", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", years = 2019:2020,
category = "Police", per_capita = TRUE)
out <- paste(c(
capture.output(cog_explain(r)),
capture.output(cog_explain(r), type = "message")
), collapse = "\n")
expect_true(grepl("Census F-33", out))
expect_true(grepl("popyear", out, ignore.case = TRUE))
expect_true(grepl("census_f33", out))
# popyear_range should render as 4-digit calendar years, not raw 2-digit
expect_true(grepl("2019-2020", out))
expect_false(grepl("popyear range: 19-20", out, fixed = TRUE))
})
})
+155
View File
@@ -0,0 +1,155 @@
# tests/testthat/test-manifest.R
#
# Tests for the guards on .fetch_or_cache_manifest() and cog_open() that
# protect users from silent failures when USCOGDATA_URL is misconfigured
# or returns non-JSON content.
test_that("cog_open aborts with actionable error when URL is the placeholder default", {
uscogdata:::cog_close()
on.exit(uscogdata:::cog_close(), add = TRUE)
placeholder <- "https://cloud.civilytics.org/s/REPLACE_WITH_SHARE_TOKEN/download/"
withr::with_envvar(c(USCOGDATA_URL = placeholder), {
expect_error(
uscogdata:::cog_open(),
class = "uscogdata_url_not_configured"
)
})
})
test_that("placeholder guard fires for any URL containing the sentinel token", {
uscogdata:::cog_close()
on.exit(uscogdata:::cog_close(), add = TRUE)
# Sentinel detection should be substring-based — covers any host that still
# has REPLACE_WITH_SHARE_TOKEN baked in (default or partial user edit).
withr::with_envvar(c(USCOGDATA_URL = "https://other.example/s/REPLACE_WITH_SHARE_TOKEN/x/"), {
expect_error(
uscogdata:::cog_open(),
class = "uscogdata_url_not_configured"
)
})
})
test_that("placeholder guard error names both env var and option as remediation", {
uscogdata:::cog_close()
on.exit(uscogdata:::cog_close(), add = TRUE)
placeholder <- "https://cloud.civilytics.org/s/REPLACE_WITH_SHARE_TOKEN/download/"
withr::with_envvar(c(USCOGDATA_URL = placeholder), {
msg <- tryCatch(uscogdata:::cog_open(), error = conditionMessage)
expect_match(msg, "USCOGDATA_URL", fixed = TRUE)
expect_match(msg, "uscogdata.url", fixed = TRUE)
})
})
test_that("local manifest containing HTML produces uscogdata_invalid_manifest, not raw parse error", {
uscogdata:::cog_close()
on.exit(uscogdata:::cog_close(), add = TRUE)
tmp <- withr::local_tempdir()
writeLines(
c("<html>", " <head><title>Welcome to our server</title></head>", "</html>"),
file.path(tmp, "manifest.json")
)
withr::with_envvar(c(USCOGDATA_URL = paste0(tmp, "/")), {
err <- expect_error(
uscogdata:::cog_open(),
class = "uscogdata_invalid_manifest"
)
expect_match(conditionMessage(err), "manifest", ignore.case = TRUE)
})
})
test_that("remote manifest fetch does not poison cache when response is HTML", {
uscogdata:::cog_close()
on.exit(uscogdata:::cog_close(), add = TRUE)
tmp_cache <- withr::local_tempdir()
cache_path <- file.path(tmp_cache, "manifest.json")
# Pretend the cache already exists with stale-but-fresh-by-mtime HTML
# (simulating a previous poisoned write from the old behavior). When the
# fetcher sees invalid JSON in the cache, it must refetch rather than
# silently returning a parse error to the caller.
writeLines("<html>poisoned</html>", cache_path)
Sys.setFileTime(cache_path, Sys.time()) # ensure within TTL
# We don't have a live HTTP fixture here, so the refetch will fail at the
# network layer — but the failure should NOT be a jsonlite parse error on
# the cached HTML; it should be a network-level httr2 error. The cache
# file itself must remain untouched (no atomic-write half-states).
withr::with_envvar(
c(
USCOGDATA_URL = "https://invalid.localhost.uscogdata.test/",
USCOGDATA_CACHE_DIR = tmp_cache
),
{
err <- tryCatch(uscogdata:::cog_open(), error = identity)
expect_s3_class(err, "error")
# Must not be a JSON lexical error on HTML.
expect_false(grepl("lexical error", conditionMessage(err), fixed = TRUE))
}
)
# Atomic write contract: no stray tmp files left behind in cache_dir.
expect_length(
list.files(tmp_cache, pattern = "manifest\\.json\\.tmp"),
0L
)
})
test_that("cog_manifest returns the active session's parsed manifest", {
with_fixture_corpus({
m <- cog_manifest()
expect_type(m, "list")
expect_true(m$schema_version >= 4L)
yrs <- vapply(m$files$long_partitions, function(p) as.integer(p$year),
integer(1))
expect_setequal(yrs, c(2011L, 2012L, 2019L, 2020L))
})
})
test_that(".validate_schema accepts schema_version 4, 5 and 6, rejects others", {
expect_silent(uscogdata:::.validate_schema(list(schema_version = 4L)))
expect_silent(uscogdata:::.validate_schema(list(schema_version = 5L)))
# v6 = FIPS geography harmonization (2026-07-22): _code -> _asof rename +
# cog_legacy_* columns (26 -> 28 cols). This package references none of the
# renamed columns and its geography comes from the xwalk, so v6 is accepted
# without behavioural change -- see .validate_schema()'s note.
expect_silent(uscogdata:::.validate_schema(list(schema_version = 6L)))
expect_error(
uscogdata:::.validate_schema(list(schema_version = 3L)),
"schema_version"
)
expect_error(
uscogdata:::.validate_schema(list(schema_version = 7L)),
"schema_version"
)
})
test_that("cog_open succeeds against a doctored schema_version 4 corpus (dual-accept)", {
skip_if_no_corpus()
with_doctored_schema_version(4L, {
con <- cog_open()
expect_true(DBI::dbIsValid(con))
expect_equal(as.integer(cog_manifest()$schema_version), 4L)
# Core (pre-Phase-R2) views must still register on a v4 corpus.
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("spending_annotated", "revenue_annotated") %in% views))
# Schema-v5-only harmonization views must NOT register on a v4 corpus:
# their parquet sources don't exist there and DuckDB's read_parquet()
# errors eagerly at CREATE VIEW time for a missing file/glob, so
# .register_views() gates these on manifest$schema_version >= 5.
expect_false(any(c(
"spending_long_harmonized", "spending_annotated_harmonized",
"harmonization_recipes", "harmonization_map", "series_breaks_pq"
) %in% views))
})
})
+2 -2
View File
@@ -61,7 +61,7 @@ test_that("cog_mirror reads back via a fresh session against the mirror", {
cog_close() cog_close()
options(uscogdata.url = paste0(normalizePath(tmp), "/")) options(uscogdata.url = paste0(normalizePath(tmp), "/"))
r <- cog_spending("101006006", 2020L, "Corrections") r <- cog_spending("121011212191", 2020L, "Corrections")
expect_gt(nrow(r), 0L) expect_gt(nrow(r), 0L)
expect_equal(unique(r$canonical_govid), "101006006") expect_equal(unique(r$canonical_govid), "121011212191")
}) })
+64 -16
View File
@@ -1,29 +1,29 @@
test_that("cog_find_peers returns same-type peers in the default pop band", { test_that("cog_find_peers returns same-type peers in the default pop band", {
skip_if_no_corpus() skip_if_no_corpus()
peers <- cog_find_peers("101006006") # Broward County peers <- cog_find_peers("121011212191") # Broward County
expect_s3_class(peers, "tbl_df") expect_s3_class(peers, "tbl_df")
expected_cols <- c("canonical_govid", "gov_name", "fips_state", expected_cols <- c("canonical_govid", "gov_name", "fips_state",
"population_acs", "pop_ratio", "rank") "population", "pop_ratio", "rank")
expect_true(all(expected_cols %in% names(peers))) expect_true(all(expected_cols %in% names(peers)))
expect_true(all(peers$pop_ratio >= 0.7 & peers$pop_ratio <= 1.3)) expect_true(all(peers$pop_ratio >= 0.7 & peers$pop_ratio <= 1.3))
expect_false("101006006" %in% peers$canonical_govid) expect_false("121011212191" %in% peers$canonical_govid)
expect_equal(peers$rank, seq_len(nrow(peers))) expect_equal(peers$rank, seq_len(nrow(peers)))
}) })
test_that("cog_find_peers respects same_state restriction", { test_that("cog_find_peers respects same_state restriction", {
skip_if_no_corpus() skip_if_no_corpus()
peers <- cog_find_peers("101006006", same_state = TRUE, peers <- cog_find_peers("121011212191", same_state = TRUE,
pop_range = c(0.1, 10)) pop_range = c(0.1, 10))
expect_true(all(peers$fips_state == "12")) expect_true(all(peers$fips_state == "12"))
}) })
test_that("cog_find_peers absolute pop range works", { test_that("cog_find_peers absolute pop range works", {
skip_if_no_corpus() skip_if_no_corpus()
peers <- cog_find_peers("101006006", peers <- cog_find_peers("121011212191",
pop_range = c(1.5e6, 2.5e6), pop_range = c(1.5e6, 2.5e6),
is_ratio = FALSE, max_peers = 20L) is_ratio = FALSE, max_peers = 20L)
expect_true(all(peers$population_acs >= 1.5e6 & expect_true(all(peers$population >= 1.5e6 &
peers$population_acs <= 2.5e6)) peers$population <= 2.5e6))
}) })
test_that("cog_find_peers errors cleanly on unknown govid", { test_that("cog_find_peers errors cleanly on unknown govid", {
@@ -33,8 +33,8 @@ test_that("cog_find_peers errors cleanly on unknown govid", {
test_that("cog_peer_compare accepts a cog_find_peers result directly", { test_that("cog_peer_compare accepts a cog_find_peers result directly", {
skip_if_no_corpus() skip_if_no_corpus()
peers <- cog_find_peers("101006006", max_peers = 4L) peers <- cog_find_peers("121011212191", max_peers = 4L)
r <- cog_peer_compare("101006006", peers, "Police", years = 2020L) r <- cog_peer_compare("121011212191", peers, "Police", years = 2020L)
expect_s3_class(r, "tbl_df") expect_s3_class(r, "tbl_df")
expect_true("role" %in% names(r)) expect_true("role" %in% names(r))
expect_setequal( expect_setequal(
@@ -47,8 +47,8 @@ test_that("cog_peer_compare accepts a cog_find_peers result directly", {
test_that("cog_peer_compare accepts a character vector of govids", { test_that("cog_peer_compare accepts a character vector of govids", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_peer_compare( r <- cog_peer_compare(
"101006006", "121011212191",
peers = c("441015015", "441220220"), # Bexar, Tarrant peers = c("481029175853", "481439135072"), # Bexar, Tarrant
category = "Police", years = 2020L category = "Police", years = 2020L
) )
expect_true("peer" %in% r$role) expect_true("peer" %in% r$role)
@@ -58,8 +58,8 @@ test_that("cog_peer_compare accepts a character vector of govids", {
test_that("cog_peer_compare summary rows use real per-capita when requested", { test_that("cog_peer_compare summary rows use real per-capita when requested", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_peer_compare( r <- cog_peer_compare(
"101006006", "121011212191",
peers = c("441015015", "441220220", "231082082"), peers = c("481029175853", "481439135072", "261163166615"),
category = "Police", years = 2019:2020, category = "Police", years = 2019:2020,
per_capita = TRUE, adjust_to_year = 2022L per_capita = TRUE, adjust_to_year = 2022L
) )
@@ -72,8 +72,8 @@ test_that("cog_peer_compare summary rows use real per-capita when requested", {
test_that("cog_peer_compare provenance reports the outer verb + peer count", { test_that("cog_peer_compare provenance reports the outer verb + peer count", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_peer_compare("101006006", r <- cog_peer_compare("121011212191",
peers = c("441015015", "441220220"), peers = c("481029175853", "481439135072"),
category = "Police", years = 2020L) category = "Police", years = 2020L)
prov <- attr(r, "provenance") prov <- attr(r, "provenance")
expect_equal(prov$verb, "cog_peer_compare") expect_equal(prov$verb, "cog_peer_compare")
@@ -82,9 +82,57 @@ test_that("cog_peer_compare provenance reports the outer verb + peer count", {
test_that("cog_peer_compare handles zero peers gracefully", { test_that("cog_peer_compare handles zero peers gracefully", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_peer_compare("101006006", r <- cog_peer_compare("121011212191",
peers = character(0), peers = character(0),
category = "Police", years = 2020L) category = "Police", years = 2020L)
expect_true(all(r$role == "target")) expect_true(all(r$role == "target"))
expect_equal(sum(grepl("^summary_", r$role)), 0L) expect_equal(sum(grepl("^summary_", r$role)), 0L)
}) })
test_that("cog_find_peers defaults `year` to most recent observed year for target", {
skip_if_no_corpus()
peers <- cog_find_peers("121011212191")
expect_equal(attr(peers, "cohort_year"), 2020L)
# Returned column is now `population`, not `population_acs`
expect_true("population" %in% names(peers))
expect_false("population_acs" %in% names(peers))
})
test_that("cog_find_peers honors an explicit `year`", {
skip_if_no_corpus()
peers <- cog_find_peers("121011212191", year = 2019L)
expect_equal(attr(peers, "cohort_year"), 2019L)
})
test_that("cog_find_peers errors when target has no observed pop in `year`", {
skip_if_no_corpus()
expect_error(
cog_find_peers("121011212191", year = 1999L),
"no observed population"
)
})
test_that("cog_peer_compare stamps cohort_year from peers attribute", {
skip_if_no_corpus()
peers <- cog_find_peers("121011212191", year = 2019L, max_peers = 4L,
pop_range = c(0.5, 1.5))
r <- cog_peer_compare("121011212191", peers, "Police", years = 2020L)
expect_true("cohort_year" %in% names(r))
expect_true(all(r$cohort_year == 2019L))
prov <- attr(r, "provenance")
expect_equal(prov$cohort_year, 2019L)
expect_equal(length(prov$cohort_govids), nrow(peers))
# pop_range and is_ratio propagate from cog_find_peers attrs
expect_equal(prov$pop_range, c(0.5, 1.5))
expect_true(prov$is_ratio)
})
test_that("cog_peer_compare cohort_year is NA for bare character peers", {
skip_if_no_corpus()
r <- cog_peer_compare(
"121011212191",
peers = c("481029175853", "481439135072"),
category = "Police", years = 2020L
)
expect_true(all(is.na(r$cohort_year)))
})
+312
View File
@@ -0,0 +1,312 @@
# tests/testthat/test-recipes.R
#
# cog_recipes(), recipe = in cog_spending()/cog_revenue(), and the
# recipe-component-driven signposting in prov$suggestions (Phase R2 /
# Task 11, schema_version 5).
test_that("cog_recipes lists the curated catalog including corrections_combined", {
skip_if_no_corpus()
r <- cog_recipes()
expect_s3_class(r, "tbl_df")
expect_equal(names(r), c("recipe_id", "label", "n_components", "year_min", "year_max"))
expect_equal(nrow(r), 24L)
expect_true("corrections_combined" %in% r$recipe_id)
expect_true("t19_selective_sales_wide" %in% r$recipe_id)
expect_true("ig_federal_b89_wide" %in% r$recipe_id)
expect_true("rents_royalties_u4_wide" %in% r$recipe_id)
expect_true("higher_ed_e18_wide" %in% r$recipe_id)
expect_true("cash_securities_z77_wide" %in% r$recipe_id)
# Superseded id from the pre-curation brief text must NOT be present.
expect_false("corrections_judicial_combined" %in% r$recipe_id)
})
test_that("cog_recipes(pattern=) filters by recipe_id or label", {
skip_if_no_corpus()
r <- cog_recipes("corrections")
expect_true(nrow(r) >= 1L)
expect_true(all(grepl("corrections", r$recipe_id, ignore.case = TRUE) |
grepl("corrections", r$label, ignore.case = TRUE)))
})
test_that("cog_recipes requires schema_version >= 5", {
skip_if_no_corpus()
with_doctored_schema_version(4L, {
expect_error(cog_recipes(), class = "uscogdata_schema_unsupported")
})
})
# --- recipe = : generic join, no is_aggregate filter -----------------------
test_that("recipe = 'corrections_combined' is continuous across the 2011->2012 seam", {
skip_if_no_corpus()
r <- cog_spending("121011212191", years = c(2011L, 2012L),
recipe = "corrections_combined")
expect_equal(nrow(r), 2L)
expect_true(all(c("year", "canonical_govid", "gov_name", "spend_subtype",
"category", "amt_nominal", "codes_included",
"aggregate_fallback", "notes") %in% names(r)))
expect_equal(unique(r$spend_subtype), "recipe")
expect_equal(unique(r$category), "Corrections (functions 04+05 combined)")
expect_false(any(r$aggregate_fallback))
r2011 <- r$amt_nominal[r$year == 2011L]
r2012 <- r$amt_nominal[r$year == 2012L]
# 2011: E05 only exists as a wide-era AGGREGATE row (is_aggregate = TRUE)
# for Broward -- data-verified $216,088,000. Since .run_recipe() does NOT
# filter is_aggregate (amendment: the recipe join must not, because these
# families exist ONLY as aggregate rows in the wide era), the recipe
# correctly picks this up.
expect_equal(r2011, 216088000)
# 2012: modern E04 leaf ($213,056,000); Broward reports no E05 leaf that
# year, so the recipe total equals E04 alone -- still continuous with the
# 2011 aggregate, proving the wide-aggregate -> modern-leaf handoff.
expect_equal(r2012, 213056000)
expect_true(all(grepl("E04|E05", r$codes_included)))
})
test_that("recipe result carries a recipe provenance block with component rows", {
skip_if_no_corpus()
r <- cog_spending("121011212191", years = c(2011L, 2012L),
recipe = "corrections_combined")
prov <- attr(r, "provenance")
expect_equal(prov$basis, "recipe")
expect_equal(prov$category, "Corrections (functions 04+05 combined)")
expect_type(prov$recipe, "list")
expect_equal(prov$recipe$recipe_id, "corrections_combined")
expect_equal(prov$recipe$label, "Corrections (functions 04+05 combined)")
expect_length(prov$recipe$components, 2L)
comp_codes <- vapply(prov$recipe$components, function(x) x$component_code, character(1))
expect_setequal(comp_codes, c("E04", "E05"))
# A recipe query resolves its own coverage; it should never also carry
# suggestions for itself.
expect_length(prov$suggestions, 0L)
})
test_that("recipe results report an unambiguous basis/harmonization, ignoring basis=", {
skip_if_no_corpus()
# A recipe query bypasses spending_annotated(_harmonized) entirely --
# .run_recipe() joins `long` directly -- so `basis` must never read
# "harmonized"/"raw" (which would describe a code path this query never
# took) regardless of what the caller passed for `basis`. Task 12
# consumes provenance verbatim, so this needs to be unambiguous.
r_default <- cog_spending("121011212191", years = c(2011L, 2012L),
recipe = "corrections_combined")
r_raw <- cog_spending("121011212191", years = c(2011L, 2012L),
recipe = "corrections_combined", basis = "raw")
r_harm <- cog_spending("121011212191", years = c(2011L, 2012L),
recipe = "corrections_combined", basis = "harmonized")
for (r in list(r_default, r_raw, r_harm)) {
prov <- attr(r, "provenance")
expect_equal(prov$basis, "recipe")
expect_true(is.na(prov$basis_note))
expect_false(prov$harmonization$applied)
expect_equal(prov$harmonization$na_rows_excluded, 0L)
expect_match(prov$harmonization$note, "recipe", ignore.case = TRUE)
}
# basis= truly has zero effect on a recipe query's actual numbers.
expect_equal(r_raw$amt_nominal, r_harm$amt_nominal)
expect_equal(r_default$amt_nominal, r_raw$amt_nominal)
})
test_that("recipe = 't19_selective_sales_wide' sums the local T11/T14 legs when present", {
skip_if_no_corpus()
# Westminster City, CA (canonical_govid 082001211654): T11 = 0 in 2011,
# T11 = 568 (T14 = 0/absent) in 2012 -- a real, data-verified equality/
# inequality pair inside the amended fixture window (2011-2012), standing
# in for the brief's original 2004/2005 example (out of scope per the
# amended fixture years; the underlying local-tax-split boundary is
# nationally FY2005, but this government's own T11 reporting activates
# within our 2011-2012 window).
r <- cog_revenue("082001211654", years = c(2011L, 2012L),
recipe = "t19_selective_sales_wide")
# Raw, single-code T19 total (not the "Other Taxes" category total, which
# would also sum in T11/T14/T21/T23/T27/T29/T53/T99 -- queried directly to
# isolate exactly the code the brief's equality/inequality check is about).
con <- uscogdata:::.ensure_session()
raw_t19 <- DBI::dbGetQuery(con, "
SELECT year, SUM(amt) * 1000.0 AS amt
FROM revenue_long
WHERE canonical_govid = '082001211654' AND item_code = 'T19'
AND year IN (2011, 2012)
GROUP BY year ORDER BY year
")
raw_t19_2011 <- raw_t19$amt[raw_t19$year == 2011L]
raw_t19_2012 <- raw_t19$amt[raw_t19$year == 2012L]
expect_equal(raw_t19_2011, 2231000)
expect_equal(raw_t19_2012, 2365000)
recipe_2011 <- r$amt_nominal[r$year == 2011L]
recipe_2012 <- r$amt_nominal[r$year == 2012L]
expect_equal(recipe_2011, raw_t19_2011) # equality: no local T11/T14 yet
expect_gt(recipe_2012, raw_t19_2012) # inequality: local T11 joins in
expect_equal(recipe_2012, raw_t19_2012 + 568000)
})
test_that("recipe = and category = together aborts", {
skip_if_no_corpus()
expect_error(
cog_spending("121011212191", 2020L, category = "Corrections",
recipe = "corrections_combined"),
class = "uscogdata_recipe_category_conflict"
)
})
test_that("unknown recipe id aborts and lists valid ids", {
skip_if_no_corpus()
err <- tryCatch(
cog_spending("121011212191", 2020L, recipe = "does_not_exist"),
error = identity
)
expect_s3_class(err, "uscogdata_unknown_recipe")
expect_match(conditionMessage(err), "corrections_combined")
})
test_that("recipe = requires schema_version >= 5", {
skip_if_no_corpus()
with_doctored_schema_version(4L, {
expect_error(
cog_spending("121011212191", 2020L, recipe = "corrections_combined"),
class = "uscogdata_schema_unsupported"
)
})
})
# --- 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()
expect_message(
r <- cog_spending("121011212191", years = c(2011L, 2012L),
category = "Corrections"),
"recipe"
)
prov <- attr(r, "provenance")
expect_true(length(prov$suggestions) >= 1L)
ids <- vapply(prov$suggestions, function(s) s$recipe_id, character(1))
expect_true("corrections_combined" %in% ids)
hit <- prov$suggestions[[which(ids == "corrections_combined")]]
expect_equal(hit$hint, "re-run with recipe = 'corrections_combined'")
expect_equal(hit$available_years, c(1967L, 2023L))
})
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)
})
test_that("no signposting when category is NULL (unscoped query)", {
skip_if_no_corpus()
r <- cog_spending("121011212191", years = c(2011L, 2012L))
prov <- attr(r, "provenance")
expect_length(prov$suggestions, 0L)
})
test_that("no signposting under basis = 'raw'", {
skip_if_no_corpus()
r <- cog_spending("121011212191", years = c(2011L, 2012L),
category = "Corrections", basis = "raw")
prov <- attr(r, "provenance")
expect_length(prov$suggestions, 0L)
})
+22 -5
View File
@@ -1,24 +1,24 @@
test_that("cog_revenue returns expected shape for Broward Property Tax 2020", { test_that("cog_revenue returns expected shape for Broward Property Tax 2020", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_revenue("101006006", years = 2020L, category = "Property Tax") r <- cog_revenue("121011212191", years = 2020L, category = "Property Tax")
expect_s3_class(r, "tbl_df") expect_s3_class(r, "tbl_df")
expected_cols <- c("year", "canonical_govid", "gov_name", "revenue_subtype", expected_cols <- c("year", "canonical_govid", "gov_name", "revenue_subtype",
"category", "amt_nominal", "codes_included", "category", "amt_nominal", "codes_included",
"aggregate_fallback", "notes") "aggregate_fallback", "notes")
expect_true(all(expected_cols %in% names(r))) expect_true(all(expected_cols %in% names(r)))
expect_equal(unique(r$canonical_govid), "101006006") expect_equal(unique(r$canonical_govid), "121011212191")
expect_equal(unique(r$year), 2020L) expect_equal(unique(r$year), 2020L)
}) })
test_that("cog_revenue with no category filter returns multiple categories", { test_that("cog_revenue with no category filter returns multiple categories", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_revenue("101006006", years = 2020L) r <- cog_revenue("121011212191", years = 2020L)
expect_gt(length(unique(r$category)), 1L) expect_gt(length(unique(r$category)), 1L)
}) })
test_that("cog_revenue with per_capita + adjust_to_year adds all columns", { test_that("cog_revenue with per_capita + adjust_to_year adds all columns", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_revenue("101006006", 2020L, r <- cog_revenue("121011212191", 2020L,
per_capita = TRUE, adjust_to_year = 2022L) per_capita = TRUE, adjust_to_year = 2022L)
expect_true(all(c("amt_nominal", "amt_real", expect_true(all(c("amt_nominal", "amt_real",
"amt_per_capita_nominal", "amt_per_capita_real") %in% "amt_per_capita_nominal", "amt_per_capita_real") %in%
@@ -27,7 +27,7 @@ test_that("cog_revenue with per_capita + adjust_to_year adds all columns", {
test_that("cog_revenue result has provenance attribute", { test_that("cog_revenue result has provenance attribute", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_revenue("101006006", 2020L) r <- cog_revenue("121011212191", 2020L)
prov <- attr(r, "provenance") prov <- attr(r, "provenance")
expect_equal(prov$verb, "cog_revenue") expect_equal(prov$verb, "cog_revenue")
expect_true(grepl("revenue_annotated", prov$sql_query)) expect_true(grepl("revenue_annotated", prov$sql_query))
@@ -36,3 +36,20 @@ test_that("cog_revenue result has provenance attribute", {
test_that("cog_revenue rejects invalid inputs", { test_that("cog_revenue rejects invalid inputs", {
expect_error(cog_revenue(list(), 2020L), "character|data frame") expect_error(cog_revenue(list(), 2020L), "character|data frame")
}) })
test_that("cog_revenue basis = 'harmonized' (default) matches 'raw' in this fixture window", {
skip_if_no_corpus()
r_raw <- cog_revenue("121011212191", 2019:2020, basis = "raw")
r_harm <- cog_revenue("121011212191", 2019:2020, basis = "harmonized")
expect_equal(attr(r_raw, "provenance")$basis, "raw")
expect_equal(attr(r_harm, "provenance")$basis, "harmonized")
expect_equal(sum(r_raw$amt_nominal), sum(r_harm$amt_nominal))
})
test_that("cog_revenue provenance carries the harmonization block", {
skip_if_no_corpus()
r <- cog_revenue("121011212191", 2020L)
h <- attr(r, "provenance")$harmonization
expect_true(h$applied)
expect_true(h$na_rows_excluded >= 0L)
})
+49 -11
View File
@@ -2,9 +2,9 @@ test_that("cog_geographic_rollup aggregates state + county + city layers", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_geographic_rollup( r <- cog_geographic_rollup(
govids = list( govids = list(
state = "100000000", # Florida state govt state = "120000226351", # Florida state govt
county = "101006006", # Broward County county = "121011212191", # Broward County
city = "102006004" # Fort Lauderdale City city = "122011161585" # Fort Lauderdale City
), ),
category = "Police", category = "Police",
years = 2019:2020 years = 2019:2020
@@ -23,7 +23,7 @@ test_that("cog_geographic_rollup aggregates state + county + city layers", {
test_that("cog_geographic_rollup respects per_capita + adjust_to_year", { test_that("cog_geographic_rollup respects per_capita + adjust_to_year", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_geographic_rollup( r <- cog_geographic_rollup(
govids = list(county = "101006006", city = "102006004"), govids = list(county = "121011212191", city = "122011161585"),
category = "Police", category = "Police",
years = 2020L, years = 2020L,
per_capita = TRUE, per_capita = TRUE,
@@ -43,8 +43,8 @@ test_that("cog_geographic_rollup respects per_capita + adjust_to_year", {
test_that("cog_geographic_rollup scope_notes describe each layer", { test_that("cog_geographic_rollup scope_notes describe each layer", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_geographic_rollup( r <- cog_geographic_rollup(
govids = list(state = "100000000", county = "101006006", govids = list(state = "120000226351", county = "121011212191",
city = "102006004"), city = "122011161585"),
category = "Police", years = 2020L category = "Police", years = 2020L
) )
state_notes <- unique(r$scope_note[r$layer == "state"]) state_notes <- unique(r$scope_note[r$layer == "state"])
@@ -58,7 +58,7 @@ test_that("cog_geographic_rollup scope_notes describe each layer", {
test_that("cog_geographic_rollup single-layer call works", { test_that("cog_geographic_rollup single-layer call works", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_geographic_rollup( r <- cog_geographic_rollup(
govids = list(county = c("101006006")), govids = list(county = c("121011212191")),
category = "Corrections", category = "Corrections",
years = 2020L years = 2020L
) )
@@ -69,7 +69,7 @@ test_that("cog_geographic_rollup single-layer call works", {
test_that("cog_geographic_rollup provenance reports the outer verb", { test_that("cog_geographic_rollup provenance reports the outer verb", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_geographic_rollup( r <- cog_geographic_rollup(
govids = list(state = "100000000", county = "101006006"), govids = list(state = "120000226351", county = "121011212191"),
category = "Police", years = 2020L category = "Police", years = 2020L
) )
prov <- attr(r, "provenance") prov <- attr(r, "provenance")
@@ -80,7 +80,7 @@ test_that("cog_geographic_rollup provenance reports the outer verb", {
test_that("cog_geographic_rollup accepts data.frames per layer", { test_that("cog_geographic_rollup accepts data.frames per layer", {
skip_if_no_corpus() skip_if_no_corpus()
fl_state <- cog_gov_search("^FLORIDA STATE GOVT$", type = "state") fl_state <- cog_gov_search("^FLORIDA$", type = "state")
broward <- cog_gov_search("^BROWARD COUNTY$", state = "FL", type = "county") broward <- cog_gov_search("^BROWARD COUNTY$", state = "FL", type = "county")
r <- cog_geographic_rollup( r <- cog_geographic_rollup(
govids = list(state = fl_state, county = broward), govids = list(state = fl_state, county = broward),
@@ -92,9 +92,47 @@ test_that("cog_geographic_rollup accepts data.frames per layer", {
test_that("cog_geographic_rollup rejects invalid inputs", { test_that("cog_geographic_rollup rejects invalid inputs", {
expect_error(cog_geographic_rollup(list(), "Police", 2020L), "length") expect_error(cog_geographic_rollup(list(), "Police", 2020L), "length")
expect_error(cog_geographic_rollup(c("101006006"), "Police", 2020L), "list") expect_error(cog_geographic_rollup(c("121011212191"), "Police", 2020L), "list")
expect_error( expect_error(
cog_geographic_rollup(list(planet = "100000000"), "Police", 2020L), cog_geographic_rollup(list(planet = "120000226351"), "Police", 2020L),
"state|county|city" "state|county|city"
) )
}) })
test_that("cog_geographic_rollup per-capita uses summed per-year populations", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_geographic_rollup(
govids = list(state = "010000226085",
county = "121011212191"),
category = "Police",
years = 2019:2020,
per_capita = TRUE
)
state_ops <- r[r$layer == "state" & r$spend_subtype == "operations", ]
county_ops <- r[r$layer == "county" & r$spend_subtype == "operations", ]
state_implied <- state_ops$amt_nominal / state_ops$amt_per_capita_nominal
county_implied <- county_ops$amt_nominal /
county_ops$amt_per_capita_nominal
# Per-year, per-layer denominator is the layer's own per-year population
expect_equal(state_implied[state_ops$year == 2019], 4874747, tolerance = 1)
expect_equal(state_implied[state_ops$year == 2020], 4903185, tolerance = 1)
expect_equal(county_implied[county_ops$year == 2019], 1935878, tolerance = 1)
})
})
test_that("cog_geographic_rollup records included/excluded govids in provenance", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_geographic_rollup(
govids = list(county = "121011212191"),
category = "Police",
years = 2019:2020,
per_capita = TRUE
)
prov <- attr(r, "provenance")
expect_true("rollup" %in% names(prov))
expect_true("121011212191" %in% prov$rollup$included_govids)
expect_true(is.character(prov$rollup$excluded_govids))
})
})
+22 -14
View File
@@ -146,7 +146,7 @@ test_that(".resolve_basket_row exact match returns one row", {
expect_equal(out$match_method, "exact") expect_equal(out$match_method, "exact")
expect_equal(out$n_candidates, 1L) expect_equal(out$n_candidates, 1L)
expect_equal(nrow(out$row), 1L) expect_equal(nrow(out$row), 1L)
expect_equal(out$row$canonical_govid, "101006006") expect_equal(out$row$canonical_govid, "121011212191")
expect_equal(out$row$gov_name, "BROWARD COUNTY") expect_equal(out$row$gov_name, "BROWARD COUNTY")
}) })
@@ -157,7 +157,7 @@ test_that(".resolve_basket_row exact match is case-insensitive", {
) )
expect_equal(out$status, "resolved") expect_equal(out$status, "resolved")
expect_equal(out$match_method, "exact") expect_equal(out$match_method, "exact")
expect_equal(out$row$canonical_govid, "101006006") expect_equal(out$row$canonical_govid, "121011212191")
}) })
test_that(".resolve_basket_row exact match honors per-row type", { test_that(".resolve_basket_row exact match honors per-row type", {
@@ -166,7 +166,7 @@ test_that(".resolve_basket_row exact match honors per-row type", {
name = "SAN DIEGO CITY", state = "CA", type = "city", con = con name = "SAN DIEGO CITY", state = "CA", type = "city", con = con
) )
expect_equal(out$status, "resolved") expect_equal(out$status, "resolved")
expect_equal(out$row$canonical_govid, "052037010") expect_equal(out$row$canonical_govid, "062073207598")
}) })
test_that(".resolve_basket_row substring fallback resolves single match", { test_that(".resolve_basket_row substring fallback resolves single match", {
@@ -177,7 +177,7 @@ test_that(".resolve_basket_row substring fallback resolves single match", {
expect_equal(out$status, "resolved") expect_equal(out$status, "resolved")
expect_equal(out$match_method, "substring") expect_equal(out$match_method, "substring")
expect_equal(out$n_candidates, 1L) expect_equal(out$n_candidates, 1L)
expect_equal(out$row$canonical_govid, "101006006") expect_equal(out$row$canonical_govid, "121011212191")
}) })
test_that(".resolve_basket_row no_match returns 0-row tibble", { test_that(".resolve_basket_row no_match returns 0-row tibble", {
@@ -207,15 +207,19 @@ test_that(".resolve_basket_row treats empty/whitespace name as no_match", {
test_that(".resolve_basket_row largest_pop within single type", { test_that(".resolve_basket_row largest_pop within single type", {
# FL Miami substring matches 10 cities (all govs_type = 2), largest pop # FL Miami substring matches 10 cities (all govs_type = 2), largest pop
# is MIAMI CITY at 443665. # is MIAMI CITY at 443665. Under Phase P canonical naming, MIAMI-DADE
# COUNTY (govs_type = 1) also contains "Miami", so `type = "city"` pins
# the match set to a single type (as the query docs promise it will for
# per-row `type`), keeping this test's original intent: multiple
# same-type name matches resolve to the largest-population row.
con <- uscogdata:::.ensure_session() con <- uscogdata:::.ensure_session()
out <- uscogdata:::.resolve_basket_row( out <- uscogdata:::.resolve_basket_row(
name = "Miami", state = "FL", type = NA_character_, con = con name = "Miami", state = "FL", type = "city", con = con
) )
expect_equal(out$status, "largest_pop") expect_equal(out$status, "largest_pop")
expect_equal(out$match_method, "substring") expect_equal(out$match_method, "substring")
expect_gte(out$n_candidates, 2L) expect_gte(out$n_candidates, 2L)
expect_equal(out$row$canonical_govid, "102013013") expect_equal(out$row$canonical_govid, "122086194757")
expect_equal(out$row$gov_name, "MIAMI CITY") expect_equal(out$row$gov_name, "MIAMI CITY")
}) })
@@ -241,7 +245,7 @@ test_that(".resolve_basket_row resolves with type override on ambiguous case", {
) )
expect_equal(out$status, "resolved") expect_equal(out$status, "resolved")
expect_equal(out$match_method, "substring") expect_equal(out$match_method, "substring")
expect_equal(out$row$canonical_govid, "052037010") expect_equal(out$row$canonical_govid, "062073207598")
}) })
# ---- basket mode public surface ---- # ---- basket mode public surface ----
@@ -254,7 +258,7 @@ test_that("cog_gov_search basket mode resolves clean inputs in input order", {
) )
expect_s3_class(basket, "tbl_df") expect_s3_class(basket, "tbl_df")
expect_equal(nrow(basket), 3L) expect_equal(nrow(basket), 3L)
expect_equal(basket$canonical_govid, c("101006006", "052037010", "442227001")) expect_equal(basket$canonical_govid, c("121011212191", "062073207598", "482453176394"))
expect_equal(basket$gov_name, c("BROWARD COUNTY", "SAN DIEGO CITY", "AUSTIN CITY")) expect_equal(basket$gov_name, c("BROWARD COUNTY", "SAN DIEGO CITY", "AUSTIN CITY"))
}) })
@@ -284,7 +288,7 @@ test_that("cog_gov_search basket mode skips ambiguous and no_match rows", {
)) ))
# Broward resolves; San Diego ambiguous; Notarealplace no_match. # Broward resolves; San Diego ambiguous; Notarealplace no_match.
expect_equal(nrow(basket), 1L) expect_equal(nrow(basket), 1L)
expect_equal(basket$canonical_govid, "101006006") expect_equal(basket$canonical_govid, "121011212191")
res <- attr(basket, "resolution") res <- attr(basket, "resolution")
expect_equal(nrow(res), 3L) expect_equal(nrow(res), 3L)
expect_equal(res$status, c("resolved", "ambiguous", "no_match")) expect_equal(res$status, c("resolved", "ambiguous", "no_match"))
@@ -306,20 +310,24 @@ test_that("cog_gov_search basket mode recycles single state", {
state = "CA" state = "CA"
) )
expect_equal(nrow(basket), 2L) expect_equal(nrow(basket), 2L)
expect_equal(basket$canonical_govid, c("052037010", "052001009")) expect_equal(basket$canonical_govid, c("062073207598", "062001123093"))
}) })
test_that("cog_gov_search basket mode within-type largest_pop records candidates", { test_that("cog_gov_search basket mode within-type largest_pop records candidates", {
skip_if_no_corpus() skip_if_no_corpus()
# `type = "city"` for the Miami row pins the match set to govs_type = 2;
# under Phase P canonical naming MIAMI-DADE COUNTY also contains "Miami"
# and would otherwise make this an ambiguous (cross-type) match.
basket <- suppressMessages(cog_gov_search( basket <- suppressMessages(cog_gov_search(
name = c("Miami", "OAKLAND CITY"), name = c("Miami", "OAKLAND CITY"),
state = c("FL", "CA") state = c("FL", "CA"),
type = c("city", NA)
)) ))
expect_equal(nrow(basket), 2L) expect_equal(nrow(basket), 2L)
res <- attr(basket, "resolution") res <- attr(basket, "resolution")
miami_row <- res[res$query_name == "Miami", ] miami_row <- res[res$query_name == "Miami", ]
expect_equal(miami_row$status, "largest_pop") expect_equal(miami_row$status, "largest_pop")
expect_equal(miami_row$canonical_govid, "102013013") expect_equal(miami_row$canonical_govid, "122086194757")
expect_gte(miami_row$n_candidates, 2L) expect_gte(miami_row$n_candidates, 2L)
expect_gte(nrow(miami_row$candidates[[1]]), 2L) expect_gte(nrow(miami_row$candidates[[1]]), 2L)
}) })
@@ -396,7 +404,7 @@ test_that("cog_gov_search basket mode skips per-row excluded type without aborti
)) ))
# Broward should resolve; the special_district row should be no_match. # Broward should resolve; the special_district row should be no_match.
expect_equal(nrow(basket), 1L) expect_equal(nrow(basket), 1L)
expect_equal(basket$canonical_govid, "101006006") expect_equal(basket$canonical_govid, "121011212191")
res <- attr(basket, "resolution") res <- attr(basket, "resolution")
expect_equal(res$status, c("resolved", "no_match")) expect_equal(res$status, c("resolved", "no_match"))
# query_type should record what the user passed for the excluded-type row # query_type should record what the user passed for the excluded-type row
+164
View File
@@ -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")
})
+204 -12
View File
@@ -1,12 +1,12 @@
test_that("cog_spending returns expected shape for Broward Corrections 2020", { test_that("cog_spending returns expected shape for Broward Corrections 2020", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", years = 2020L, category = "Corrections") r <- cog_spending("121011212191", years = 2020L, category = "Corrections")
expect_s3_class(r, "tbl_df") expect_s3_class(r, "tbl_df")
expected_cols <- c("year", "canonical_govid", "gov_name", "spend_subtype", expected_cols <- c("year", "canonical_govid", "gov_name", "spend_subtype",
"category", "amt_nominal", "codes_included", "category", "amt_nominal", "codes_included",
"aggregate_fallback", "notes") "aggregate_fallback", "notes")
expect_true(all(expected_cols %in% names(r))) expect_true(all(expected_cols %in% names(r)))
expect_equal(unique(r$canonical_govid), "101006006") expect_equal(unique(r$canonical_govid), "121011212191")
expect_equal(unique(r$year), 2020L) expect_equal(unique(r$year), 2020L)
expect_equal(unique(r$category), "Corrections") expect_equal(unique(r$category), "Corrections")
expect_true(all(r$spend_subtype %in% c("operations", "capital"))) expect_true(all(r$spend_subtype %in% c("operations", "capital")))
@@ -15,7 +15,7 @@ test_that("cog_spending returns expected shape for Broward Corrections 2020", {
test_that("cog_spending vectorised years + categories", { test_that("cog_spending vectorised years + categories", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", 2019:2020, r <- cog_spending("121011212191", 2019:2020,
category = c("Corrections", "Police")) category = c("Corrections", "Police"))
expect_true(all(r$year %in% 2019:2020)) expect_true(all(r$year %in% 2019:2020))
expect_true(all(r$category %in% c("Corrections", "Police"))) expect_true(all(r$category %in% c("Corrections", "Police")))
@@ -24,7 +24,7 @@ test_that("cog_spending vectorised years + categories", {
test_that("cog_spending with per_capita adds per-capita nominal column", { test_that("cog_spending with per_capita adds per-capita nominal column", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", 2020L, "Corrections", per_capita = TRUE) r <- cog_spending("121011212191", 2020L, "Corrections", per_capita = TRUE)
expect_true("amt_per_capita_nominal" %in% names(r)) expect_true("amt_per_capita_nominal" %in% names(r))
expect_false("amt_real" %in% names(r)) expect_false("amt_real" %in% names(r))
expect_false("amt_per_capita_real" %in% names(r)) expect_false("amt_per_capita_real" %in% names(r))
@@ -34,7 +34,7 @@ test_that("cog_spending with per_capita adds per-capita nominal column", {
test_that("cog_spending with adjust_to_year adds real column", { test_that("cog_spending with adjust_to_year adds real column", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", 2019:2020, "Corrections", r <- cog_spending("121011212191", 2019:2020, "Corrections",
adjust_to_year = 2022L) adjust_to_year = 2022L)
expect_true("amt_real" %in% names(r)) expect_true("amt_real" %in% names(r))
r2019 <- dplyr::filter(r, year == 2019L) r2019 <- dplyr::filter(r, year == 2019L)
@@ -43,7 +43,7 @@ test_that("cog_spending with adjust_to_year adds real column", {
test_that("cog_spending with per_capita + adjust_to_year adds all columns", { test_that("cog_spending with per_capita + adjust_to_year adds all columns", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", 2020L, "Corrections", r <- cog_spending("121011212191", 2020L, "Corrections",
per_capita = TRUE, adjust_to_year = 2022L) per_capita = TRUE, adjust_to_year = 2022L)
expect_true(all(c("amt_nominal", "amt_real", expect_true(all(c("amt_nominal", "amt_real",
"amt_per_capita_nominal", "amt_per_capita_real") %in% "amt_per_capita_nominal", "amt_per_capita_real") %in%
@@ -68,16 +68,16 @@ test_that("cog_spending for unknown govid returns empty tibble + informs", {
test_that("cog_spending records found + missing govids in provenance", { test_that("cog_spending records found + missing govids in provenance", {
skip_if_no_corpus() skip_if_no_corpus()
suppressMessages( suppressMessages(
r <- cog_spending(c("101006006", "XXXINVALID"), 2020L, "Corrections") r <- cog_spending(c("121011212191", "XXXINVALID"), 2020L, "Corrections")
) )
prov <- attr(r, "provenance") prov <- attr(r, "provenance")
expect_equal(sort(prov$scope$govids_found), "101006006") expect_equal(sort(prov$scope$govids_found), "121011212191")
expect_equal(sort(prov$scope$govids_missing), "XXXINVALID") expect_equal(sort(prov$scope$govids_missing), "XXXINVALID")
}) })
test_that("cog_spending result has provenance attribute matching schema", { test_that("cog_spending result has provenance attribute matching schema", {
skip_if_no_corpus() skip_if_no_corpus()
r <- cog_spending("101006006", 2020L, "Corrections") r <- cog_spending("121011212191", 2020L, "Corrections")
prov <- attr(r, "provenance") prov <- attr(r, "provenance")
expect_type(prov, "list") expect_type(prov, "list")
expect_equal(prov$verb, "cog_spending") expect_equal(prov$verb, "cog_spending")
@@ -93,7 +93,7 @@ test_that("cog_spending result has provenance attribute matching schema", {
test_that("cog_spending rejects invalid inputs", { test_that("cog_spending rejects invalid inputs", {
expect_error(cog_spending(list(), 2020L), "character|data frame") expect_error(cog_spending(list(), 2020L), "character|data frame")
expect_error(cog_spending("101006006", "2020"), "years") expect_error(cog_spending("121011212191", "2020"), "years")
}) })
test_that("cog_spending accepts a cog_gov_search result directly", { test_that("cog_spending accepts a cog_gov_search result directly", {
@@ -101,12 +101,12 @@ test_that("cog_spending accepts a cog_gov_search result directly", {
picks <- cog_gov_search("^BROWARD COUNTY$", state = "FL", type = "county") picks <- cog_gov_search("^BROWARD COUNTY$", state = "FL", type = "county")
expect_gt(nrow(picks), 0L) expect_gt(nrow(picks), 0L)
r <- cog_spending(picks, 2020L, "Corrections") r <- cog_spending(picks, 2020L, "Corrections")
expect_equal(unique(r$canonical_govid), "101006006") expect_equal(unique(r$canonical_govid), "121011212191")
}) })
test_that("cog_spending accepts a cog_find_peers result directly", { test_that("cog_spending accepts a cog_find_peers result directly", {
skip_if_no_corpus() skip_if_no_corpus()
peers <- cog_find_peers("101006006", max_peers = 3L) peers <- cog_find_peers("121011212191", max_peers = 3L)
r <- cog_spending(peers, 2020L, "Police") r <- cog_spending(peers, 2020L, "Police")
expect_setequal(unique(r$canonical_govid), expect_setequal(unique(r$canonical_govid),
sort(peers$canonical_govid)) sort(peers$canonical_govid))
@@ -128,3 +128,195 @@ test_that("cog_spending accepts a basket-mode cog_gov_search result", {
expect_s3_class(spending, "tbl_df") expect_s3_class(spending, "tbl_df")
expect_setequal(unique(spending$canonical_govid), basket$canonical_govid) expect_setequal(unique(spending$canonical_govid), basket$canonical_govid)
}) })
test_that("per_capita denominator is the per-year F-33 population", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", years = 2019:2020,
category = "Police", per_capita = TRUE)
r_ops <- r[r$spend_subtype == "operations", ]
# Implied denominator from amt_nominal / amt_per_capita_nominal
implied_pop <- r_ops$amt_nominal / r_ops$amt_per_capita_nominal
names(implied_pop) <- r_ops$year
# Use absolute tolerance: within 1 person of per-year F-33 values.
# Hardcoded values are Broward County's per-year Census F-33 population
# from the bundled fixture (regenerated 2026-07-11 against cog_pipeline
# publish tree, pipeline_commit 1a00925, Phase P schema_version 4).
# 1,940,907 is the static ACS 2018-2022 5-year value the legacy
# implementation would use; we assert it is NOT what we get.
expect_true(abs(implied_pop[["2019"]] - 1935878) < 1)
expect_true(abs(implied_pop[["2020"]] - 1952778) < 1)
expect_false(all(abs(implied_pop - 1940907) < 1))
})
})
test_that("pop_source = 'census_f33' does not produce unavailable-pop note", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", years = 2019L,
category = "Police", per_capita = TRUE)
expect_true(all(r$pop_source == "census_f33"))
expect_true(all(is.na(r$notes) | r$notes == "" |
!grepl("No population denominator", r$notes)))
})
})
test_that("aggregate fallback + unavailable pop produce concatenated notes", {
# Unit-level test of .notes_column with a synthetic data frame so we don't
# depend on having a type-4/5 gov in the fixture.
result <- tibble::tibble(
aggregate_fallback = c(FALSE, TRUE, TRUE),
pop_source = c("census_f33", "census_f33", "unavailable")
)
notes <- uscogdata:::.notes_column(result)
expect_equal(notes[1], "")
expect_equal(notes[2], "Aggregate fallback applied; see cog_explain()")
expect_equal(notes[3],
"Aggregate fallback applied; see cog_explain(); No population denominator available for this gov type")
})
test_that("provenance records per-year denominator metadata", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", years = 2019:2020,
category = "Police", per_capita = TRUE)
pc <- attr(r, "provenance")$transformations$per_capita
expect_true(pc$applied)
expect_match(pc$denominator_source, "Census F-33", fixed = FALSE)
expect_match(pc$denominator_source, "per-year", fixed = TRUE)
expect_equal(pc$pop_source_counts$census_f33, nrow(r))
expect_equal(pc$pop_source_counts$unavailable, 0L)
expect_equal(length(pc$popyear_range), 2L)
})
})
# --- basis = "harmonized" / "raw" (Phase R2, schema v5) --------------------
test_that("basis = 'raw' reproduces the pre-harmonization Broward Police totals", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", years = 2019:2020, category = "Police",
basis = "raw")
# Regression pin captured against the schema v5 fixture (2026-07-18,
# pipeline_commit ece9b32) before basis = "harmonized" existed as a
# concept; these are the same totals the pre-Phase-R2 default query
# returned (spending_annotated is untouched by the harmonized views).
ops <- r$amt_nominal[r$year == 2019L & r$spend_subtype == "operations"]
cap <- r$amt_nominal[r$year == 2020L & r$spend_subtype == "capital"]
expect_equal(ops, 483560000)
expect_equal(cap, 26693000)
expect_equal(attr(r, "provenance")$basis, "raw")
})
})
test_that("basis = 'harmonized' (default) matches 'raw' when no harmonization rule applies", {
skip_if_no_corpus()
with_fixture_corpus({
# Every `method = "collapse"` mapping in the curated harmonization_map
# ends by FY2004 for codes inside the spending/revenue flow-type
# prefixes (E/F/G/K, T/A/U/B/C/D); the one collapse extending to FY2011
# (L38/M38 -> L36/M36) is intergovernmental-transfer (L/M prefix) codes
# that were never part of spending_long/revenue_long to begin with. So
# for the fixture's 2011-2020 window, basis = "harmonized" is a
# data-verified no-op vs "raw" for in-scope codes -- this is the
# positive-control counterpart to the synthetic REPLACE-mechanism test
# in test-views.R, which proves the fold itself works when data exists.
r_raw <- cog_spending("121011212191", c(2011L, 2012L, 2019L, 2020L),
"Police", basis = "raw")
r_harm <- cog_spending("121011212191", c(2011L, 2012L, 2019L, 2020L),
"Police", basis = "harmonized")
expect_equal(attr(r_harm, "provenance")$basis, "harmonized")
expect_equal(
r_harm$amt_nominal[order(r_harm$year, r_harm$spend_subtype)],
r_raw$amt_nominal[order(r_raw$year, r_raw$spend_subtype)]
)
})
})
test_that("basis defaults to 'harmonized' when not passed", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", 2020L, "Police")
expect_equal(attr(r, "provenance")$basis, "harmonized")
})
})
test_that("provenance carries basis + harmonization block with na_rows_excluded", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", 2011:2012, "Corrections")
prov <- attr(r, "provenance")
expect_equal(prov$basis, "harmonized")
expect_true(prov$harmonization$applied)
expect_true(prov$harmonization$na_rows_excluded >= 0L)
expect_true(prov$harmonization$na_amount_excluded >= 0)
# Data-verified for the v6 fixture (corpus 2026-07-22). The Task 18 map
# extension added E/F/G-prefix discontinued_na rulings the earlier pin's
# comment predated: E21/F21/G21 (Education NEC local, SB184-186,
# "trivial; explicit-NA, full wide-era window"). Broward's 2011 legacy
# partition zero-pads exactly those three codes, so this query now
# excludes 3 NA-harmonized rows -- all with amt = 0, hence the excluded
# AMOUNT stays exactly zero. (The other discontinued_na rulings -- S74,
# Z61, X04, X06, the debt-detail family, L24 -- remain outside the
# E/F/G/K prefixes.) See docs/phase_r_harmonization_review.md § 1.3/1.4
# and cog_pipeline data/harmonization_map.csv E21/F21/G21 rows.
expect_equal(prov$harmonization$na_rows_excluded, 3L)
expect_equal(prov$harmonization$na_amount_excluded, 0)
})
})
test_that("basis = 'raw' never populates the harmonization exclusion block", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", 2020L, "Corrections", basis = "raw")
h <- attr(r, "provenance")$harmonization
expect_false(h$applied)
expect_equal(h$na_rows_excluded, 0L)
})
})
test_that("v4 corpus: basis silently resolves to raw (default) with a provenance note", {
skip_if_no_corpus()
with_doctored_schema_version(4L, {
r <- cog_spending("121011212191", 2019L, "Police")
prov <- attr(r, "provenance")
expect_equal(prov$basis, "raw")
expect_match(prov$basis_note, "raw", fixed = TRUE)
expect_match(prov$basis_note, "schema_version", fixed = TRUE)
expect_false(prov$harmonization$applied)
})
})
test_that("v4 corpus: explicit basis = 'harmonized' aborts", {
skip_if_no_corpus()
with_doctored_schema_version(4L, {
expect_error(
cog_spending("121011212191", 2019L, "Police", basis = "harmonized"),
class = "uscogdata_basis_unsupported"
)
})
})
test_that("provenance$series_break_refs is a populated-when-applicable character vector", {
skip_if_no_corpus()
with_fixture_corpus({
r <- cog_spending("121011212191", 2020L, "Corrections")
refs <- attr(r, "provenance")$series_break_refs
expect_type(refs, "character")
# No catalogued series_breaks_pq row falls inside this fixture's
# 2011/2012/2019/2020 window for the codes this query touches (E04/G04)
# -- data-verified; the mechanism itself is what's under test here, via
# a query-shaped unit test in test-views.R since the fixture has no
# positive case to pin against.
expect_equal(refs, character(0))
})
})
test_that("v4 corpus: explicit basis = 'raw' still works", {
skip_if_no_corpus()
with_doctored_schema_version(4L, {
r <- cog_spending("121011212191", 2019L, "Police", basis = "raw")
expect_equal(attr(r, "provenance")$basis, "raw")
expect_gt(nrow(r), 0L)
})
})
+171
View File
@@ -14,6 +14,144 @@ test_that("all expected views register on session open", {
expect_true(all(expected %in% views$table_name)) expect_true(all(expected %in% views$table_name))
}) })
test_that("inst/sql/22- and 23- harmonized views enforce every WHERE predicate (real SQL text, synthetic parquet)", {
# spending_long_harmonized / revenue_long_harmonized are three-predicate
# views:
# 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 (<flow prefixes>)
# None of the curated harmonization_map's `collapse` rulings land inside
# the bundled fixture's 2011-2020 window for spending/revenue-prefixed
# codes (see the "basis = 'harmonized' (default) matches 'raw'" test in
# test-spending.R and docs/phase_r_harmonization_review.md § 0.2/§ 2), so
# there is no real fixture row that exercises a nonzero fold or a
# predicate-excluded row. Rather than re-implement the WHERE clause by
# hand against an in-memory VALUES table (which would only prove the SQL
# *pattern* works, not that the deployed inst/sql/22-/23- text actually
# applies it), this test reads the real SQL files off disk, substitutes
# {url} exactly as .register_views() does, and executes them -- plus
# their 10-long.sql dependency -- against a synthetic hive-partitioned
# parquet tree written to a temp dir. A regression in any predicate (e.g.
# `NOT is_aggregate` dropped, the prefix list changed, the NULL guard
# removed) would change which of the rows below survive.
#
# The synthetic parquet is written with DuckDB's own COPY ... TO (FORMAT
# PARQUET) rather than the arrow package: this package has no arrow
# dependency (CLAUDE.md "No arrow dependency -- DuckDB reads parquet
# natively"), and DuckDB can round-trip its own parquet writer/reader
# without adding one for tests either.
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
-- Spending (E/F/G/K) rows, exercised against spending_long_harmonized:
('spend-A', 'E36', 100, false, 'E36'), -- control: passes every predicate as-is
('spend-B', 'E38', 50, false, 'E36'), -- collapse-fold: passes every predicate, renamed to E36
('spend-C', 'E05', 999999, true, 'E05'), -- excluded ONLY by `NOT is_aggregate`
('spend-D', 'E99', 888888, false, NULL), -- excluded by `harmonized_code IS NOT NULL`
-- 'S74' is outside BOTH flow families (E/F/G/K spending and
-- T/A/U/B/C/D revenue -- it mirrors the real corpus's own
-- non-flow-type codes like S74/Z61), so it can only leak into
-- EITHER view via the E/F/G/K or T/A/U/B/C/D prefix filter, never
-- both at once -- a prefix drawn from the other view's own family
-- (e.g. a real T-code for the spending row) would incorrectly
-- leak into the other view's assertion below and not discriminate
-- the predicate under test.
('spend-E', 'S74', 777777, false, 'S74'), -- excluded ONLY by the E/F/G/K prefix filter
-- Revenue (T/A/U/B/C/D) rows, exercised against revenue_long_harmonized:
('rev-A', 'U11', 200, false, 'U11'), -- control: passes every predicate as-is
('rev-B', 'U10', 25, false, 'U11'), -- collapse-fold: passes every predicate, renamed to U11
('rev-C', 'T29', 555555, true, 'T29'), -- excluded ONLY by `NOT is_aggregate`
('rev-D', 'T88', 444444, false, NULL), -- excluded by `harmonized_code IS NOT NULL`
('rev-E', 'Z61', 333333, false, 'Z61') -- excluded ONLY by the T/A/U/B/C/D prefix filter
) 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("22-spending_long_harmonized.sql"))
DBI::dbExecute(con, .read_view_sql("23-revenue_long_harmonized.sql"))
spend <- DBI::dbGetQuery(con,
"SELECT item_code, SUM(amt) AS amt FROM spending_long_harmonized
GROUP BY item_code ORDER BY item_code"
)
# Exactly one surviving row: spend-C (aggregate), spend-D (NULL
# harmonized_code), and spend-E (wrong prefix family) must all be gone,
# and spend-A + spend-B must be folded together under E36.
expect_equal(nrow(spend), 1L)
expect_equal(spend$item_code, "E36")
expect_equal(spend$amt, 150)
rev <- DBI::dbGetQuery(con,
"SELECT item_code, SUM(amt) AS amt FROM revenue_long_harmonized
GROUP BY item_code ORDER BY item_code"
)
expect_equal(nrow(rev), 1L)
expect_equal(rev$item_code, "U11")
expect_equal(rev$amt, 225)
})
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
# test-spending.R), so this proves the matching logic itself against the
# live view + a synthetic year window that DOES hit a cataloged break
# (SB075, fin_code E62, break_year 2005).
skip_if_no_corpus()
con <- cog_open()
on.exit(cog_close())
refs <- uscogdata:::.build_series_break_refs(
con, codes_observed = c("E62", "E04"), years = c(2003L, 2006L),
schema_version = 5L
)
expect_true("SB075" %in% refs)
expect_true("SB071" %in% refs)
# Gated on schema_version >= 5 even when the codes/years would otherwise match.
refs_v4 <- uscogdata:::.build_series_break_refs(
con, codes_observed = c("E62"), years = c(2003L, 2006L), schema_version = 4L
)
expect_equal(refs_v4, character(0))
})
test_that("schema v5 harmonization views register when the corpus supports them", {
skip_if_no_corpus()
con <- cog_open()
on.exit(cog_close())
manifest <- uscogdata:::.uscogdata_env$manifest
skip_if(as.integer(manifest$schema_version) < 5L, "fixture is schema_version < 5")
views <- DBI::dbGetQuery(con,
"SELECT table_name FROM information_schema.tables
WHERE table_schema = 'main' AND table_type = 'VIEW'"
)
expected_v5 <- c(
"spending_long_harmonized", "revenue_long_harmonized",
"spending_annotated_harmonized", "revenue_annotated_harmonized",
"harmonization_map", "harmonization_recipes", "series_breaks_pq"
)
expect_true(all(expected_v5 %in% views$table_name))
})
test_that("spending_long filters to E/F/G/K prefixes and excludes aggregates", { test_that("spending_long filters to E/F/G/K prefixes and excludes aggregates", {
skip_if_no_corpus() skip_if_no_corpus()
con <- cog_open() con <- cog_open()
@@ -57,3 +195,36 @@ test_that("spending_annotated carries category + xwalk columns", {
expect_true(nm %in% names(row), info = paste("missing column:", nm)) expect_true(nm %in% names(row), info = paste("missing column:", nm))
} }
}) })
test_that("gov_population_yearly exposes one row per (year, canonical_govid)", {
skip_if_no_corpus()
with_fixture_corpus({
con <- uscogdata:::.ensure_session()
df <- DBI::dbGetQuery(
con,
"SELECT year, canonical_govid, population, popyear
FROM gov_population_yearly
WHERE canonical_govid = '121011212191'
ORDER BY year"
)
expect_setequal(df$year, c(2011L, 2012L, 2019L, 2020L))
expect_equal(nrow(df), 4L)
expect_true(all(!is.na(df$population)))
# Hardcoded values are from the bundled fixture (regenerated 2026-07-18
# against cog_pipeline publish tree, pipeline_commit ece9b32, Phase R2
# schema_version 5, years 2011/2012/2019/2020). Update if the fixture is
# rebuilt against a different source vintage.
expect_equal(df$population[df$year == 2011L], 1759591L)
expect_equal(df$population[df$year == 2012L], 1819773L)
expect_equal(df$population[df$year == 2019L], 1935878L)
expect_equal(df$population[df$year == 2020L], 1952778L)
# Uniqueness on (year, canonical_govid) across the whole view.
dup <- DBI::dbGetQuery(
con,
"SELECT year, canonical_govid, COUNT(*) AS n
FROM gov_population_yearly
GROUP BY year, canonical_govid HAVING n > 1"
)
expect_equal(nrow(dup), 0L)
})
})
+62
View File
@@ -0,0 +1,62 @@
---
title: "Population denominators"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Population denominators}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r setup, include = FALSE}
knitr::opts_chunk$set(eval = FALSE, collapse = TRUE, comment = "#>")
```
# Why per-year population matters
Per-capita finance numbers divide each year's spending or revenue by a population denominator. The choice of denominator is a research decision, not an implementation detail: a 24-year corpus paired with a single 5-year ACS estimate produces biased per-capita values whose magnitude scales with each government's population change.
`uscogdata` defaults to the **Census F-33 population value Census itself uses to compute its published per-capita tables.** That value is recorded on every COG row as `population`, with `popyear` indicating the vintage. For a city that grew from 200,000 to 300,000 between 2000 and 2023, this default reproduces the per-capita value Census published. A static ACS denominator would have understated 2000 per-capita by ~33%.
# The four population sources
| Source | What it is | Default in uscogdata? |
|---|---|---|
| Census F-33 `population` | Population value Census used on each COG row to compute its published per-capita tables. Almost always a Population Estimates Program (PEP) estimate; sometimes lagged a year for fiscal-year alignment, recorded in `popyear`. | **Yes — default for `cog_spending(per_capita = TRUE)` etc.** |
| PEP (raw) | Census Bureau's official annual intercensal estimates, distinct from F-33 because F-33 sometimes uses a lagged vintage. | No (not in corpus) |
| ACS 5-year | American Community Survey 5-year rolling average. Different methodology, has margin of error, only available 2005-2009 onward. | Used by `cog_find_peers()` historically; replaced in 0.1 by per-year F-33. Still available in `canonical_fips_xwalk.population_acs` for non-time-series uses. |
| Decennial count | Actual count, every 10 years. | No (not in corpus) |
The F-33 denominator is preferred because it's the same value Census uses internally — so `uscogdata` per-capita numbers reconcile with Census's own published tables.
# Coverage
F-33 `population` is observed for gov types 0–3 (state, county, city, township). Gov types 4 (special districts) and 5 (school districts) have `population` masked to NA in the F-33 schema. uscogdata returns:
- `pop_source = "census_f33"` and a numeric `amt_per_capita_*` for types 0–3.
- `pop_source = "unavailable"` and `NA` per-capita for types 4–5, with a corresponding entry in `notes`.
`cog_geographic_rollup(per_capita = TRUE)` excludes unavailable-pop rows from the result; the dropped govids are listed in `provenance\$rollup\$excluded_govids`.
# The popyear quirk
Census sometimes uses a population estimate from one year prior to the fiscal year being reported (e.g., FY2018 paired with a 2017 PEP estimate) so the denominator is available before the fiscal year closes. `popyear` records which vintage was paired; `cog_spending()` returns the popyear range in `provenance\$transformations\$per_capita\$popyear_range` rather than as a per-row column.
# Time-varying peer cohorts
`cog_find_peers(target, year = Y)` builds a cohort matched on each candidate's population at year `Y`. The cohort is fixed once chosen; `cog_peer_compare()` then runs that cohort across whatever `years` you ask for. To run a moving-window comparison, build cohorts year-by-year and stitch the results:
```r
years <- 2010:2023
out <- purrr::map_dfr(years, function(y) {
peers <- cog_find_peers("261163166615", year = y, max_peers = 10L)
cog_peer_compare("261163166615", peers,
category = "Police", years = y,
per_capita = TRUE)
})
```
Each row in `out` has `cohort_year == year`, so a faceted plot shows cohort drift directly.
# Future direction
`pop_source` is a column on the result, not a fixed value, so adding a new denominator (PEP from tidycensus, decennial counts, ACS time-series) is a join change rather than an API change. A future release may add `cog_spending(..., pop_source = "pep")` for users who need a single externally-audited series.