Compare commits
1
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
748ca4a56e |
+24
-1
@@ -21,7 +21,30 @@
|
|||||||
.uscogdata_defaults[[key]]
|
.uscogdata_defaults[[key]]
|
||||||
}
|
}
|
||||||
|
|
||||||
.resolve_url <- function() .cfg("url")
|
#' Resolve the corpus URL, guaranteeing the trailing slash the package assumes.
|
||||||
|
#'
|
||||||
|
#' Every consumer builds locations by CONCATENATION -- `paste0(url,
|
||||||
|
#' "manifest.json")` in manifest.R, `paste0(url, e$path)` in mirror.R, and the
|
||||||
|
#' parquet glob in views.R -- and mirror.R:104 documents the invariant outright
|
||||||
|
#' ('url ends in "/"'). Nothing enforced it, so a URL entered without the slash
|
||||||
|
#' failed silently and misleadingly:
|
||||||
|
#'
|
||||||
|
#' HTTPS -> ".../downloadmanifest.json"; the host answers with an HTML 404
|
||||||
|
#' page, which lands in the JSON parser as the lexical error
|
||||||
|
#' reported in issue #3 -- pointing the user at "login page / wrong
|
||||||
|
#' share" when the real cause was one missing character.
|
||||||
|
#' local -> ".../corpusdata/long/**/*.parquet" and a DuckDB "No files found".
|
||||||
|
#'
|
||||||
|
#' Normalizing here fixes every consumer at once, rather than each call site
|
||||||
|
#' re-deriving the same invariant. An empty setting is passed through
|
||||||
|
#' untouched so manifest.R's "not configured" guard still fires instead of the
|
||||||
|
#' value degrading into a bare "/" filesystem root.
|
||||||
|
#' @noRd
|
||||||
|
.resolve_url <- function() {
|
||||||
|
url <- .cfg("url")
|
||||||
|
if (is.null(url) || !nzchar(url) || grepl("/$", url)) return(url)
|
||||||
|
paste0(url, "/")
|
||||||
|
}
|
||||||
|
|
||||||
.resolve_cache_dir <- function() {
|
.resolve_cache_dir <- function() {
|
||||||
v <- .cfg("cache_dir")
|
v <- .cfg("cache_dir")
|
||||||
|
|||||||
+1
-1
@@ -141,7 +141,7 @@ cog_spending <- function(govid, years, category = NULL,
|
|||||||
harmonization <- .build_harmonization_block(
|
harmonization <- .build_harmonization_block(
|
||||||
con, govid, years, resolved, flow_prefixes
|
con, govid, years, resolved, flow_prefixes
|
||||||
)
|
)
|
||||||
suggestions <- .build_suggestions(con, govid, years, category, resolved$basis)
|
suggestions <- .build_suggestions(con, govid, years, category, result, resolved$basis)
|
||||||
}
|
}
|
||||||
|
|
||||||
prov <- .build_provenance(
|
prov <- .build_provenance(
|
||||||
|
|||||||
+54
-150
@@ -1,9 +1,8 @@
|
|||||||
# R/suggestions.R
|
# R/suggestions.R
|
||||||
# Recipe-component-driven signposting: when a basis = "harmonized" query for
|
# Recipe-component-driven signposting: when a basis = "harmonized" query for
|
||||||
# a category asks for a code that is itself a harmonization recipe
|
# a category comes back with a coverage gap in some requested years (the
|
||||||
# component, and that specific code has no rows in some requested years
|
# result has no rows at all in that year) that a harmonization recipe would
|
||||||
# while the recipe's own generic join would still fill those years for this
|
# actually fill for this government, surface that recipe as a suggestion.
|
||||||
# government, surface that recipe as a suggestion.
|
|
||||||
#
|
#
|
||||||
# This is deliberately keyed off the recipe catalog's component codes, not
|
# This is deliberately keyed off the recipe catalog's component codes, not
|
||||||
# off harmonization_map rows: no live map row carries a non-blank
|
# off harmonization_map rows: no live map row carries a non-blank
|
||||||
@@ -13,58 +12,53 @@
|
|||||||
# suggestion off of, just a leaf-code absence a recipe happens to fill).
|
# suggestion off of, just a leaf-code absence a recipe happens to fill).
|
||||||
# See docs/phase_r_harmonization_review.md § 0.3.
|
# See docs/phase_r_harmonization_review.md § 0.3.
|
||||||
#
|
#
|
||||||
# Scope is deliberately narrow in one respect and, as of Phase R3 Task 19c,
|
# Scope is deliberately narrow: signposting only runs when the caller
|
||||||
# deliberately WIDE in another: signposting only runs when the caller
|
|
||||||
# supplied a `category` (an un-scoped, all-categories query has no single
|
# supplied a `category` (an un-scoped, all-categories query has no single
|
||||||
# coverage question to answer), but within that category it now checks
|
# coverage question to answer) and only flags a recipe when the ACTUAL
|
||||||
# EACH recipe component that is itself a category member individually,
|
# result has zero rows in a requested year AND the candidate recipe's own
|
||||||
# rather than asking whether the whole category *result* has zero rows
|
# generic join (same join .run_recipe() uses, including its wide-era
|
||||||
# that year. A recipe fires when one of its own components has zero rows
|
# aggregate rows) produces at least one row for this government in that
|
||||||
# for this government in a requested year, AND SOME OTHER component of that
|
# year. Checking presence per-government (not corpus-wide) avoids false
|
||||||
# SAME recipe -- excluding the gapped one itself -- has a row (same join
|
# positives from ordinary reporting variance -- most governments don't use
|
||||||
# .run_recipe() uses, aggregate rows included) for that year. This is the
|
# every sibling code in a multi-code category every year, and that is not
|
||||||
# literal review-doc § 0.3 criterion: "...has no rows ... but other
|
# a format-boundary gap worth signposting.
|
||||||
# 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 --
|
#' Build the `prov$suggestions` list for a (non-recipe) basis = "harmonized"
|
||||||
#' the codes a category-scoped query actually "requests". A recipe can
|
#' verb call: recipes whose generic join would fill a real gap in `result`.
|
||||||
#' 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
|
#' @param con Active DuckDB connection.
|
||||||
#' just were never part of what this query asked for.
|
#' @param govid Character vector of canonical_govid values (the verb's raw
|
||||||
|
#' `govid`).
|
||||||
|
#' @param years Integer vector of requested years.
|
||||||
|
#' @param category `category` argument as passed to the verb (character
|
||||||
|
#' vector or `NULL`; suggestions are only computed when non-NULL).
|
||||||
|
#' @param result The verb's already-computed result tibble (post basis
|
||||||
|
#' query, pre per_capita/adjust_to_year).
|
||||||
|
#' @param basis The *resolved* basis (`"harmonized"` or `"raw"`).
|
||||||
|
#' @return List of `list(recipe_id, label, available_years, hint)`, possibly
|
||||||
|
#' empty.
|
||||||
#' @noRd
|
#' @noRd
|
||||||
.category_recipe_components <- function(con, category) {
|
.build_suggestions <- function(con, govid, years, category, result, basis) {
|
||||||
DBI::dbGetQuery(con, sprintf(
|
if (!identical(basis, "harmonized") || is.null(category)) return(list())
|
||||||
"SELECT DISTINCT r.recipe_id, r.component_code, r.year_min, r.year_max,
|
|
||||||
r.gov_type_scope
|
candidates <- DBI::dbGetQuery(con, sprintf(
|
||||||
FROM harmonization_recipes r
|
"SELECT DISTINCT recipe_id FROM harmonization_recipes
|
||||||
JOIN summary_categories sc
|
WHERE component_code IN (
|
||||||
ON sc.item_code = r.component_code AND sc.category IN (%s)",
|
SELECT DISTINCT item_code FROM summary_categories WHERE category IN (%s)
|
||||||
|
)",
|
||||||
.sql_lit_chr(category)
|
.sql_lit_chr(category)
|
||||||
))
|
))$recipe_id
|
||||||
}
|
if (length(candidates) == 0L) return(list())
|
||||||
|
|
||||||
#' Label + overall year coverage for a set of recipe ids (the suggestion's
|
result_years <- if (is.null(result) || nrow(result) == 0L) {
|
||||||
#' `label`/`available_years`).
|
integer(0)
|
||||||
#' @noRd
|
} else {
|
||||||
.recipe_meta <- function(con, candidates) {
|
unique(as.integer(result$year))
|
||||||
tibble::as_tibble(DBI::dbGetQuery(con, sprintf(
|
}
|
||||||
|
gap_years <- setdiff(as.integer(years), result_years)
|
||||||
|
if (length(gap_years) == 0L) return(list())
|
||||||
|
|
||||||
|
meta <- tibble::as_tibble(DBI::dbGetQuery(con, sprintf(
|
||||||
"SELECT recipe_id, any_value(label) AS label,
|
"SELECT recipe_id, any_value(label) AS label,
|
||||||
MIN(year_min) AS year_min, MAX(year_max) AS year_max
|
MIN(year_min) AS year_min, MAX(year_max) AS year_max
|
||||||
FROM harmonization_recipes
|
FROM harmonization_recipes
|
||||||
@@ -72,48 +66,13 @@
|
|||||||
GROUP BY recipe_id",
|
GROUP BY recipe_id",
|
||||||
.sql_lit_chr(candidates)
|
.sql_lit_chr(candidates)
|
||||||
)))
|
)))
|
||||||
}
|
|
||||||
|
|
||||||
#' Which (recipe_id, component_code, year) triples have at least one
|
# Which (recipe_id, year) pairs the recipe's own generic join actually
|
||||||
#' NOT-aggregate row for these governments -- i.e. that specific requested
|
# covers for this government, restricted to the gap years -- the same
|
||||||
#' code itself has data, scoped exactly like .run_recipe()'s join
|
# join .run_recipe() uses (component year_min/year_max + gov_type_scope,
|
||||||
#' (component year_min/year_max + gov_type_scope). NOT-aggregate mirrors
|
# no is_aggregate filter), just checking existence instead of summing.
|
||||||
#' what basis = "harmonized" itself excludes: an aggregate-only year is a
|
covered <- DBI::dbGetQuery(con, sprintf(
|
||||||
#' gap for that code exactly as it would be in a plain category query.
|
"SELECT DISTINCT r.recipe_id, l.year
|
||||||
#' @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
|
FROM long l
|
||||||
JOIN harmonization_recipes r
|
JOIN harmonization_recipes r
|
||||||
ON l.item_code = r.component_code
|
ON l.item_code = r.component_code
|
||||||
@@ -124,68 +83,13 @@
|
|||||||
WHERE r.recipe_id IN (%s)
|
WHERE r.recipe_id IN (%s)
|
||||||
AND l.canonical_govid IN (%s)
|
AND l.canonical_govid IN (%s)
|
||||||
AND l.year IN (%s)",
|
AND l.year IN (%s)",
|
||||||
.sql_lit_chr(candidates), .sql_lit_chr(govid), years_lit
|
.sql_lit_chr(candidates), .sql_lit_chr(govid),
|
||||||
|
paste(gap_years, collapse = ",")
|
||||||
))
|
))
|
||||||
}
|
|
||||||
|
|
||||||
#' 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()
|
suggestions <- list()
|
||||||
for (rid in candidates) {
|
for (rid in candidates) {
|
||||||
if (!.recipe_component_gapped(rid, requested, present, covered, years_int)) next
|
if (!rid %in% covered$recipe_id) next
|
||||||
m <- meta[meta$recipe_id == rid, ]
|
m <- meta[meta$recipe_id == rid, ]
|
||||||
suggestions[[length(suggestions) + 1L]] <- list(
|
suggestions[[length(suggestions) + 1L]] <- list(
|
||||||
recipe_id = rid,
|
recipe_id = rid,
|
||||||
|
|||||||
@@ -25,22 +25,6 @@ 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
|
||||||
|
|||||||
@@ -1,563 +0,0 @@
|
|||||||
# 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")
|
|
||||||
}
|
|
||||||
@@ -26,3 +26,41 @@ test_that(".resolve_cache_dir falls back to R_user_dir", {
|
|||||||
})
|
})
|
||||||
})
|
})
|
||||||
})
|
})
|
||||||
|
|
||||||
|
# ---------------------------------------------------------------------------
|
||||||
|
# Trailing-slash normalization (uscogdata #3 follow-up).
|
||||||
|
#
|
||||||
|
# EVERY consumer builds paths by concatenation: paste0(url, "manifest.json")
|
||||||
|
# (manifest.R), paste0(url, e$path) (mirror.R), and the parquet glob in
|
||||||
|
# views.R. mirror.R:104 even comments 'url ends in "/"' -- an assumption the
|
||||||
|
# package documents and relies on but never enforced.
|
||||||
|
#
|
||||||
|
# A URL missing its trailing slash therefore fails SILENTLY and confusingly:
|
||||||
|
# HTTPS -> ".../downloadmanifest.json" -> the host answers with an HTML 404
|
||||||
|
# page -> the jsonlite lexical error that issue #3 reported;
|
||||||
|
# local -> ".../corpusdata/long/**/*.parquet" -> DuckDB "No files found".
|
||||||
|
# Neither message points at the real cause. Normalize once, at resolution.
|
||||||
|
# ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
test_that(".resolve_url appends a missing trailing slash", {
|
||||||
|
withr::local_envvar(USCOGDATA_URL = "https://example.org/s/TOKEN/download")
|
||||||
|
expect_equal(.resolve_url(), "https://example.org/s/TOKEN/download/")
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that(".resolve_url leaves an existing trailing slash alone", {
|
||||||
|
withr::local_envvar(USCOGDATA_URL = "https://example.org/s/TOKEN/download/")
|
||||||
|
expect_equal(.resolve_url(), "https://example.org/s/TOKEN/download/")
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that(".resolve_url normalizes a local path without a trailing slash", {
|
||||||
|
withr::local_envvar(USCOGDATA_URL = "/tmp/corpus")
|
||||||
|
expect_equal(.resolve_url(), "/tmp/corpus/")
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that(".resolve_url does not invent a slash for an empty setting", {
|
||||||
|
# An unset/empty URL must stay empty so the "not configured" guard in
|
||||||
|
# manifest.R still fires, rather than degrading into a bare "/" root.
|
||||||
|
withr::local_envvar(USCOGDATA_URL = "")
|
||||||
|
withr::local_options(uscogdata.url = "")
|
||||||
|
expect_equal(.resolve_url(), "")
|
||||||
|
})
|
||||||
|
|||||||
@@ -176,16 +176,6 @@ test_that("recipe = requires schema_version >= 5", {
|
|||||||
})
|
})
|
||||||
|
|
||||||
# --- signposting -------------------------------------------------------
|
# --- 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", {
|
test_that("signposting suggests corrections_combined across the 2011->2012 gap", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
@@ -203,96 +193,10 @@ test_that("signposting suggests corrections_combined across the 2011->2012 gap",
|
|||||||
expect_equal(hit$available_years, c(1967L, 2023L))
|
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\")", {
|
test_that("no signposting when the result already has full year coverage", {
|
||||||
skip_if_no_corpus()
|
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")
|
r <- cog_spending("121011212191", years = 2019:2020, category = "Corrections")
|
||||||
prov <- attr(r, "provenance")
|
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)
|
expect_length(prov$suggestions, 0L)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|||||||
@@ -1,164 +0,0 @@
|
|||||||
# 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")
|
|
||||||
})
|
|
||||||
Reference in New Issue
Block a user