Compare commits
33
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
4d61692f05
|
||
|
|
70cf553828
|
||
|
|
3c55447308
|
||
|
|
92c9a7382e
|
||
|
|
570a9408a2
|
||
|
|
e635a1fc9e
|
||
|
|
874347242b
|
||
|
|
0dd3f15ada | ||
|
|
919548685b | ||
|
|
716cfe25e5 | ||
|
|
33c0274727 | ||
|
|
c46354f049
|
||
|
|
916212c327
|
||
|
|
a2ced368f5
|
||
|
|
b7ebb4cd88
|
||
|
|
c334be7706
|
||
|
|
cadce8d528 | ||
|
|
a92450ff76
|
||
|
|
54dd40a61d
|
||
|
|
807ed35cb7
|
||
|
|
9ae46746c0 | ||
|
|
9238b04b69
|
||
|
|
cbc867bed1 | ||
|
|
4ea0583d3a
|
||
|
|
e4a105013e | ||
|
|
21b3d66c0e
|
||
|
|
df3fe3731b | ||
|
|
ed9658d267
|
||
|
|
a28fb2e19b | ||
|
|
24e4449be7 | ||
|
|
cfcda04e0c | ||
|
|
a25ba5f348 | ||
|
|
e7fa51eec7 |
@@ -10,3 +10,9 @@
|
||||
^\.gitignore$
|
||||
\.gitkeep$
|
||||
^vignettes$
|
||||
^specs$
|
||||
^plans$
|
||||
^doc$
|
||||
^Meta$
|
||||
^\.gitea$
|
||||
^CLAUDE\.md$
|
||||
|
||||
+2
-2
@@ -31,5 +31,5 @@ Suggests:
|
||||
Config/testthat/edition: 3
|
||||
VignetteBuilder: knitr
|
||||
RoxygenNote: 7.3.3
|
||||
MinCorpusSchema: 3
|
||||
MaxCorpusSchema: 3
|
||||
MinCorpusSchema: 4
|
||||
MaxCorpusSchema: 4
|
||||
|
||||
@@ -7,6 +7,7 @@ export(cog_explain)
|
||||
export(cog_find_peers)
|
||||
export(cog_geographic_rollup)
|
||||
export(cog_gov_search)
|
||||
export(cog_manifest)
|
||||
export(cog_mirror)
|
||||
export(cog_peer_compare)
|
||||
export(cog_revenue)
|
||||
|
||||
@@ -1,5 +1,84 @@
|
||||
# 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
|
||||
|
||||
* `cog_gov_search()` gains a **basket mode**: passing vector `name`
|
||||
|
||||
+22
@@ -74,6 +74,16 @@ cog_explain <- function(result, format = c("print", "list")) {
|
||||
pc <- prov$transformations$per_capita
|
||||
if (isTRUE(pc$applied)) {
|
||||
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
|
||||
if (isTRUE(infl$applied)) {
|
||||
@@ -98,3 +108,15 @@ cog_explain <- function(result, format = c("print", "list")) {
|
||||
|
||||
invisible(NULL)
|
||||
}
|
||||
|
||||
# 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
|
||||
}
|
||||
|
||||
+114
-7
@@ -1,5 +1,66 @@
|
||||
# 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),
|
||||
#' cache locally, validate TTL.
|
||||
#' @noRd
|
||||
@@ -11,23 +72,54 @@
|
||||
if (!file.exists(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")
|
||||
ttl <- as.integer(.cfg("manifest_ttl_secs"))
|
||||
|
||||
needs_fetch <- !file.exists(cache_path) ||
|
||||
difftime(Sys.time(), file.info(cache_path)$mtime, units = "secs") > ttl
|
||||
cache_fresh <- file.exists(cache_path) &&
|
||||
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")) |>
|
||||
httr2::req_error(is_error = function(r) httr2::resp_status(r) >= 400) |>
|
||||
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
|
||||
@@ -54,3 +146,18 @@
|
||||
}
|
||||
|
||||
`%||%` <- 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
|
||||
}
|
||||
|
||||
@@ -2,31 +2,33 @@
|
||||
|
||||
#' Find peer governments by similarity criteria
|
||||
#'
|
||||
#' Selects peer governments from `canonical_fips_xwalk` by combinations of
|
||||
#' government type, state, and population range. Peers are ordered by
|
||||
#' `|log(pop_ratio)|` ascending (closest to the target's population first).
|
||||
#' Selects peer governments by combinations of government type, state, and
|
||||
#' population range at a chosen `year`. Peers are ordered by `|log(pop_ratio)|`
|
||||
#' ascending (closest to the target's population first).
|
||||
#'
|
||||
#' @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
|
||||
#' `govs_type`.
|
||||
#' @param same_state If `TRUE` restrict peers to the target's `fips_state`.
|
||||
#' Default `FALSE`.
|
||||
#' @param pop_range Length-2 numeric vector giving lower/upper bounds.
|
||||
#' @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.
|
||||
#' @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.
|
||||
#' @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
|
||||
cog_find_peers <- function(target_govid,
|
||||
year = NULL,
|
||||
same_type = TRUE,
|
||||
same_state = FALSE,
|
||||
pop_range = c(0.7, 1.3),
|
||||
is_ratio = TRUE,
|
||||
pop_year = NULL,
|
||||
max_peers = 10L) {
|
||||
if (!is.character(target_govid) || length(target_govid) != 1L) {
|
||||
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]) {
|
||||
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()
|
||||
|
||||
target_sql <- sprintf(
|
||||
"SELECT canonical_govid, gov_name, govs_type, fips_state, population_acs
|
||||
# Confirm target exists in the xwalk and pull govs_type / fips_state.
|
||||
meta_sql <- sprintf(
|
||||
"SELECT canonical_govid, gov_name, govs_type, fips_state
|
||||
FROM canonical_fips_xwalk
|
||||
WHERE canonical_govid = %s",
|
||||
.sql_lit_chr(target_govid)
|
||||
)
|
||||
target <- DBI::dbGetQuery(con, target_sql)
|
||||
if (nrow(target) == 0L) {
|
||||
meta <- DBI::dbGetQuery(con, meta_sql)
|
||||
if (nrow(meta) == 0L) {
|
||||
cli::cli_abort(c(
|
||||
"govid {target_govid} not found in corpus.",
|
||||
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)) {
|
||||
lo <- target$population_acs * pop_range[1]
|
||||
hi <- target$population_acs * pop_range[2]
|
||||
lo <- target_pop * pop_range[1]
|
||||
hi <- target_pop * pop_range[2]
|
||||
} else {
|
||||
lo <- pop_range[1]; hi <- pop_range[2]
|
||||
}
|
||||
|
||||
preds <- c(
|
||||
sprintf("canonical_govid != %s", .sql_lit_chr(target_govid)),
|
||||
sprintf("population_acs BETWEEN %.6f AND %.6f", lo, hi)
|
||||
sprintf("p.canonical_govid != %s", .sql_lit_chr(target_govid)),
|
||||
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_state)) preds <- c(preds, sprintf("fips_state = %s", .sql_lit_chr(target$fips_state)))
|
||||
if (isTRUE(same_type)) preds <- c(preds, sprintf("x.govs_type = %d", meta$govs_type))
|
||||
if (isTRUE(same_state)) preds <- c(preds, sprintf("x.fips_state = %s", .sql_lit_chr(meta$fips_state)))
|
||||
|
||||
peers_sql <- sprintf(
|
||||
"SELECT canonical_govid, gov_name, fips_state, population_acs,
|
||||
population_acs / %.6f AS pop_ratio
|
||||
FROM canonical_fips_xwalk
|
||||
"SELECT p.canonical_govid, x.gov_name, x.fips_state, p.population,
|
||||
p.population / %.6f AS pop_ratio
|
||||
FROM gov_population_yearly p
|
||||
JOIN canonical_fips_xwalk x USING (canonical_govid)
|
||||
WHERE %s
|
||||
ORDER BY ABS(LN(CAST(population_acs AS DOUBLE) / %.6f))
|
||||
ORDER BY ABS(LN(CAST(p.population AS DOUBLE) / %.6f))
|
||||
LIMIT %d",
|
||||
target$population_acs,
|
||||
target_pop,
|
||||
paste(preds, collapse = " AND "),
|
||||
target$population_acs,
|
||||
target_pop,
|
||||
as.integer(max_peers)
|
||||
)
|
||||
peers <- tibble::as_tibble(DBI::dbGetQuery(con, peers_sql))
|
||||
if (nrow(peers) > 0L) peers$rank <- seq_len(nrow(peers))
|
||||
else peers$rank <- integer(0)
|
||||
peers$rank <- if (nrow(peers) > 0L) seq_len(nrow(peers)) else 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
|
||||
}
|
||||
|
||||
#' @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
|
||||
#'
|
||||
#' 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`.
|
||||
#' @return Tibble matching [cog_spending()]'s columns, plus a `role`
|
||||
#' column taking values `"target"`, `"peer"`, `"summary_p25"`,
|
||||
#' `"summary_p50"`, or `"summary_p75"`, and `target_rank` (target's rank
|
||||
#' among target+peers at `max(years)`, NA for other rows). Provenance
|
||||
#' attribute reports `verb = "cog_peer_compare"` and `peer_count`.
|
||||
#' `"summary_p50"`, or `"summary_p75"`, `target_rank` (target's rank
|
||||
#' among target+peers at `max(years)`, NA for other rows), and
|
||||
#' `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
|
||||
cog_peer_compare <- function(target_govid, peers, category, years,
|
||||
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) {
|
||||
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)) {
|
||||
as.character(peers$canonical_govid)
|
||||
} else {
|
||||
@@ -132,11 +183,16 @@ cog_peer_compare <- function(target_govid, peers, category, years,
|
||||
out <- dplyr::bind_rows(r, summary_rows)
|
||||
rank_val <- .peer_target_rank(r, target_govid, years, value_col)
|
||||
out$target_rank <- ifelse(out$role == "target", rank_val, NA_integer_)
|
||||
out$cohort_year <- cohort_year
|
||||
|
||||
prov <- attr(r, "provenance") %||% list()
|
||||
prov$verb <- "cog_peer_compare"
|
||||
prov$call <- paste(deparse(call), collapse = " ")
|
||||
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(
|
||||
canonical_govid = target_govid,
|
||||
gov_name = unique(r$gov_name[r$role == "target"])
|
||||
|
||||
+19
-1
@@ -61,9 +61,27 @@
|
||||
per_capita = list(
|
||||
applied = 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 {
|
||||
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(
|
||||
|
||||
+1
-1
@@ -11,7 +11,7 @@
|
||||
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||
#' `revenue_subtype`, `category`, `amt_nominal`, optional `amt_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
|
||||
cog_revenue <- function(govid, years, category = NULL,
|
||||
per_capita = FALSE, adjust_to_year = NULL) {
|
||||
|
||||
+27
-7
@@ -8,28 +8,35 @@
|
||||
#' "place portraits" that compare a city to the surrounding county and
|
||||
#' 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
|
||||
#' `state`, `county`, `city`. Each element is a character vector of
|
||||
#' `canonical_govid` values. At least one layer required.
|
||||
#' @param category Single category name or character vector (passed through
|
||||
#' to [cog_spending()]).
|
||||
#' @param years Integer vector of years.
|
||||
#' @param per_capita If `TRUE`, per-capita uses each layer's own population
|
||||
#' from `canonical_fips_xwalk.population_acs`.
|
||||
#' @param per_capita If `TRUE`, per-capita uses each gov's own per-year
|
||||
#' 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`.
|
||||
#' @return Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
||||
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
||||
#' `amt_per_capita_nominal` / `amt_per_capita_real`, `codes_included`,
|
||||
#' `aggregate_fallback`, `scope_note`, `notes`. Carries a `provenance`
|
||||
#' attribute with `verb = "cog_geographic_rollup"` and `layers`.
|
||||
#' `amt_per_capita_nominal` / `amt_per_capita_real`, optional `pop_source`,
|
||||
#' `codes_included`, `aggregate_fallback`, `scope_note`, `notes`. Carries a
|
||||
#' `provenance` attribute with `verb = "cog_geographic_rollup"`, `layers`,
|
||||
#' and `rollup$included_govids` / `rollup$excluded_govids`.
|
||||
#' @export
|
||||
cog_geographic_rollup <- function(govids, category, years,
|
||||
per_capita = FALSE, adjust_to_year = NULL) {
|
||||
call <- match.call()
|
||||
.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]]")
|
||||
if (any(lengths(govids) == 0L)) {
|
||||
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",
|
||||
relationship = "many-to-many")
|
||||
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)
|
||||
|
||||
prov <- attr(r, "provenance")
|
||||
prov$verb <- "cog_geographic_rollup"
|
||||
prov$call <- paste(deparse(call), collapse = " ")
|
||||
prov$layers <- layer_names
|
||||
prov$rollup <- list(
|
||||
included_govids = included,
|
||||
excluded_govids = excluded
|
||||
)
|
||||
attr(r, "provenance") <- prov
|
||||
|
||||
r
|
||||
|
||||
+4
-3
@@ -126,9 +126,10 @@ cog_gov_search <- function(name = NULL, state = NULL, type = NULL) {
|
||||
canonical_govid = character(0), gov_name = character(0),
|
||||
govs_type = integer(0), type_label = character(0),
|
||||
fips_state = character(0), fips_county = character(0),
|
||||
fips_place = character(0), first_year = integer(0),
|
||||
last_year = integer(0), population_acs = integer(0),
|
||||
confidence = character(0)
|
||||
fips_place = character(0), legacy_govs_id = character(0),
|
||||
first_year = integer(0), last_year = integer(0),
|
||||
census_geoid = character(0), population_acs = integer(0),
|
||||
pop_confidence = character(0), id_source = character(0)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
+2
-1
@@ -5,13 +5,14 @@
|
||||
#' @noRd
|
||||
cog_open <- function(url = .resolve_url(),
|
||||
cache_dir = .resolve_cache_dir()) {
|
||||
.check_url_configured(url)
|
||||
if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE)
|
||||
|
||||
con <- DBI::dbConnect(duckdb::duckdb())
|
||||
DBI::dbExecute(con, "INSTALL httpfs; LOAD httpfs;")
|
||||
|
||||
manifest <- .fetch_or_cache_manifest(url, cache_dir)
|
||||
.validate_schema(manifest, expected_version = 3L)
|
||||
.validate_schema(manifest, expected_version = 4L)
|
||||
.validate_scope(manifest)
|
||||
|
||||
.register_views(con, url, manifest)
|
||||
|
||||
+54
-16
@@ -13,15 +13,18 @@
|
||||
#' @param category Character vector of category names (from
|
||||
#' `summary_categories.category`), or `NULL` for all categories.
|
||||
#' @param per_capita If `TRUE`, adds `amt_per_capita_nominal` (and
|
||||
#' `amt_per_capita_real` when `adjust_to_year` is set) using
|
||||
#' `population_acs` from the canonical xwalk.
|
||||
#' `amt_per_capita_real` when `adjust_to_year` is set) using the per-year
|
||||
#' Census F-33 population from `gov_population_yearly`. Result also gains
|
||||
#' a `pop_source` column with values `"census_f33"` or `"unavailable"`
|
||||
#' (the latter for gov types 4/5 and any row whose population is missing
|
||||
#' in that year).
|
||||
#' @param adjust_to_year Integer base year for CPI-U real-dollar conversion,
|
||||
#' or `NULL` for nominal only.
|
||||
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
||||
#' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
||||
#' `codes_included`, `aggregate_fallback`, `notes`. Carries a `provenance`
|
||||
#' attribute matching `inst/schemas/provenance-v1.json`.
|
||||
#' optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
|
||||
#' Carries a `provenance` attribute matching `inst/schemas/provenance-v1.json`.
|
||||
#' @export
|
||||
cog_spending <- function(govid, years, category = NULL,
|
||||
per_capita = FALSE, adjust_to_year = NULL) {
|
||||
@@ -76,6 +79,7 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
prov$scope$govids_found <- scope$found
|
||||
prov$scope$govids_missing <- scope$missing
|
||||
attr(result, "provenance") <- prov
|
||||
attr(result, ".popyear_range") <- NULL
|
||||
result
|
||||
}
|
||||
|
||||
@@ -143,18 +147,32 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
.attach_per_capita <- function(result, con, govid) {
|
||||
if (nrow(result) == 0L) {
|
||||
result$amt_per_capita_nominal <- numeric(0)
|
||||
result$pop_source <- character(0)
|
||||
attr(result, ".popyear_range") <- integer(0)
|
||||
return(result)
|
||||
}
|
||||
years_lit <- paste(unique(as.integer(result$year)), collapse = ",")
|
||||
sql <- sprintf(
|
||||
"SELECT canonical_govid, population_acs
|
||||
FROM canonical_fips_xwalk
|
||||
WHERE canonical_govid IN (%s)",
|
||||
.sql_lit_chr(govid)
|
||||
"SELECT canonical_govid, year, population, popyear
|
||||
FROM gov_population_yearly
|
||||
WHERE canonical_govid IN (%s)
|
||||
AND year IN (%s)",
|
||||
.sql_lit_chr(govid), years_lit
|
||||
)
|
||||
pops <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
||||
result <- dplyr::left_join(result, pops, by = "canonical_govid")
|
||||
result$amt_per_capita_nominal <- result$amt_nominal / result$population_acs
|
||||
result$population_acs <- NULL
|
||||
result <- dplyr::left_join(result, pops,
|
||||
by = c("canonical_govid", "year"))
|
||||
result$amt_per_capita_nominal <- result$amt_nominal / result$population
|
||||
result$pop_source <- ifelse(is.na(result$population),
|
||||
"unavailable", "census_f33")
|
||||
py <- result$popyear[!is.na(result$popyear)]
|
||||
attr(result, ".popyear_range") <- if (length(py) > 0L) {
|
||||
as.integer(c(min(py), max(py)))
|
||||
} else {
|
||||
integer(0)
|
||||
}
|
||||
result$population <- NULL
|
||||
result$popyear <- NULL
|
||||
result
|
||||
}
|
||||
|
||||
@@ -176,10 +194,30 @@ cog_spending <- function(govid, years, category = NULL,
|
||||
|
||||
#' @noRd
|
||||
.notes_column <- function(result) {
|
||||
if (nrow(result) == 0L) return(character(0))
|
||||
ifelse(
|
||||
isTRUE(result$aggregate_fallback) | result$aggregate_fallback %in% TRUE,
|
||||
n <- nrow(result)
|
||||
if (n == 0L) return(character(0))
|
||||
parts <- vector("list", 2L)
|
||||
agg <- result[["aggregate_fallback"]]
|
||||
parts[[1]] <- if (!is.null(agg)) {
|
||||
ifelse(agg %in% TRUE,
|
||||
"Aggregate fallback applied; see cog_explain()",
|
||||
""
|
||||
)
|
||||
NA_character_)
|
||||
} else {
|
||||
rep(NA_character_, n)
|
||||
}
|
||||
ps <- result[["pop_source"]]
|
||||
parts[[2]] <- if (!is.null(ps)) {
|
||||
ifelse(ps == "unavailable",
|
||||
"No population denominator available for this gov type",
|
||||
NA_character_)
|
||||
} else {
|
||||
rep(NA_character_, n)
|
||||
}
|
||||
out <- character(n)
|
||||
for (i in seq_len(n)) {
|
||||
pieces <- vapply(parts, `[[`, character(1), i)
|
||||
pieces <- pieces[!is.na(pieces)]
|
||||
out[i] <- if (length(pieces) == 0L) "" else paste(pieces, collapse = "; ")
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
@@ -0,0 +1,215 @@
|
||||
# data-raw/regenerate_fixture_corpus.R
|
||||
#
|
||||
# Regenerate inst/extdata/fixture_corpus/ from a cog_pipeline publish tree.
|
||||
#
|
||||
# What this does:
|
||||
# 1. Copies the year=2019 and year=2020 long partitions as-is (byte-for-
|
||||
# byte) from <publish_cache>/data/long/ into the fixture.
|
||||
# 2. Copies the full canonical_fips_xwalk.parquet, canonical_alias.parquet,
|
||||
# and summary_categories.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(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, and
|
||||
# summary_categories parquet tables.
|
||||
#' @noRd
|
||||
.copy_metadata_parquets <- function(publish_cache_dir, fixture_dir) {
|
||||
files <- c(
|
||||
"canonical_fips_xwalk.parquet",
|
||||
"canonical_alias.parquet",
|
||||
"summary_categories.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"
|
||||
)
|
||||
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(
|
||||
"Two-year (2019-2020) fixture for uscogdata tests. Full corpus",
|
||||
"available via USCOGDATA_URL. Regenerated for Phase P",
|
||||
"(schema_version 4, uniformly 12-char canonical_govid) with the full",
|
||||
"canonical_fips_xwalk master and the new canonical_alias lookup",
|
||||
"table 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.
+18
-46
@@ -1,54 +1,21 @@
|
||||
{
|
||||
"schema_version": 3,
|
||||
"built_at": "2026-04-27T16:43:46Z",
|
||||
"pipeline_commit": "899af37",
|
||||
"fixture_note": "Two-year (2019-2020) fixture for uscogdata tests. Full corpus available via USCOGDATA_URL.",
|
||||
"schema_version": 4,
|
||||
"built_at": "2026-07-13T23:35:09Z",
|
||||
"pipeline_commit": "a082b26",
|
||||
"fixture_note": "Two-year (2019-2020) fixture for uscogdata tests. Full corpus available via USCOGDATA_URL. Regenerated for Phase P (schema_version 4, uniformly 12-char canonical_govid) with the full canonical_fips_xwalk master and the new canonical_alias lookup table via data-raw/regenerate_fixture_corpus.R.",
|
||||
"data_vintage": {
|
||||
"census_source_downloaded": "unknown",
|
||||
"cpi_vintage": "FRED CPIAUCSL",
|
||||
"acs_vintage": "ACS 2018-2022 5-year"
|
||||
},
|
||||
"scope": {
|
||||
"gov_types_included": [
|
||||
0,
|
||||
1,
|
||||
2,
|
||||
3
|
||||
],
|
||||
"gov_types_excluded": [
|
||||
4,
|
||||
5
|
||||
],
|
||||
"gov_types_included": [0, 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."
|
||||
},
|
||||
"schema": {
|
||||
"long_column_count": 24,
|
||||
"long_columns": [
|
||||
"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"
|
||||
],
|
||||
"long_columns": ["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"
|
||||
},
|
||||
"files": {
|
||||
@@ -56,27 +23,32 @@
|
||||
{
|
||||
"year": 2019,
|
||||
"path": "data/long/year=2019/part-0.parquet",
|
||||
"sha256": "e1c9f426c6d7d3c51d06b3a652473b987b304836619c213f019cee4887714daa",
|
||||
"sha256": "c0a2bf0758af129d5dfddb6ff6665cc435ddee87fd6879e788fb56ed53ab22b8",
|
||||
"row_count": 318139,
|
||||
"size_bytes": 1424231
|
||||
"size_bytes": 1441404
|
||||
},
|
||||
{
|
||||
"year": 2020,
|
||||
"path": "data/long/year=2020/part-0.parquet",
|
||||
"sha256": "9b795853a848e8c955c80261b96b79630fc77394dcfb1a1ca288e2cd634053a3",
|
||||
"sha256": "92570b9d55ec3425d034db37838f91c3b8359d0454d3d98730a6016b62e4bb48",
|
||||
"row_count": 317500,
|
||||
"size_bytes": 1427150
|
||||
"size_bytes": 1444011
|
||||
}
|
||||
],
|
||||
"metadata": [
|
||||
{
|
||||
"path": "data/canonical_alias.parquet",
|
||||
"sha256": "feb8d01a640fb16c9a4b4ad66726b50b8fe8a1ce2a771bed8c1190fec51d5c8d",
|
||||
"description": "canonical_alias.parquet"
|
||||
},
|
||||
{
|
||||
"path": "data/canonical_fips_xwalk.parquet",
|
||||
"sha256": "86e53e04a35f6f90bb74bb1a273e053392afa782d6f518e3e3da9c976d47f7af",
|
||||
"sha256": "1ae47981531c7389f69eff3f7656045428564bfbe8032200eb9c039d32739a7e",
|
||||
"description": "canonical_fips_xwalk.parquet"
|
||||
},
|
||||
{
|
||||
"path": "data/summary_categories.parquet",
|
||||
"sha256": "60045e22bc2723318fa2cb73f8e5038250dc54d24b3447c6750dfe29035335b8",
|
||||
"sha256": "dd59e7f58a022679ad43511c8c8e938b8dd4be81196bbeeee21e67bdcca2295b",
|
||||
"description": "summary_categories.parquet"
|
||||
}
|
||||
]
|
||||
|
||||
@@ -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;
|
||||
+11
-9
@@ -6,17 +6,21 @@
|
||||
\usage{
|
||||
cog_find_peers(
|
||||
target_govid,
|
||||
year = NULL,
|
||||
same_type = TRUE,
|
||||
same_state = FALSE,
|
||||
pop_range = c(0.7, 1.3),
|
||||
is_ratio = TRUE,
|
||||
pop_year = NULL,
|
||||
max_peers = 10L
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\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
|
||||
`govs_type`.}
|
||||
|
||||
@@ -26,20 +30,18 @@ Default `FALSE`.}
|
||||
\item{pop_range}{Length-2 numeric vector giving lower/upper bounds.}
|
||||
|
||||
\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.}
|
||||
|
||||
\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.}
|
||||
}
|
||||
\value{
|
||||
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{
|
||||
Selects peer governments from `canonical_fips_xwalk` by combinations of
|
||||
government type, state, and population range. Peers are ordered by
|
||||
`|log(pop_ratio)|` ascending (closest to the target's population first).
|
||||
Selects peer governments by combinations of government type, state, and
|
||||
population range at a chosen `year`. Peers are ordered by `|log(pop_ratio)|`
|
||||
ascending (closest to the target's population first).
|
||||
}
|
||||
|
||||
@@ -22,17 +22,19 @@ to [cog_spending()]).}
|
||||
|
||||
\item{years}{Integer vector of years.}
|
||||
|
||||
\item{per_capita}{If `TRUE`, per-capita uses each layer's own population
|
||||
from `canonical_fips_xwalk.population_acs`.}
|
||||
\item{per_capita}{If `TRUE`, per-capita uses each gov's own per-year
|
||||
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`.}
|
||||
}
|
||||
\value{
|
||||
Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
||||
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
||||
`amt_per_capita_nominal` / `amt_per_capita_real`, `codes_included`,
|
||||
`aggregate_fallback`, `scope_note`, `notes`. Carries a `provenance`
|
||||
attribute with `verb = "cog_geographic_rollup"` and `layers`.
|
||||
`amt_per_capita_nominal` / `amt_per_capita_real`, optional `pop_source`,
|
||||
`codes_included`, `aggregate_fallback`, `scope_note`, `notes`. Carries a
|
||||
`provenance` attribute with `verb = "cog_geographic_rollup"`, `layers`,
|
||||
and `rollup$included_govids` / `rollup$excluded_govids`.
|
||||
}
|
||||
\description{
|
||||
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
|
||||
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')`.
|
||||
}
|
||||
|
||||
@@ -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.
|
||||
}
|
||||
@@ -31,9 +31,12 @@ population.}
|
||||
\value{
|
||||
Tibble matching [cog_spending()]'s columns, plus a `role`
|
||||
column taking values `"target"`, `"peer"`, `"summary_p25"`,
|
||||
`"summary_p50"`, or `"summary_p75"`, and `target_rank` (target's rank
|
||||
among target+peers at `max(years)`, NA for other rows). Provenance
|
||||
attribute reports `verb = "cog_peer_compare"` and `peer_count`.
|
||||
`"summary_p50"`, or `"summary_p75"`, `target_rank` (target's rank
|
||||
among target+peers at `max(years)`, NA for other rows), and
|
||||
`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{
|
||||
Pulls spending for the target plus a peer set (either a
|
||||
|
||||
+6
-3
@@ -21,8 +21,11 @@ cog_revenue(
|
||||
`summary_categories.category`), or `NULL` for all categories.}
|
||||
|
||||
\item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and
|
||||
`amt_per_capita_real` when `adjust_to_year` is set) using
|
||||
`population_acs` from the canonical xwalk.}
|
||||
`amt_per_capita_real` when `adjust_to_year` is set) using the per-year
|
||||
Census F-33 population from `gov_population_yearly`. Result also gains
|
||||
a `pop_source` column with values `"census_f33"` or `"unavailable"`
|
||||
(the latter for gov types 4/5 and any row whose population is missing
|
||||
in that year).}
|
||||
|
||||
\item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion,
|
||||
or `NULL` for nominal only.}
|
||||
@@ -31,7 +34,7 @@ or `NULL` for nominal only.}
|
||||
Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||
`revenue_subtype`, `category`, `amt_nominal`, optional `amt_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{
|
||||
Mirror of [cog_spending()] for revenue categories. One row per
|
||||
|
||||
+7
-4
@@ -21,8 +21,11 @@ cog_spending(
|
||||
`summary_categories.category`), or `NULL` for all categories.}
|
||||
|
||||
\item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and
|
||||
`amt_per_capita_real` when `adjust_to_year` is set) using
|
||||
`population_acs` from the canonical xwalk.}
|
||||
`amt_per_capita_real` when `adjust_to_year` is set) using the per-year
|
||||
Census F-33 population from `gov_population_yearly`. Result also gains
|
||||
a `pop_source` column with values `"census_f33"` or `"unavailable"`
|
||||
(the latter for gov types 4/5 and any row whose population is missing
|
||||
in that year).}
|
||||
|
||||
\item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion,
|
||||
or `NULL` for nominal only.}
|
||||
@@ -31,8 +34,8 @@ or `NULL` for nominal only.}
|
||||
Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
||||
optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
||||
`codes_included`, `aggregate_fallback`, `notes`. Carries a `provenance`
|
||||
attribute matching `inst/schemas/provenance-v1.json`.
|
||||
optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
|
||||
Carries a `provenance` attribute matching `inst/schemas/provenance-v1.json`.
|
||||
}
|
||||
\description{
|
||||
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
|
||||
@@ -41,3 +41,10 @@ test_that(".inflate preserves NA amounts", {
|
||||
expect_true(is.na(result[2]))
|
||||
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)))
|
||||
})
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
test_that("cog_explain prints verb header and target", {
|
||||
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.
|
||||
txt <- paste(c(
|
||||
capture.output(cog_explain(r)),
|
||||
@@ -8,19 +8,19 @@ test_that("cog_explain prints verb header and target", {
|
||||
), collapse = "\n")
|
||||
expect_true(grepl("cog_spending", 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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
||||
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||
prov <- cog_explain(r, format = "list")
|
||||
expect_identical(prov, attr(r, "provenance"))
|
||||
})
|
||||
|
||||
test_that("cog_explain returns result invisibly for chaining", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
||||
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||
res <- withVisible(cog_explain(r))
|
||||
expect_false(res$visible)
|
||||
expect_identical(res$value, r)
|
||||
@@ -30,3 +30,21 @@ test_that("cog_explain errors on non-verb input", {
|
||||
df <- tibble::tibble(a = 1)
|
||||
expect_error(cog_explain(df), "provenance")
|
||||
})
|
||||
|
||||
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))
|
||||
})
|
||||
})
|
||||
|
||||
@@ -0,0 +1,112 @@
|
||||
# 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(2019L, 2020L))
|
||||
})
|
||||
})
|
||||
@@ -61,7 +61,7 @@ test_that("cog_mirror reads back via a fresh session against the mirror", {
|
||||
cog_close()
|
||||
options(uscogdata.url = paste0(normalizePath(tmp), "/"))
|
||||
|
||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
||||
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||
expect_gt(nrow(r), 0L)
|
||||
expect_equal(unique(r$canonical_govid), "101006006")
|
||||
expect_equal(unique(r$canonical_govid), "121011212191")
|
||||
})
|
||||
|
||||
+64
-16
@@ -1,29 +1,29 @@
|
||||
test_that("cog_find_peers returns same-type peers in the default pop band", {
|
||||
skip_if_no_corpus()
|
||||
peers <- cog_find_peers("101006006") # Broward County
|
||||
peers <- cog_find_peers("121011212191") # Broward County
|
||||
expect_s3_class(peers, "tbl_df")
|
||||
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(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)))
|
||||
})
|
||||
|
||||
test_that("cog_find_peers respects same_state restriction", {
|
||||
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))
|
||||
expect_true(all(peers$fips_state == "12"))
|
||||
})
|
||||
|
||||
test_that("cog_find_peers absolute pop range works", {
|
||||
skip_if_no_corpus()
|
||||
peers <- cog_find_peers("101006006",
|
||||
peers <- cog_find_peers("121011212191",
|
||||
pop_range = c(1.5e6, 2.5e6),
|
||||
is_ratio = FALSE, max_peers = 20L)
|
||||
expect_true(all(peers$population_acs >= 1.5e6 &
|
||||
peers$population_acs <= 2.5e6))
|
||||
expect_true(all(peers$population >= 1.5e6 &
|
||||
peers$population <= 2.5e6))
|
||||
})
|
||||
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
peers <- cog_find_peers("101006006", max_peers = 4L)
|
||||
r <- cog_peer_compare("101006006", peers, "Police", years = 2020L)
|
||||
peers <- cog_find_peers("121011212191", max_peers = 4L)
|
||||
r <- cog_peer_compare("121011212191", peers, "Police", years = 2020L)
|
||||
expect_s3_class(r, "tbl_df")
|
||||
expect_true("role" %in% names(r))
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_peer_compare(
|
||||
"101006006",
|
||||
peers = c("441015015", "441220220"), # Bexar, Tarrant
|
||||
"121011212191",
|
||||
peers = c("481029175853", "481439135072"), # Bexar, Tarrant
|
||||
category = "Police", years = 2020L
|
||||
)
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_peer_compare(
|
||||
"101006006",
|
||||
peers = c("441015015", "441220220", "231082082"),
|
||||
"121011212191",
|
||||
peers = c("481029175853", "481439135072", "261163166615"),
|
||||
category = "Police", years = 2019:2020,
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_peer_compare("101006006",
|
||||
peers = c("441015015", "441220220"),
|
||||
r <- cog_peer_compare("121011212191",
|
||||
peers = c("481029175853", "481439135072"),
|
||||
category = "Police", years = 2020L)
|
||||
prov <- attr(r, "provenance")
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_peer_compare("101006006",
|
||||
r <- cog_peer_compare("121011212191",
|
||||
peers = character(0),
|
||||
category = "Police", years = 2020L)
|
||||
expect_true(all(r$role == "target"))
|
||||
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)))
|
||||
})
|
||||
|
||||
@@ -1,24 +1,24 @@
|
||||
test_that("cog_revenue returns expected shape for Broward Property Tax 2020", {
|
||||
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")
|
||||
expected_cols <- c("year", "canonical_govid", "gov_name", "revenue_subtype",
|
||||
"category", "amt_nominal", "codes_included",
|
||||
"aggregate_fallback", "notes")
|
||||
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)
|
||||
})
|
||||
|
||||
test_that("cog_revenue with no category filter returns multiple categories", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_revenue("101006006", years = 2020L)
|
||||
r <- cog_revenue("121011212191", years = 2020L)
|
||||
expect_gt(length(unique(r$category)), 1L)
|
||||
})
|
||||
|
||||
test_that("cog_revenue with per_capita + adjust_to_year adds all columns", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_revenue("101006006", 2020L,
|
||||
r <- cog_revenue("121011212191", 2020L,
|
||||
per_capita = TRUE, adjust_to_year = 2022L)
|
||||
expect_true(all(c("amt_nominal", "amt_real",
|
||||
"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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_revenue("101006006", 2020L)
|
||||
r <- cog_revenue("121011212191", 2020L)
|
||||
prov <- attr(r, "provenance")
|
||||
expect_equal(prov$verb, "cog_revenue")
|
||||
expect_true(grepl("revenue_annotated", prov$sql_query))
|
||||
|
||||
@@ -2,9 +2,9 @@ test_that("cog_geographic_rollup aggregates state + county + city layers", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_geographic_rollup(
|
||||
govids = list(
|
||||
state = "100000000", # Florida state govt
|
||||
county = "101006006", # Broward County
|
||||
city = "102006004" # Fort Lauderdale City
|
||||
state = "120000226351", # Florida state govt
|
||||
county = "121011212191", # Broward County
|
||||
city = "122011161585" # Fort Lauderdale City
|
||||
),
|
||||
category = "Police",
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_geographic_rollup(
|
||||
govids = list(county = "101006006", city = "102006004"),
|
||||
govids = list(county = "121011212191", city = "122011161585"),
|
||||
category = "Police",
|
||||
years = 2020L,
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_geographic_rollup(
|
||||
govids = list(state = "100000000", county = "101006006",
|
||||
city = "102006004"),
|
||||
govids = list(state = "120000226351", county = "121011212191",
|
||||
city = "122011161585"),
|
||||
category = "Police", years = 2020L
|
||||
)
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_geographic_rollup(
|
||||
govids = list(county = c("101006006")),
|
||||
govids = list(county = c("121011212191")),
|
||||
category = "Corrections",
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_geographic_rollup(
|
||||
govids = list(state = "100000000", county = "101006006"),
|
||||
govids = list(state = "120000226351", county = "121011212191"),
|
||||
category = "Police", years = 2020L
|
||||
)
|
||||
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", {
|
||||
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")
|
||||
r <- cog_geographic_rollup(
|
||||
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", {
|
||||
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(
|
||||
cog_geographic_rollup(list(planet = "100000000"), "Police", 2020L),
|
||||
cog_geographic_rollup(list(planet = "120000226351"), "Police", 2020L),
|
||||
"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))
|
||||
})
|
||||
})
|
||||
|
||||
@@ -146,7 +146,7 @@ test_that(".resolve_basket_row exact match returns one row", {
|
||||
expect_equal(out$match_method, "exact")
|
||||
expect_equal(out$n_candidates, 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")
|
||||
})
|
||||
|
||||
@@ -157,7 +157,7 @@ test_that(".resolve_basket_row exact match is case-insensitive", {
|
||||
)
|
||||
expect_equal(out$status, "resolved")
|
||||
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", {
|
||||
@@ -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
|
||||
)
|
||||
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", {
|
||||
@@ -177,7 +177,7 @@ test_that(".resolve_basket_row substring fallback resolves single match", {
|
||||
expect_equal(out$status, "resolved")
|
||||
expect_equal(out$match_method, "substring")
|
||||
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", {
|
||||
@@ -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", {
|
||||
# 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()
|
||||
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$match_method, "substring")
|
||||
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")
|
||||
})
|
||||
|
||||
@@ -241,7 +245,7 @@ test_that(".resolve_basket_row resolves with type override on ambiguous case", {
|
||||
)
|
||||
expect_equal(out$status, "resolved")
|
||||
expect_equal(out$match_method, "substring")
|
||||
expect_equal(out$row$canonical_govid, "052037010")
|
||||
expect_equal(out$row$canonical_govid, "062073207598")
|
||||
})
|
||||
|
||||
# ---- 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_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"))
|
||||
})
|
||||
|
||||
@@ -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.
|
||||
expect_equal(nrow(basket), 1L)
|
||||
expect_equal(basket$canonical_govid, "101006006")
|
||||
expect_equal(basket$canonical_govid, "121011212191")
|
||||
res <- attr(basket, "resolution")
|
||||
expect_equal(nrow(res), 3L)
|
||||
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"
|
||||
)
|
||||
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", {
|
||||
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(
|
||||
name = c("Miami", "OAKLAND CITY"),
|
||||
state = c("FL", "CA")
|
||||
state = c("FL", "CA"),
|
||||
type = c("city", NA)
|
||||
))
|
||||
expect_equal(nrow(basket), 2L)
|
||||
res <- attr(basket, "resolution")
|
||||
miami_row <- res[res$query_name == "Miami", ]
|
||||
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(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.
|
||||
expect_equal(nrow(basket), 1L)
|
||||
expect_equal(basket$canonical_govid, "101006006")
|
||||
expect_equal(basket$canonical_govid, "121011212191")
|
||||
res <- attr(basket, "resolution")
|
||||
expect_equal(res$status, c("resolved", "no_match"))
|
||||
# query_type should record what the user passed for the excluded-type row
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
test_that("cog_spending returns expected shape for Broward Corrections 2020", {
|
||||
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")
|
||||
expected_cols <- c("year", "canonical_govid", "gov_name", "spend_subtype",
|
||||
"category", "amt_nominal", "codes_included",
|
||||
"aggregate_fallback", "notes")
|
||||
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$category), "Corrections")
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_spending("101006006", 2019:2020,
|
||||
r <- cog_spending("121011212191", 2019:2020,
|
||||
category = c("Corrections", "Police"))
|
||||
expect_true(all(r$year %in% 2019:2020))
|
||||
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", {
|
||||
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_false("amt_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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_spending("101006006", 2019:2020, "Corrections",
|
||||
r <- cog_spending("121011212191", 2019:2020, "Corrections",
|
||||
adjust_to_year = 2022L)
|
||||
expect_true("amt_real" %in% names(r))
|
||||
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", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_spending("101006006", 2020L, "Corrections",
|
||||
r <- cog_spending("121011212191", 2020L, "Corrections",
|
||||
per_capita = TRUE, adjust_to_year = 2022L)
|
||||
expect_true(all(c("amt_nominal", "amt_real",
|
||||
"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", {
|
||||
skip_if_no_corpus()
|
||||
suppressMessages(
|
||||
r <- cog_spending(c("101006006", "XXXINVALID"), 2020L, "Corrections")
|
||||
r <- cog_spending(c("121011212191", "XXXINVALID"), 2020L, "Corrections")
|
||||
)
|
||||
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")
|
||||
})
|
||||
|
||||
test_that("cog_spending result has provenance attribute matching schema", {
|
||||
skip_if_no_corpus()
|
||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
||||
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||
prov <- attr(r, "provenance")
|
||||
expect_type(prov, "list")
|
||||
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", {
|
||||
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", {
|
||||
@@ -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")
|
||||
expect_gt(nrow(picks), 0L)
|
||||
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", {
|
||||
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")
|
||||
expect_setequal(unique(r$canonical_govid),
|
||||
sort(peers$canonical_govid))
|
||||
@@ -128,3 +128,64 @@ test_that("cog_spending accepts a basket-mode cog_gov_search result", {
|
||||
expect_s3_class(spending, "tbl_df")
|
||||
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)
|
||||
})
|
||||
})
|
||||
|
||||
@@ -57,3 +57,34 @@ test_that("spending_annotated carries category + xwalk columns", {
|
||||
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(2019L, 2020L))
|
||||
expect_equal(nrow(df), 2L)
|
||||
expect_true(all(!is.na(df$population)))
|
||||
# Hardcoded values are from the bundled fixture (regenerated 2026-07-11
|
||||
# against cog_pipeline publish tree, pipeline_commit 1a00925, Phase P
|
||||
# schema_version 4). Update if the fixture is rebuilt against a
|
||||
# different source vintage.
|
||||
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)
|
||||
})
|
||||
})
|
||||
|
||||
@@ -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.
|
||||
Reference in New Issue
Block a user