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$
|
^\.gitignore$
|
||||||
\.gitkeep$
|
\.gitkeep$
|
||||||
^vignettes$
|
^vignettes$
|
||||||
|
^specs$
|
||||||
|
^plans$
|
||||||
|
^doc$
|
||||||
|
^Meta$
|
||||||
|
^\.gitea$
|
||||||
|
^CLAUDE\.md$
|
||||||
|
|||||||
+2
-2
@@ -31,5 +31,5 @@ Suggests:
|
|||||||
Config/testthat/edition: 3
|
Config/testthat/edition: 3
|
||||||
VignetteBuilder: knitr
|
VignetteBuilder: knitr
|
||||||
RoxygenNote: 7.3.3
|
RoxygenNote: 7.3.3
|
||||||
MinCorpusSchema: 3
|
MinCorpusSchema: 4
|
||||||
MaxCorpusSchema: 3
|
MaxCorpusSchema: 4
|
||||||
|
|||||||
@@ -7,6 +7,7 @@ export(cog_explain)
|
|||||||
export(cog_find_peers)
|
export(cog_find_peers)
|
||||||
export(cog_geographic_rollup)
|
export(cog_geographic_rollup)
|
||||||
export(cog_gov_search)
|
export(cog_gov_search)
|
||||||
|
export(cog_manifest)
|
||||||
export(cog_mirror)
|
export(cog_mirror)
|
||||||
export(cog_peer_compare)
|
export(cog_peer_compare)
|
||||||
export(cog_revenue)
|
export(cog_revenue)
|
||||||
|
|||||||
@@ -1,5 +1,84 @@
|
|||||||
# uscogdata 0.1.0 (development)
|
# uscogdata 0.1.0 (development)
|
||||||
|
|
||||||
|
## Breaking: corpus schema_version 4 (Phase P canonical ids)
|
||||||
|
|
||||||
|
* The package now requires corpus `schema_version = 4` (`MinCorpusSchema` /
|
||||||
|
`MaxCorpusSchema` in `DESCRIPTION` are both `4`); older corpora built
|
||||||
|
against schema 3 are rejected by `cog_open()` with a clear version-mismatch
|
||||||
|
error. `canonical_govid` is now uniformly 12 characters across every
|
||||||
|
vintage the corpus covers (previously a mix of 9-char legacy ids and
|
||||||
|
12-char FIPS ids depending on source year) — **every hardcoded
|
||||||
|
`canonical_govid` literal from a pre-Phase-P corpus is now invalid** and
|
||||||
|
must be re-resolved via `cog_gov_search()` or the new `canonical_alias`
|
||||||
|
lookup table. `canonical_fips_xwalk` gains four columns
|
||||||
|
(`legacy_govs_id`, `census_geoid`, `id_source`; `confidence` is renamed to
|
||||||
|
`pop_confidence`) and a companion `canonical_alias` table ships in the
|
||||||
|
corpus for mapping legacy/alternate ids onto the current canonical
|
||||||
|
namespace. The bundled fixture corpus (`inst/extdata/fixture_corpus/`) has
|
||||||
|
been regenerated against the Phase P publish tree, now ships the full
|
||||||
|
`canonical_fips_xwalk` and `canonical_alias` master tables alongside the
|
||||||
|
2019-2020 long partitions, and is reproducible via
|
||||||
|
`data-raw/regenerate_fixture_corpus.R`.
|
||||||
|
|
||||||
|
## Clearer errors when `USCOGDATA_URL` is unconfigured or returns non-JSON
|
||||||
|
|
||||||
|
* `cog_open()` now aborts with the `uscogdata_url_not_configured` error
|
||||||
|
class when the resolved corpus URL still contains the placeholder
|
||||||
|
`REPLACE_WITH_SHARE_TOKEN` sentinel (or is empty). The message lists both
|
||||||
|
remediation paths (`Sys.setenv(USCOGDATA_URL = ...)` and
|
||||||
|
`options(uscogdata.url = ...)`) and points at the bundled fixture for
|
||||||
|
offline testing. Previously the package proceeded to fetch the placeholder
|
||||||
|
URL, cached the resulting HTML welcome page, and failed downstream with a
|
||||||
|
cryptic `jsonlite` lexical-error.
|
||||||
|
* `.fetch_or_cache_manifest()` now parses the HTTP response body before
|
||||||
|
persisting it. Non-JSON responses (login pages, 404 HTML) raise
|
||||||
|
`uscogdata_invalid_manifest` with the URL, Content-Type, and underlying
|
||||||
|
parse error — and never write to the on-disk cache.
|
||||||
|
* Manifest cache writes are now atomic (write to `manifest.json.tmp.<pid>`
|
||||||
|
in `cache_dir`, then `file.rename` over the target), so an interrupted
|
||||||
|
fetch cannot replace a previously-good cache.
|
||||||
|
* Existing caches with non-JSON content (poisoned by the prior code path)
|
||||||
|
are silently refetched instead of returning a parse error to the caller.
|
||||||
|
* Local `USCOGDATA_URL` paths whose `manifest.json` is not valid JSON now
|
||||||
|
surface the same `uscogdata_invalid_manifest` class with file context.
|
||||||
|
|
||||||
|
## Per-capita denominators now use per-year Census F-33 population
|
||||||
|
|
||||||
|
* `cog_spending()` and `cog_revenue()` previously divided all years' amounts
|
||||||
|
by a single ACS 2018-2022 estimate (`canonical_fips_xwalk.population_acs`),
|
||||||
|
producing biased per-capita values for time-series analysis. They now
|
||||||
|
divide by the F-33 `population` recorded on each gov-year via the new
|
||||||
|
`gov_population_yearly` view. Result tibbles gain a `pop_source` column
|
||||||
|
with values `"census_f33"` or `"unavailable"`. `notes` is updated to
|
||||||
|
concatenate multiple notes with `"; "`.
|
||||||
|
|
||||||
|
## Peer cohorts can be set to a chosen year
|
||||||
|
|
||||||
|
* `cog_find_peers()` adds a `year` argument (default: most recent year for
|
||||||
|
which the target has an observed population in `gov_population_yearly`).
|
||||||
|
The returned column previously named `population_acs` is now `population`
|
||||||
|
and reflects the cohort year's vintage. The cohort year is attached to the
|
||||||
|
returned tibble as `attr(x, "cohort_year")`.
|
||||||
|
* `cog_peer_compare()` now stamps a `cohort_year` column on its result (read
|
||||||
|
from the peers tibble's attribute) and records `cohort_year` plus
|
||||||
|
`cohort_govids` in provenance. When the caller supplies a bare character
|
||||||
|
vector instead of a `cog_find_peers()` result, `cohort_year` is `NA`.
|
||||||
|
|
||||||
|
## Rollups exclude govs missing population
|
||||||
|
|
||||||
|
* `cog_geographic_rollup(per_capita = TRUE)` drops rows whose government has
|
||||||
|
`pop_source == "unavailable"` and records the dropped govids in
|
||||||
|
`provenance$rollup$excluded_govids`. This excludes special districts
|
||||||
|
(type 4) and school districts (type 5) from per-capita rollups by design.
|
||||||
|
|
||||||
|
## New: vignette and provenance metadata
|
||||||
|
|
||||||
|
* New vignette `population-denominators` covers the four population sources,
|
||||||
|
the type-4/5 coverage gap, the popyear quirk, and how to build moving-window
|
||||||
|
peer cohorts manually.
|
||||||
|
* Provenance gains `transformations$per_capita$popyear_range` and
|
||||||
|
`pop_source_counts`. `cog_explain()` renders both.
|
||||||
|
|
||||||
## New features
|
## New features
|
||||||
|
|
||||||
* `cog_gov_search()` gains a **basket mode**: passing vector `name`
|
* `cog_gov_search()` gains a **basket mode**: passing vector `name`
|
||||||
|
|||||||
+22
@@ -74,6 +74,16 @@ cog_explain <- function(result, format = c("print", "list")) {
|
|||||||
pc <- prov$transformations$per_capita
|
pc <- prov$transformations$per_capita
|
||||||
if (isTRUE(pc$applied)) {
|
if (isTRUE(pc$applied)) {
|
||||||
cli::cli_text("Per-capita denominator: {pc$denominator_source}")
|
cli::cli_text("Per-capita denominator: {pc$denominator_source}")
|
||||||
|
if (length(pc$popyear_range) == 2L) {
|
||||||
|
lo <- .expand_popyear(pc$popyear_range[1])
|
||||||
|
hi <- .expand_popyear(pc$popyear_range[2])
|
||||||
|
cli::cli_text(" popyear range: {lo}-{hi}")
|
||||||
|
}
|
||||||
|
if (!is.null(pc$pop_source_counts)) {
|
||||||
|
cli::cli_text(
|
||||||
|
" pop_source counts: census_f33={pc$pop_source_counts$census_f33}, unavailable={pc$pop_source_counts$unavailable}"
|
||||||
|
)
|
||||||
|
}
|
||||||
}
|
}
|
||||||
infl <- prov$transformations$inflation
|
infl <- prov$transformations$inflation
|
||||||
if (isTRUE(infl$applied)) {
|
if (isTRUE(infl$applied)) {
|
||||||
@@ -98,3 +108,15 @@ cog_explain <- function(result, format = c("print", "list")) {
|
|||||||
|
|
||||||
invisible(NULL)
|
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
|
# R/manifest.R
|
||||||
|
|
||||||
|
# Sentinel substring baked into the placeholder default URL. If we see this
|
||||||
|
# in the resolved URL, the user hasn't configured USCOGDATA_URL yet.
|
||||||
|
.PLACEHOLDER_TOKEN <- "REPLACE_WITH_SHARE_TOKEN"
|
||||||
|
|
||||||
|
#' Abort with actionable guidance when the resolved corpus URL is still the
|
||||||
|
#' placeholder shipped with the package (or any URL containing the sentinel).
|
||||||
|
#' Called from `cog_open()` before any I/O so users see a clear message
|
||||||
|
#' instead of a downstream JSON parse error.
|
||||||
|
#' @noRd
|
||||||
|
.check_url_configured <- function(url) {
|
||||||
|
if (!is.character(url) || length(url) != 1L || !nzchar(url)) {
|
||||||
|
cli::cli_abort(c(
|
||||||
|
"USCOGDATA_URL is not configured.",
|
||||||
|
i = "Set the corpus location via one of:",
|
||||||
|
"*" = "{.code Sys.setenv(USCOGDATA_URL = \"<url-or-local-path>/\")}",
|
||||||
|
"*" = "{.code options(uscogdata.url = \"<url-or-local-path>/\")}",
|
||||||
|
i = "For an offline smoke test, use the bundled fixture: {.code system.file(\"extdata/fixture_corpus\", package = \"uscogdata\")}."
|
||||||
|
), class = "uscogdata_url_not_configured")
|
||||||
|
}
|
||||||
|
if (grepl(.PLACEHOLDER_TOKEN, url, fixed = TRUE)) {
|
||||||
|
sentinel <- .PLACEHOLDER_TOKEN
|
||||||
|
cli::cli_abort(c(
|
||||||
|
"USCOGDATA_URL is not configured (placeholder URL detected).",
|
||||||
|
x = "Current value contains the sentinel {.val {sentinel}}: {.url {url}}",
|
||||||
|
i = "Set the corpus location via one of:",
|
||||||
|
"*" = "{.code Sys.setenv(USCOGDATA_URL = \"<url-or-local-path>/\")}",
|
||||||
|
"*" = "{.code options(uscogdata.url = \"<url-or-local-path>/\")}",
|
||||||
|
i = "For an offline smoke test, use the bundled fixture: {.code system.file(\"extdata/fixture_corpus\", package = \"uscogdata\")}.",
|
||||||
|
i = "For the live Civilytics corpus, request the Nextcloud share URL from the package maintainer."
|
||||||
|
), class = "uscogdata_url_not_configured")
|
||||||
|
}
|
||||||
|
invisible(url)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' Try to parse a JSON file. Returns parsed object on success, NULL on
|
||||||
|
#' any parse failure (so callers can decide whether to refetch).
|
||||||
|
#' @noRd
|
||||||
|
.try_parse_manifest_file <- function(path) {
|
||||||
|
tryCatch(
|
||||||
|
jsonlite::fromJSON(path, simplifyVector = FALSE),
|
||||||
|
error = function(e) NULL
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' Abort with a clear, classified error when a manifest payload (string or
|
||||||
|
#' file) cannot be parsed as JSON. Surfaces the URL, content-type if known,
|
||||||
|
#' and the underlying parse error.
|
||||||
|
#' @noRd
|
||||||
|
.abort_invalid_manifest <- function(source, content_type = NA_character_, parse_error = NULL) {
|
||||||
|
ct <- if (is.na(content_type) || !nzchar(content_type)) "<unknown>" else content_type
|
||||||
|
pmsg <- if (is.null(parse_error)) "" else conditionMessage(parse_error)
|
||||||
|
cli::cli_abort(c(
|
||||||
|
"Corpus manifest is not valid JSON.",
|
||||||
|
x = "Source: {source}",
|
||||||
|
i = "Content-Type: {ct}",
|
||||||
|
i = "Likely causes: USCOGDATA_URL points at a login page, a 404 HTML page, or the wrong share; or the corpus has not been published yet.",
|
||||||
|
i = "Set USCOGDATA_URL to a directory (local path or HTTPS) that serves manifest.json directly.",
|
||||||
|
if (nzchar(pmsg)) c(">" = "Parse error: {pmsg}") else NULL
|
||||||
|
), class = "uscogdata_invalid_manifest")
|
||||||
|
}
|
||||||
|
|
||||||
#' Fetch manifest.json from URL (or read from a local fixture path),
|
#' Fetch manifest.json from URL (or read from a local fixture path),
|
||||||
#' cache locally, validate TTL.
|
#' cache locally, validate TTL.
|
||||||
#' @noRd
|
#' @noRd
|
||||||
@@ -11,23 +72,54 @@
|
|||||||
if (!file.exists(local_manifest)) {
|
if (!file.exists(local_manifest)) {
|
||||||
cli::cli_abort("Local fixture has no manifest.json at {local_manifest}")
|
cli::cli_abort("Local fixture has no manifest.json at {local_manifest}")
|
||||||
}
|
}
|
||||||
return(jsonlite::fromJSON(local_manifest, simplifyVector = FALSE))
|
return(tryCatch(
|
||||||
|
jsonlite::fromJSON(local_manifest, simplifyVector = FALSE),
|
||||||
|
error = function(e) .abort_invalid_manifest(source = local_manifest, parse_error = e)
|
||||||
|
))
|
||||||
}
|
}
|
||||||
|
|
||||||
cache_path <- file.path(cache_dir, "manifest.json")
|
cache_path <- file.path(cache_dir, "manifest.json")
|
||||||
ttl <- as.integer(.cfg("manifest_ttl_secs"))
|
ttl <- as.integer(.cfg("manifest_ttl_secs"))
|
||||||
|
|
||||||
needs_fetch <- !file.exists(cache_path) ||
|
cache_fresh <- file.exists(cache_path) &&
|
||||||
difftime(Sys.time(), file.info(cache_path)$mtime, units = "secs") > ttl
|
difftime(Sys.time(), file.info(cache_path)$mtime, units = "secs") <= ttl
|
||||||
|
|
||||||
|
# Honor a fresh cache only if its contents still parse as JSON. A previous
|
||||||
|
# version of this package could write HTML directly into the cache; treat
|
||||||
|
# such poisoned caches as if they were missing so the next call recovers.
|
||||||
|
if (cache_fresh) {
|
||||||
|
parsed <- .try_parse_manifest_file(cache_path)
|
||||||
|
if (!is.null(parsed)) return(parsed)
|
||||||
|
}
|
||||||
|
|
||||||
if (needs_fetch) {
|
|
||||||
resp <- httr2::request(paste0(url, "manifest.json")) |>
|
resp <- httr2::request(paste0(url, "manifest.json")) |>
|
||||||
httr2::req_error(is_error = function(r) httr2::resp_status(r) >= 400) |>
|
httr2::req_error(is_error = function(r) httr2::resp_status(r) >= 400) |>
|
||||||
httr2::req_perform()
|
httr2::req_perform()
|
||||||
writeLines(httr2::resp_body_string(resp), cache_path)
|
body <- httr2::resp_body_string(resp)
|
||||||
}
|
|
||||||
|
|
||||||
jsonlite::fromJSON(cache_path, simplifyVector = FALSE)
|
# Parse BEFORE persisting. If the server returned HTML / a login page /
|
||||||
|
# any non-JSON body with a 2xx status, we must not write it to the cache.
|
||||||
|
parsed <- tryCatch(
|
||||||
|
jsonlite::fromJSON(body, simplifyVector = FALSE),
|
||||||
|
error = function(e) {
|
||||||
|
ct <- tryCatch(httr2::resp_content_type(resp), error = function(e2) NA_character_)
|
||||||
|
.abort_invalid_manifest(
|
||||||
|
source = paste0(url, "manifest.json"),
|
||||||
|
content_type = ct,
|
||||||
|
parse_error = e
|
||||||
|
)
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
|
# Atomic write: tmp file alongside cache_path (same filesystem -> no EXDEV)
|
||||||
|
# then rename. Ensures a partial write or interrupted process never
|
||||||
|
# replaces a previously-good cache.
|
||||||
|
if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE)
|
||||||
|
tmp <- paste0(cache_path, ".tmp.", Sys.getpid())
|
||||||
|
on.exit(if (file.exists(tmp)) unlink(tmp), add = TRUE)
|
||||||
|
writeLines(body, tmp)
|
||||||
|
file.rename(tmp, cache_path)
|
||||||
|
parsed
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @noRd
|
#' @noRd
|
||||||
@@ -54,3 +146,18 @@
|
|||||||
}
|
}
|
||||||
|
|
||||||
`%||%` <- function(a, b) if (is.null(a) || (length(a) == 1 && is.na(a))) b else a
|
`%||%` <- function(a, b) if (is.null(a) || (length(a) == 1 && is.na(a))) b else a
|
||||||
|
|
||||||
|
#' Return the parsed corpus manifest for the active session.
|
||||||
|
#'
|
||||||
|
#' Opens a session (connecting to the configured corpus) if none is active,
|
||||||
|
#' then returns the manifest exactly as parsed from `manifest.json`. Useful
|
||||||
|
#' for consumers that need the published year range (`years` block, schema
|
||||||
|
#' v5+) or the partition list without issuing a data query.
|
||||||
|
#'
|
||||||
|
#' @return Named list: `schema_version`, `built_at`, `pipeline_commit`,
|
||||||
|
#' `data_vintage`, `scope`, `years` (schema v5+), `schema`, `files`.
|
||||||
|
#' @export
|
||||||
|
cog_manifest <- function() {
|
||||||
|
.ensure_session()
|
||||||
|
.uscogdata_env$manifest
|
||||||
|
}
|
||||||
|
|||||||
@@ -2,31 +2,33 @@
|
|||||||
|
|
||||||
#' Find peer governments by similarity criteria
|
#' Find peer governments by similarity criteria
|
||||||
#'
|
#'
|
||||||
#' Selects peer governments from `canonical_fips_xwalk` by combinations of
|
#' Selects peer governments by combinations of government type, state, and
|
||||||
#' government type, state, and population range. Peers are ordered by
|
#' population range at a chosen `year`. Peers are ordered by `|log(pop_ratio)|`
|
||||||
#' `|log(pop_ratio)|` ascending (closest to the target's population first).
|
#' ascending (closest to the target's population first).
|
||||||
#'
|
#'
|
||||||
#' @param target_govid Character scalar — `canonical_govid` of the target.
|
#' @param target_govid Character scalar — `canonical_govid` of the target.
|
||||||
|
#' @param year Integer scalar. Cohort vintage. When `NULL` (default), uses the
|
||||||
|
#' most recent year for which the target has an observed population in
|
||||||
|
#' `gov_population_yearly`.
|
||||||
#' @param same_type If `TRUE` (default) restrict peers to the target's
|
#' @param same_type If `TRUE` (default) restrict peers to the target's
|
||||||
#' `govs_type`.
|
#' `govs_type`.
|
||||||
#' @param same_state If `TRUE` restrict peers to the target's `fips_state`.
|
#' @param same_state If `TRUE` restrict peers to the target's `fips_state`.
|
||||||
#' Default `FALSE`.
|
#' Default `FALSE`.
|
||||||
#' @param pop_range Length-2 numeric vector giving lower/upper bounds.
|
#' @param pop_range Length-2 numeric vector giving lower/upper bounds.
|
||||||
#' @param is_ratio If `TRUE` (default) `pop_range` is multiplied by the
|
#' @param is_ratio If `TRUE` (default) `pop_range` is multiplied by the
|
||||||
#' target's `population_acs` to produce absolute bounds. If `FALSE`,
|
#' target's population at `year` to produce absolute bounds. If `FALSE`,
|
||||||
#' `pop_range` is interpreted as absolute population counts.
|
#' `pop_range` is interpreted as absolute population counts.
|
||||||
#' @param pop_year Reserved for future use (selecting ACS vintage). Currently
|
|
||||||
#' the corpus has a single snapshot so this argument has no effect.
|
|
||||||
#' @param max_peers Integer cap on the number of peers returned.
|
#' @param max_peers Integer cap on the number of peers returned.
|
||||||
#' @return Tibble with columns `canonical_govid`, `gov_name`, `fips_state`,
|
#' @return Tibble with columns `canonical_govid`, `gov_name`, `fips_state`,
|
||||||
#' `population_acs`, `pop_ratio`, `rank`.
|
#' `population`, `pop_ratio`, `rank`. The cohort year is attached as
|
||||||
|
#' `attr(x, "cohort_year")`.
|
||||||
#' @export
|
#' @export
|
||||||
cog_find_peers <- function(target_govid,
|
cog_find_peers <- function(target_govid,
|
||||||
|
year = NULL,
|
||||||
same_type = TRUE,
|
same_type = TRUE,
|
||||||
same_state = FALSE,
|
same_state = FALSE,
|
||||||
pop_range = c(0.7, 1.3),
|
pop_range = c(0.7, 1.3),
|
||||||
is_ratio = TRUE,
|
is_ratio = TRUE,
|
||||||
pop_year = NULL,
|
|
||||||
max_peers = 10L) {
|
max_peers = 10L) {
|
||||||
if (!is.character(target_govid) || length(target_govid) != 1L) {
|
if (!is.character(target_govid) || length(target_govid) != 1L) {
|
||||||
cli::cli_abort("`target_govid` must be a length-1 character string.")
|
cli::cli_abort("`target_govid` must be a length-1 character string.")
|
||||||
@@ -35,58 +37,96 @@ cog_find_peers <- function(target_govid,
|
|||||||
pop_range[1] >= pop_range[2]) {
|
pop_range[1] >= pop_range[2]) {
|
||||||
cli::cli_abort("`pop_range` must be a length-2 numeric with lo < hi.")
|
cli::cli_abort("`pop_range` must be a length-2 numeric with lo < hi.")
|
||||||
}
|
}
|
||||||
|
if (!is.null(year) &&
|
||||||
|
(!(is.numeric(year) || is.integer(year)) || length(year) != 1L)) {
|
||||||
|
cli::cli_abort("`year` must be NULL or a length-1 integer.")
|
||||||
|
}
|
||||||
|
|
||||||
con <- .ensure_session()
|
con <- .ensure_session()
|
||||||
|
|
||||||
target_sql <- sprintf(
|
# Confirm target exists in the xwalk and pull govs_type / fips_state.
|
||||||
"SELECT canonical_govid, gov_name, govs_type, fips_state, population_acs
|
meta_sql <- sprintf(
|
||||||
|
"SELECT canonical_govid, gov_name, govs_type, fips_state
|
||||||
FROM canonical_fips_xwalk
|
FROM canonical_fips_xwalk
|
||||||
WHERE canonical_govid = %s",
|
WHERE canonical_govid = %s",
|
||||||
.sql_lit_chr(target_govid)
|
.sql_lit_chr(target_govid)
|
||||||
)
|
)
|
||||||
target <- DBI::dbGetQuery(con, target_sql)
|
meta <- DBI::dbGetQuery(con, meta_sql)
|
||||||
if (nrow(target) == 0L) {
|
if (nrow(meta) == 0L) {
|
||||||
cli::cli_abort(c(
|
cli::cli_abort(c(
|
||||||
"govid {target_govid} not found in corpus.",
|
"govid {target_govid} not found in corpus.",
|
||||||
i = "v0.1 covers types 0-3 only (state/county/city/township); see vignette('coverage-scope')."
|
i = "v0.1 covers types 0-3 only (state/county/city/township); see vignette('coverage-scope')."
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
if (is.na(target$population_acs) || target$population_acs <= 0) {
|
|
||||||
cli::cli_abort("Target {target_govid} has missing or non-positive population; cannot build pop_ratio band.")
|
cohort_year <- .resolve_cohort_year(con, target_govid, year)
|
||||||
|
|
||||||
|
pop_sql <- sprintf(
|
||||||
|
"SELECT population FROM gov_population_yearly
|
||||||
|
WHERE canonical_govid = %s AND year = %d",
|
||||||
|
.sql_lit_chr(target_govid), as.integer(cohort_year)
|
||||||
|
)
|
||||||
|
target_pop <- DBI::dbGetQuery(con, pop_sql)$population
|
||||||
|
if (length(target_pop) == 0L || is.na(target_pop) || target_pop <= 0) {
|
||||||
|
cli::cli_abort(c(
|
||||||
|
"Target {target_govid} has no observed population in {cohort_year}.",
|
||||||
|
i = "Use a year for which population is observed; see gov_population_yearly."
|
||||||
|
))
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(is_ratio)) {
|
if (isTRUE(is_ratio)) {
|
||||||
lo <- target$population_acs * pop_range[1]
|
lo <- target_pop * pop_range[1]
|
||||||
hi <- target$population_acs * pop_range[2]
|
hi <- target_pop * pop_range[2]
|
||||||
} else {
|
} else {
|
||||||
lo <- pop_range[1]; hi <- pop_range[2]
|
lo <- pop_range[1]; hi <- pop_range[2]
|
||||||
}
|
}
|
||||||
|
|
||||||
preds <- c(
|
preds <- c(
|
||||||
sprintf("canonical_govid != %s", .sql_lit_chr(target_govid)),
|
sprintf("p.canonical_govid != %s", .sql_lit_chr(target_govid)),
|
||||||
sprintf("population_acs BETWEEN %.6f AND %.6f", lo, hi)
|
sprintf("p.year = %d", as.integer(cohort_year)),
|
||||||
|
sprintf("p.population BETWEEN %.6f AND %.6f", lo, hi)
|
||||||
)
|
)
|
||||||
if (isTRUE(same_type)) preds <- c(preds, sprintf("govs_type = %d", target$govs_type))
|
if (isTRUE(same_type)) preds <- c(preds, sprintf("x.govs_type = %d", meta$govs_type))
|
||||||
if (isTRUE(same_state)) preds <- c(preds, sprintf("fips_state = %s", .sql_lit_chr(target$fips_state)))
|
if (isTRUE(same_state)) preds <- c(preds, sprintf("x.fips_state = %s", .sql_lit_chr(meta$fips_state)))
|
||||||
|
|
||||||
peers_sql <- sprintf(
|
peers_sql <- sprintf(
|
||||||
"SELECT canonical_govid, gov_name, fips_state, population_acs,
|
"SELECT p.canonical_govid, x.gov_name, x.fips_state, p.population,
|
||||||
population_acs / %.6f AS pop_ratio
|
p.population / %.6f AS pop_ratio
|
||||||
FROM canonical_fips_xwalk
|
FROM gov_population_yearly p
|
||||||
|
JOIN canonical_fips_xwalk x USING (canonical_govid)
|
||||||
WHERE %s
|
WHERE %s
|
||||||
ORDER BY ABS(LN(CAST(population_acs AS DOUBLE) / %.6f))
|
ORDER BY ABS(LN(CAST(p.population AS DOUBLE) / %.6f))
|
||||||
LIMIT %d",
|
LIMIT %d",
|
||||||
target$population_acs,
|
target_pop,
|
||||||
paste(preds, collapse = " AND "),
|
paste(preds, collapse = " AND "),
|
||||||
target$population_acs,
|
target_pop,
|
||||||
as.integer(max_peers)
|
as.integer(max_peers)
|
||||||
)
|
)
|
||||||
peers <- tibble::as_tibble(DBI::dbGetQuery(con, peers_sql))
|
peers <- tibble::as_tibble(DBI::dbGetQuery(con, peers_sql))
|
||||||
if (nrow(peers) > 0L) peers$rank <- seq_len(nrow(peers))
|
peers$rank <- if (nrow(peers) > 0L) seq_len(nrow(peers)) else integer(0)
|
||||||
else peers$rank <- integer(0)
|
attr(peers, "cohort_year") <- as.integer(cohort_year)
|
||||||
|
attr(peers, "pop_range") <- as.numeric(pop_range)
|
||||||
|
attr(peers, "is_ratio") <- isTRUE(is_ratio)
|
||||||
peers
|
peers
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#' @noRd
|
||||||
|
.resolve_cohort_year <- function(con, target_govid, year) {
|
||||||
|
if (!is.null(year)) return(as.integer(year))
|
||||||
|
sql <- sprintf(
|
||||||
|
"SELECT MAX(year) AS y FROM gov_population_yearly
|
||||||
|
WHERE canonical_govid = %s",
|
||||||
|
.sql_lit_chr(target_govid)
|
||||||
|
)
|
||||||
|
y <- DBI::dbGetQuery(con, sql)$y
|
||||||
|
if (length(y) == 0L || is.na(y)) {
|
||||||
|
cli::cli_abort(
|
||||||
|
"Target {target_govid} has no observed population in any year."
|
||||||
|
)
|
||||||
|
}
|
||||||
|
as.integer(y)
|
||||||
|
}
|
||||||
|
|
||||||
#' Compare a target government against a peer set
|
#' Compare a target government against a peer set
|
||||||
#'
|
#'
|
||||||
#' Pulls spending for the target plus a peer set (either a
|
#' Pulls spending for the target plus a peer set (either a
|
||||||
@@ -105,9 +145,12 @@ cog_find_peers <- function(target_govid,
|
|||||||
#' @param adjust_to_year Integer base year for CPI-U conversion or `NULL`.
|
#' @param adjust_to_year Integer base year for CPI-U conversion or `NULL`.
|
||||||
#' @return Tibble matching [cog_spending()]'s columns, plus a `role`
|
#' @return Tibble matching [cog_spending()]'s columns, plus a `role`
|
||||||
#' column taking values `"target"`, `"peer"`, `"summary_p25"`,
|
#' column taking values `"target"`, `"peer"`, `"summary_p25"`,
|
||||||
#' `"summary_p50"`, or `"summary_p75"`, and `target_rank` (target's rank
|
#' `"summary_p50"`, or `"summary_p75"`, `target_rank` (target's rank
|
||||||
#' among target+peers at `max(years)`, NA for other rows). Provenance
|
#' among target+peers at `max(years)`, NA for other rows), and
|
||||||
#' attribute reports `verb = "cog_peer_compare"` and `peer_count`.
|
#' `cohort_year` (the year used to build the peer cohort, read from
|
||||||
|
#' `attr(peers, "cohort_year")`; `NA` when `peers` was a bare character
|
||||||
|
#' vector). Provenance reports `verb = "cog_peer_compare"`, `peer_count`,
|
||||||
|
#' `cohort_year`, and `cohort_govids`.
|
||||||
#' @export
|
#' @export
|
||||||
cog_peer_compare <- function(target_govid, peers, category, years,
|
cog_peer_compare <- function(target_govid, peers, category, years,
|
||||||
per_capita = TRUE, adjust_to_year = NULL) {
|
per_capita = TRUE, adjust_to_year = NULL) {
|
||||||
@@ -115,6 +158,14 @@ cog_peer_compare <- function(target_govid, peers, category, years,
|
|||||||
if (!is.character(target_govid) || length(target_govid) != 1L) {
|
if (!is.character(target_govid) || length(target_govid) != 1L) {
|
||||||
cli::cli_abort("`target_govid` must be a length-1 character string.")
|
cli::cli_abort("`target_govid` must be a length-1 character string.")
|
||||||
}
|
}
|
||||||
|
cohort_year <- if (is.data.frame(peers)) {
|
||||||
|
ay <- attr(peers, "cohort_year")
|
||||||
|
if (is.null(ay)) NA_integer_ else as.integer(ay)
|
||||||
|
} else {
|
||||||
|
NA_integer_
|
||||||
|
}
|
||||||
|
pop_range <- if (is.data.frame(peers)) attr(peers, "pop_range") else NULL
|
||||||
|
is_ratio <- if (is.data.frame(peers)) attr(peers, "is_ratio") else NULL
|
||||||
peer_govids <- if (is.data.frame(peers)) {
|
peer_govids <- if (is.data.frame(peers)) {
|
||||||
as.character(peers$canonical_govid)
|
as.character(peers$canonical_govid)
|
||||||
} else {
|
} else {
|
||||||
@@ -132,11 +183,16 @@ cog_peer_compare <- function(target_govid, peers, category, years,
|
|||||||
out <- dplyr::bind_rows(r, summary_rows)
|
out <- dplyr::bind_rows(r, summary_rows)
|
||||||
rank_val <- .peer_target_rank(r, target_govid, years, value_col)
|
rank_val <- .peer_target_rank(r, target_govid, years, value_col)
|
||||||
out$target_rank <- ifelse(out$role == "target", rank_val, NA_integer_)
|
out$target_rank <- ifelse(out$role == "target", rank_val, NA_integer_)
|
||||||
|
out$cohort_year <- cohort_year
|
||||||
|
|
||||||
prov <- attr(r, "provenance") %||% list()
|
prov <- attr(r, "provenance") %||% list()
|
||||||
prov$verb <- "cog_peer_compare"
|
prov$verb <- "cog_peer_compare"
|
||||||
prov$call <- paste(deparse(call), collapse = " ")
|
prov$call <- paste(deparse(call), collapse = " ")
|
||||||
prov$peer_count <- length(peer_govids)
|
prov$peer_count <- length(peer_govids)
|
||||||
|
prov$cohort_year <- cohort_year
|
||||||
|
prov$cohort_govids <- peer_govids
|
||||||
|
prov$pop_range <- pop_range
|
||||||
|
prov$is_ratio <- is_ratio
|
||||||
prov$target <- list(
|
prov$target <- list(
|
||||||
canonical_govid = target_govid,
|
canonical_govid = target_govid,
|
||||||
gov_name = unique(r$gov_name[r$role == "target"])
|
gov_name = unique(r$gov_name[r$role == "target"])
|
||||||
|
|||||||
+19
-1
@@ -61,9 +61,27 @@
|
|||||||
per_capita = list(
|
per_capita = list(
|
||||||
applied = isTRUE(per_capita),
|
applied = isTRUE(per_capita),
|
||||||
denominator_source = if (isTRUE(per_capita)) {
|
denominator_source = if (isTRUE(per_capita)) {
|
||||||
"ACS 2018-2022 B01003_001 (population_acs from canonical_fips_xwalk)"
|
"Census F-33 population (per-year, from long.population)"
|
||||||
} else {
|
} else {
|
||||||
NA_character_
|
NA_character_
|
||||||
|
},
|
||||||
|
popyear_range = if (isTRUE(per_capita)) {
|
||||||
|
attr(result, ".popyear_range") %||% integer(0)
|
||||||
|
} else {
|
||||||
|
integer(0)
|
||||||
|
},
|
||||||
|
pop_source_counts = if (isTRUE(per_capita)) {
|
||||||
|
ps <- result[["pop_source"]]
|
||||||
|
if (is.null(ps) || length(ps) == 0L) {
|
||||||
|
list(census_f33 = 0L, unavailable = 0L)
|
||||||
|
} else {
|
||||||
|
list(
|
||||||
|
census_f33 = sum(ps == "census_f33", na.rm = TRUE),
|
||||||
|
unavailable = sum(ps == "unavailable", na.rm = TRUE)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
NULL
|
||||||
}
|
}
|
||||||
),
|
),
|
||||||
inflation = list(
|
inflation = list(
|
||||||
|
|||||||
+1
-1
@@ -11,7 +11,7 @@
|
|||||||
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||||
#' `revenue_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
#' `revenue_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
||||||
#' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
#' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
||||||
#' `codes_included`, `aggregate_fallback`, `notes`.
|
#' optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
|
||||||
#' @export
|
#' @export
|
||||||
cog_revenue <- function(govid, years, category = NULL,
|
cog_revenue <- function(govid, years, category = NULL,
|
||||||
per_capita = FALSE, adjust_to_year = NULL) {
|
per_capita = FALSE, adjust_to_year = NULL) {
|
||||||
|
|||||||
+27
-7
@@ -8,28 +8,35 @@
|
|||||||
#' "place portraits" that compare a city to the surrounding county and
|
#' "place portraits" that compare a city to the surrounding county and
|
||||||
#' containing state on one set of axes.
|
#' containing state on one set of axes.
|
||||||
#'
|
#'
|
||||||
|
#' When `per_capita = TRUE`, rows whose government has no observed
|
||||||
|
#' population in that year (`pop_source == "unavailable"`) are dropped from
|
||||||
|
#' the result. The dropped govids are recorded in
|
||||||
|
#' `provenance$rollup$excluded_govids`. This excludes special districts
|
||||||
|
#' (gov type 4) and school districts (gov type 5) from per-capita rollups
|
||||||
|
#' by design — see `vignette('population-denominators')`.
|
||||||
|
#'
|
||||||
#' @param govids Named list with any non-empty subset of elements named
|
#' @param govids Named list with any non-empty subset of elements named
|
||||||
#' `state`, `county`, `city`. Each element is a character vector of
|
#' `state`, `county`, `city`. Each element is a character vector of
|
||||||
#' `canonical_govid` values. At least one layer required.
|
#' `canonical_govid` values. At least one layer required.
|
||||||
#' @param category Single category name or character vector (passed through
|
#' @param category Single category name or character vector (passed through
|
||||||
#' to [cog_spending()]).
|
#' to [cog_spending()]).
|
||||||
#' @param years Integer vector of years.
|
#' @param years Integer vector of years.
|
||||||
#' @param per_capita If `TRUE`, per-capita uses each layer's own population
|
#' @param per_capita If `TRUE`, per-capita uses each gov's own per-year
|
||||||
#' from `canonical_fips_xwalk.population_acs`.
|
#' population from `gov_population_yearly`. Govs with missing population
|
||||||
|
#' are excluded from the result.
|
||||||
#' @param adjust_to_year Integer base year for CPI-U conversion, or `NULL`.
|
#' @param adjust_to_year Integer base year for CPI-U conversion, or `NULL`.
|
||||||
#' @return Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
#' @return Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
||||||
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
||||||
#' `amt_per_capita_nominal` / `amt_per_capita_real`, `codes_included`,
|
#' `amt_per_capita_nominal` / `amt_per_capita_real`, optional `pop_source`,
|
||||||
#' `aggregate_fallback`, `scope_note`, `notes`. Carries a `provenance`
|
#' `codes_included`, `aggregate_fallback`, `scope_note`, `notes`. Carries a
|
||||||
#' attribute with `verb = "cog_geographic_rollup"` and `layers`.
|
#' `provenance` attribute with `verb = "cog_geographic_rollup"`, `layers`,
|
||||||
|
#' and `rollup$included_govids` / `rollup$excluded_govids`.
|
||||||
#' @export
|
#' @export
|
||||||
cog_geographic_rollup <- function(govids, category, years,
|
cog_geographic_rollup <- function(govids, category, years,
|
||||||
per_capita = FALSE, adjust_to_year = NULL) {
|
per_capita = FALSE, adjust_to_year = NULL) {
|
||||||
call <- match.call()
|
call <- match.call()
|
||||||
.validate_rollup_layers(govids)
|
.validate_rollup_layers(govids)
|
||||||
|
|
||||||
# Accept character vector OR a data.frame with canonical_govid per layer,
|
|
||||||
# so cog_gov_search() output can be piped into one of the layer slots.
|
|
||||||
govids <- lapply(govids, .coerce_govid_input, arg = "govids[[layer]]")
|
govids <- lapply(govids, .coerce_govid_input, arg = "govids[[layer]]")
|
||||||
if (any(lengths(govids) == 0L)) {
|
if (any(lengths(govids) == 0L)) {
|
||||||
cli::cli_abort("Each layer in `govids` must be non-empty after coercion.")
|
cli::cli_abort("Each layer in `govids` must be non-empty after coercion.")
|
||||||
@@ -45,12 +52,25 @@ cog_geographic_rollup <- function(govids, category, years,
|
|||||||
r <- dplyr::left_join(r, layer_map, by = "canonical_govid",
|
r <- dplyr::left_join(r, layer_map, by = "canonical_govid",
|
||||||
relationship = "many-to-many")
|
relationship = "many-to-many")
|
||||||
r$scope_note <- .rollup_scope_note(r$layer)
|
r$scope_note <- .rollup_scope_note(r$layer)
|
||||||
|
|
||||||
|
excluded <- character(0)
|
||||||
|
if (isTRUE(per_capita) && "pop_source" %in% names(r)) {
|
||||||
|
drop <- r$pop_source == "unavailable"
|
||||||
|
excluded <- unique(r$canonical_govid[drop])
|
||||||
|
r <- r[!drop, , drop = FALSE]
|
||||||
|
}
|
||||||
|
included <- unique(r$canonical_govid)
|
||||||
|
|
||||||
r <- .reorder_rollup_cols(r)
|
r <- .reorder_rollup_cols(r)
|
||||||
|
|
||||||
prov <- attr(r, "provenance")
|
prov <- attr(r, "provenance")
|
||||||
prov$verb <- "cog_geographic_rollup"
|
prov$verb <- "cog_geographic_rollup"
|
||||||
prov$call <- paste(deparse(call), collapse = " ")
|
prov$call <- paste(deparse(call), collapse = " ")
|
||||||
prov$layers <- layer_names
|
prov$layers <- layer_names
|
||||||
|
prov$rollup <- list(
|
||||||
|
included_govids = included,
|
||||||
|
excluded_govids = excluded
|
||||||
|
)
|
||||||
attr(r, "provenance") <- prov
|
attr(r, "provenance") <- prov
|
||||||
|
|
||||||
r
|
r
|
||||||
|
|||||||
+4
-3
@@ -126,9 +126,10 @@ cog_gov_search <- function(name = NULL, state = NULL, type = NULL) {
|
|||||||
canonical_govid = character(0), gov_name = character(0),
|
canonical_govid = character(0), gov_name = character(0),
|
||||||
govs_type = integer(0), type_label = character(0),
|
govs_type = integer(0), type_label = character(0),
|
||||||
fips_state = character(0), fips_county = character(0),
|
fips_state = character(0), fips_county = character(0),
|
||||||
fips_place = character(0), first_year = integer(0),
|
fips_place = character(0), legacy_govs_id = character(0),
|
||||||
last_year = integer(0), population_acs = integer(0),
|
first_year = integer(0), last_year = integer(0),
|
||||||
confidence = character(0)
|
census_geoid = character(0), population_acs = integer(0),
|
||||||
|
pop_confidence = character(0), id_source = character(0)
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
+2
-1
@@ -5,13 +5,14 @@
|
|||||||
#' @noRd
|
#' @noRd
|
||||||
cog_open <- function(url = .resolve_url(),
|
cog_open <- function(url = .resolve_url(),
|
||||||
cache_dir = .resolve_cache_dir()) {
|
cache_dir = .resolve_cache_dir()) {
|
||||||
|
.check_url_configured(url)
|
||||||
if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE)
|
if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE)
|
||||||
|
|
||||||
con <- DBI::dbConnect(duckdb::duckdb())
|
con <- DBI::dbConnect(duckdb::duckdb())
|
||||||
DBI::dbExecute(con, "INSTALL httpfs; LOAD httpfs;")
|
DBI::dbExecute(con, "INSTALL httpfs; LOAD httpfs;")
|
||||||
|
|
||||||
manifest <- .fetch_or_cache_manifest(url, cache_dir)
|
manifest <- .fetch_or_cache_manifest(url, cache_dir)
|
||||||
.validate_schema(manifest, expected_version = 3L)
|
.validate_schema(manifest, expected_version = 4L)
|
||||||
.validate_scope(manifest)
|
.validate_scope(manifest)
|
||||||
|
|
||||||
.register_views(con, url, manifest)
|
.register_views(con, url, manifest)
|
||||||
|
|||||||
+54
-16
@@ -13,15 +13,18 @@
|
|||||||
#' @param category Character vector of category names (from
|
#' @param category Character vector of category names (from
|
||||||
#' `summary_categories.category`), or `NULL` for all categories.
|
#' `summary_categories.category`), or `NULL` for all categories.
|
||||||
#' @param per_capita If `TRUE`, adds `amt_per_capita_nominal` (and
|
#' @param per_capita If `TRUE`, adds `amt_per_capita_nominal` (and
|
||||||
#' `amt_per_capita_real` when `adjust_to_year` is set) using
|
#' `amt_per_capita_real` when `adjust_to_year` is set) using the per-year
|
||||||
#' `population_acs` from the canonical xwalk.
|
#' Census F-33 population from `gov_population_yearly`. Result also gains
|
||||||
|
#' a `pop_source` column with values `"census_f33"` or `"unavailable"`
|
||||||
|
#' (the latter for gov types 4/5 and any row whose population is missing
|
||||||
|
#' in that year).
|
||||||
#' @param adjust_to_year Integer base year for CPI-U real-dollar conversion,
|
#' @param adjust_to_year Integer base year for CPI-U real-dollar conversion,
|
||||||
#' or `NULL` for nominal only.
|
#' or `NULL` for nominal only.
|
||||||
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
#' @return Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||||
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
||||||
#' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
#' optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
||||||
#' `codes_included`, `aggregate_fallback`, `notes`. Carries a `provenance`
|
#' optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
|
||||||
#' attribute matching `inst/schemas/provenance-v1.json`.
|
#' Carries a `provenance` attribute matching `inst/schemas/provenance-v1.json`.
|
||||||
#' @export
|
#' @export
|
||||||
cog_spending <- function(govid, years, category = NULL,
|
cog_spending <- function(govid, years, category = NULL,
|
||||||
per_capita = FALSE, adjust_to_year = NULL) {
|
per_capita = FALSE, adjust_to_year = NULL) {
|
||||||
@@ -76,6 +79,7 @@ cog_spending <- function(govid, years, category = NULL,
|
|||||||
prov$scope$govids_found <- scope$found
|
prov$scope$govids_found <- scope$found
|
||||||
prov$scope$govids_missing <- scope$missing
|
prov$scope$govids_missing <- scope$missing
|
||||||
attr(result, "provenance") <- prov
|
attr(result, "provenance") <- prov
|
||||||
|
attr(result, ".popyear_range") <- NULL
|
||||||
result
|
result
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -143,18 +147,32 @@ cog_spending <- function(govid, years, category = NULL,
|
|||||||
.attach_per_capita <- function(result, con, govid) {
|
.attach_per_capita <- function(result, con, govid) {
|
||||||
if (nrow(result) == 0L) {
|
if (nrow(result) == 0L) {
|
||||||
result$amt_per_capita_nominal <- numeric(0)
|
result$amt_per_capita_nominal <- numeric(0)
|
||||||
|
result$pop_source <- character(0)
|
||||||
|
attr(result, ".popyear_range") <- integer(0)
|
||||||
return(result)
|
return(result)
|
||||||
}
|
}
|
||||||
|
years_lit <- paste(unique(as.integer(result$year)), collapse = ",")
|
||||||
sql <- sprintf(
|
sql <- sprintf(
|
||||||
"SELECT canonical_govid, population_acs
|
"SELECT canonical_govid, year, population, popyear
|
||||||
FROM canonical_fips_xwalk
|
FROM gov_population_yearly
|
||||||
WHERE canonical_govid IN (%s)",
|
WHERE canonical_govid IN (%s)
|
||||||
.sql_lit_chr(govid)
|
AND year IN (%s)",
|
||||||
|
.sql_lit_chr(govid), years_lit
|
||||||
)
|
)
|
||||||
pops <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
pops <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
||||||
result <- dplyr::left_join(result, pops, by = "canonical_govid")
|
result <- dplyr::left_join(result, pops,
|
||||||
result$amt_per_capita_nominal <- result$amt_nominal / result$population_acs
|
by = c("canonical_govid", "year"))
|
||||||
result$population_acs <- NULL
|
result$amt_per_capita_nominal <- result$amt_nominal / result$population
|
||||||
|
result$pop_source <- ifelse(is.na(result$population),
|
||||||
|
"unavailable", "census_f33")
|
||||||
|
py <- result$popyear[!is.na(result$popyear)]
|
||||||
|
attr(result, ".popyear_range") <- if (length(py) > 0L) {
|
||||||
|
as.integer(c(min(py), max(py)))
|
||||||
|
} else {
|
||||||
|
integer(0)
|
||||||
|
}
|
||||||
|
result$population <- NULL
|
||||||
|
result$popyear <- NULL
|
||||||
result
|
result
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -176,10 +194,30 @@ cog_spending <- function(govid, years, category = NULL,
|
|||||||
|
|
||||||
#' @noRd
|
#' @noRd
|
||||||
.notes_column <- function(result) {
|
.notes_column <- function(result) {
|
||||||
if (nrow(result) == 0L) return(character(0))
|
n <- nrow(result)
|
||||||
ifelse(
|
if (n == 0L) return(character(0))
|
||||||
isTRUE(result$aggregate_fallback) | result$aggregate_fallback %in% TRUE,
|
parts <- vector("list", 2L)
|
||||||
|
agg <- result[["aggregate_fallback"]]
|
||||||
|
parts[[1]] <- if (!is.null(agg)) {
|
||||||
|
ifelse(agg %in% TRUE,
|
||||||
"Aggregate fallback applied; see cog_explain()",
|
"Aggregate fallback applied; see cog_explain()",
|
||||||
""
|
NA_character_)
|
||||||
)
|
} else {
|
||||||
|
rep(NA_character_, n)
|
||||||
|
}
|
||||||
|
ps <- result[["pop_source"]]
|
||||||
|
parts[[2]] <- if (!is.null(ps)) {
|
||||||
|
ifelse(ps == "unavailable",
|
||||||
|
"No population denominator available for this gov type",
|
||||||
|
NA_character_)
|
||||||
|
} else {
|
||||||
|
rep(NA_character_, n)
|
||||||
|
}
|
||||||
|
out <- character(n)
|
||||||
|
for (i in seq_len(n)) {
|
||||||
|
pieces <- vapply(parts, `[[`, character(1), i)
|
||||||
|
pieces <- pieces[!is.na(pieces)]
|
||||||
|
out[i] <- if (length(pieces) == 0L) "" else paste(pieces, collapse = "; ")
|
||||||
|
}
|
||||||
|
out
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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,
|
"schema_version": 4,
|
||||||
"built_at": "2026-04-27T16:43:46Z",
|
"built_at": "2026-07-13T23:35:09Z",
|
||||||
"pipeline_commit": "899af37",
|
"pipeline_commit": "a082b26",
|
||||||
"fixture_note": "Two-year (2019-2020) fixture for uscogdata tests. Full corpus available via USCOGDATA_URL.",
|
"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": {
|
"data_vintage": {
|
||||||
"census_source_downloaded": "unknown",
|
"census_source_downloaded": "unknown",
|
||||||
"cpi_vintage": "FRED CPIAUCSL",
|
"cpi_vintage": "FRED CPIAUCSL",
|
||||||
"acs_vintage": "ACS 2018-2022 5-year"
|
"acs_vintage": "ACS 2018-2022 5-year"
|
||||||
},
|
},
|
||||||
"scope": {
|
"scope": {
|
||||||
"gov_types_included": [
|
"gov_types_included": [0, 1, 2, 3],
|
||||||
0,
|
"gov_types_excluded": [4, 5],
|
||||||
1,
|
|
||||||
2,
|
|
||||||
3
|
|
||||||
],
|
|
||||||
"gov_types_excluded": [
|
|
||||||
4,
|
|
||||||
5
|
|
||||||
],
|
|
||||||
"scope_note": "v0.1 covers state, county, city/municipality, and township governments. Special districts (type 4) and school districts (type 5) are excluded pending validation in a future cycle."
|
"scope_note": "v0.1 covers state, county, city/municipality, and township governments. Special districts (type 4) and school districts (type 5) are excluded pending validation in a future cycle."
|
||||||
},
|
},
|
||||||
"schema": {
|
"schema": {
|
||||||
"long_column_count": 24,
|
"long_column_count": 24,
|
||||||
"long_columns": [
|
"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"],
|
||||||
"fips_state",
|
|
||||||
"type",
|
|
||||||
"fips_county",
|
|
||||||
"govid",
|
|
||||||
"gov_blank",
|
|
||||||
"gov_name",
|
|
||||||
"county_name",
|
|
||||||
"fips_state_code",
|
|
||||||
"fips_county_code",
|
|
||||||
"fips_place_code",
|
|
||||||
"population",
|
|
||||||
"popyear",
|
|
||||||
"enrollment",
|
|
||||||
"enrollyear",
|
|
||||||
"function_code",
|
|
||||||
"sch_level_code",
|
|
||||||
"fiscal_year_end",
|
|
||||||
"srvy_year",
|
|
||||||
"item_code",
|
|
||||||
"amt",
|
|
||||||
"srv_data",
|
|
||||||
"impute_flag",
|
|
||||||
"is_aggregate",
|
|
||||||
"canonical_govid"
|
|
||||||
],
|
|
||||||
"data_dictionary": "docs/data_dictionary.md"
|
"data_dictionary": "docs/data_dictionary.md"
|
||||||
},
|
},
|
||||||
"files": {
|
"files": {
|
||||||
@@ -56,27 +23,32 @@
|
|||||||
{
|
{
|
||||||
"year": 2019,
|
"year": 2019,
|
||||||
"path": "data/long/year=2019/part-0.parquet",
|
"path": "data/long/year=2019/part-0.parquet",
|
||||||
"sha256": "e1c9f426c6d7d3c51d06b3a652473b987b304836619c213f019cee4887714daa",
|
"sha256": "c0a2bf0758af129d5dfddb6ff6665cc435ddee87fd6879e788fb56ed53ab22b8",
|
||||||
"row_count": 318139,
|
"row_count": 318139,
|
||||||
"size_bytes": 1424231
|
"size_bytes": 1441404
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"year": 2020,
|
"year": 2020,
|
||||||
"path": "data/long/year=2020/part-0.parquet",
|
"path": "data/long/year=2020/part-0.parquet",
|
||||||
"sha256": "9b795853a848e8c955c80261b96b79630fc77394dcfb1a1ca288e2cd634053a3",
|
"sha256": "92570b9d55ec3425d034db37838f91c3b8359d0454d3d98730a6016b62e4bb48",
|
||||||
"row_count": 317500,
|
"row_count": 317500,
|
||||||
"size_bytes": 1427150
|
"size_bytes": 1444011
|
||||||
}
|
}
|
||||||
],
|
],
|
||||||
"metadata": [
|
"metadata": [
|
||||||
|
{
|
||||||
|
"path": "data/canonical_alias.parquet",
|
||||||
|
"sha256": "feb8d01a640fb16c9a4b4ad66726b50b8fe8a1ce2a771bed8c1190fec51d5c8d",
|
||||||
|
"description": "canonical_alias.parquet"
|
||||||
|
},
|
||||||
{
|
{
|
||||||
"path": "data/canonical_fips_xwalk.parquet",
|
"path": "data/canonical_fips_xwalk.parquet",
|
||||||
"sha256": "86e53e04a35f6f90bb74bb1a273e053392afa782d6f518e3e3da9c976d47f7af",
|
"sha256": "1ae47981531c7389f69eff3f7656045428564bfbe8032200eb9c039d32739a7e",
|
||||||
"description": "canonical_fips_xwalk.parquet"
|
"description": "canonical_fips_xwalk.parquet"
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"path": "data/summary_categories.parquet",
|
"path": "data/summary_categories.parquet",
|
||||||
"sha256": "60045e22bc2723318fa2cb73f8e5038250dc54d24b3447c6750dfe29035335b8",
|
"sha256": "dd59e7f58a022679ad43511c8c8e938b8dd4be81196bbeeee21e67bdcca2295b",
|
||||||
"description": "summary_categories.parquet"
|
"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{
|
\usage{
|
||||||
cog_find_peers(
|
cog_find_peers(
|
||||||
target_govid,
|
target_govid,
|
||||||
|
year = NULL,
|
||||||
same_type = TRUE,
|
same_type = TRUE,
|
||||||
same_state = FALSE,
|
same_state = FALSE,
|
||||||
pop_range = c(0.7, 1.3),
|
pop_range = c(0.7, 1.3),
|
||||||
is_ratio = TRUE,
|
is_ratio = TRUE,
|
||||||
pop_year = NULL,
|
|
||||||
max_peers = 10L
|
max_peers = 10L
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
\item{target_govid}{Character scalar — `canonical_govid` of the target.}
|
\item{target_govid}{Character scalar — `canonical_govid` of the target.}
|
||||||
|
|
||||||
|
\item{year}{Integer scalar. Cohort vintage. When `NULL` (default), uses the
|
||||||
|
most recent year for which the target has an observed population in
|
||||||
|
`gov_population_yearly`.}
|
||||||
|
|
||||||
\item{same_type}{If `TRUE` (default) restrict peers to the target's
|
\item{same_type}{If `TRUE` (default) restrict peers to the target's
|
||||||
`govs_type`.}
|
`govs_type`.}
|
||||||
|
|
||||||
@@ -26,20 +30,18 @@ Default `FALSE`.}
|
|||||||
\item{pop_range}{Length-2 numeric vector giving lower/upper bounds.}
|
\item{pop_range}{Length-2 numeric vector giving lower/upper bounds.}
|
||||||
|
|
||||||
\item{is_ratio}{If `TRUE` (default) `pop_range` is multiplied by the
|
\item{is_ratio}{If `TRUE` (default) `pop_range` is multiplied by the
|
||||||
target's `population_acs` to produce absolute bounds. If `FALSE`,
|
target's population at `year` to produce absolute bounds. If `FALSE`,
|
||||||
`pop_range` is interpreted as absolute population counts.}
|
`pop_range` is interpreted as absolute population counts.}
|
||||||
|
|
||||||
\item{pop_year}{Reserved for future use (selecting ACS vintage). Currently
|
|
||||||
the corpus has a single snapshot so this argument has no effect.}
|
|
||||||
|
|
||||||
\item{max_peers}{Integer cap on the number of peers returned.}
|
\item{max_peers}{Integer cap on the number of peers returned.}
|
||||||
}
|
}
|
||||||
\value{
|
\value{
|
||||||
Tibble with columns `canonical_govid`, `gov_name`, `fips_state`,
|
Tibble with columns `canonical_govid`, `gov_name`, `fips_state`,
|
||||||
`population_acs`, `pop_ratio`, `rank`.
|
`population`, `pop_ratio`, `rank`. The cohort year is attached as
|
||||||
|
`attr(x, "cohort_year")`.
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Selects peer governments from `canonical_fips_xwalk` by combinations of
|
Selects peer governments by combinations of government type, state, and
|
||||||
government type, state, and population range. Peers are ordered by
|
population range at a chosen `year`. Peers are ordered by `|log(pop_ratio)|`
|
||||||
`|log(pop_ratio)|` ascending (closest to the target's population first).
|
ascending (closest to the target's population first).
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -22,17 +22,19 @@ to [cog_spending()]).}
|
|||||||
|
|
||||||
\item{years}{Integer vector of years.}
|
\item{years}{Integer vector of years.}
|
||||||
|
|
||||||
\item{per_capita}{If `TRUE`, per-capita uses each layer's own population
|
\item{per_capita}{If `TRUE`, per-capita uses each gov's own per-year
|
||||||
from `canonical_fips_xwalk.population_acs`.}
|
population from `gov_population_yearly`. Govs with missing population
|
||||||
|
are excluded from the result.}
|
||||||
|
|
||||||
\item{adjust_to_year}{Integer base year for CPI-U conversion, or `NULL`.}
|
\item{adjust_to_year}{Integer base year for CPI-U conversion, or `NULL`.}
|
||||||
}
|
}
|
||||||
\value{
|
\value{
|
||||||
Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
||||||
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
||||||
`amt_per_capita_nominal` / `amt_per_capita_real`, `codes_included`,
|
`amt_per_capita_nominal` / `amt_per_capita_real`, optional `pop_source`,
|
||||||
`aggregate_fallback`, `scope_note`, `notes`. Carries a `provenance`
|
`codes_included`, `aggregate_fallback`, `scope_note`, `notes`. Carries a
|
||||||
attribute with `verb = "cog_geographic_rollup"` and `layers`.
|
`provenance` attribute with `verb = "cog_geographic_rollup"`, `layers`,
|
||||||
|
and `rollup$included_govids` / `rollup$excluded_govids`.
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Wraps [cog_spending()], tags each row with its layer, and attaches a
|
Wraps [cog_spending()], tags each row with its layer, and attaches a
|
||||||
@@ -41,3 +43,11 @@ human-readable `scope_note` documenting geographic-scope caveats (e.g.
|
|||||||
"place portraits" that compare a city to the surrounding county and
|
"place portraits" that compare a city to the surrounding county and
|
||||||
containing state on one set of axes.
|
containing state on one set of axes.
|
||||||
}
|
}
|
||||||
|
\details{
|
||||||
|
When `per_capita = TRUE`, rows whose government has no observed
|
||||||
|
population in that year (`pop_source == "unavailable"`) are dropped from
|
||||||
|
the result. The dropped govids are recorded in
|
||||||
|
`provenance$rollup$excluded_govids`. This excludes special districts
|
||||||
|
(gov type 4) and school districts (gov type 5) from per-capita rollups
|
||||||
|
by design — see `vignette('population-denominators')`.
|
||||||
|
}
|
||||||
|
|||||||
@@ -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{
|
\value{
|
||||||
Tibble matching [cog_spending()]'s columns, plus a `role`
|
Tibble matching [cog_spending()]'s columns, plus a `role`
|
||||||
column taking values `"target"`, `"peer"`, `"summary_p25"`,
|
column taking values `"target"`, `"peer"`, `"summary_p25"`,
|
||||||
`"summary_p50"`, or `"summary_p75"`, and `target_rank` (target's rank
|
`"summary_p50"`, or `"summary_p75"`, `target_rank` (target's rank
|
||||||
among target+peers at `max(years)`, NA for other rows). Provenance
|
among target+peers at `max(years)`, NA for other rows), and
|
||||||
attribute reports `verb = "cog_peer_compare"` and `peer_count`.
|
`cohort_year` (the year used to build the peer cohort, read from
|
||||||
|
`attr(peers, "cohort_year")`; `NA` when `peers` was a bare character
|
||||||
|
vector). Provenance reports `verb = "cog_peer_compare"`, `peer_count`,
|
||||||
|
`cohort_year`, and `cohort_govids`.
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Pulls spending for the target plus a peer set (either a
|
Pulls spending for the target plus a peer set (either a
|
||||||
|
|||||||
+6
-3
@@ -21,8 +21,11 @@ cog_revenue(
|
|||||||
`summary_categories.category`), or `NULL` for all categories.}
|
`summary_categories.category`), or `NULL` for all categories.}
|
||||||
|
|
||||||
\item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and
|
\item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and
|
||||||
`amt_per_capita_real` when `adjust_to_year` is set) using
|
`amt_per_capita_real` when `adjust_to_year` is set) using the per-year
|
||||||
`population_acs` from the canonical xwalk.}
|
Census F-33 population from `gov_population_yearly`. Result also gains
|
||||||
|
a `pop_source` column with values `"census_f33"` or `"unavailable"`
|
||||||
|
(the latter for gov types 4/5 and any row whose population is missing
|
||||||
|
in that year).}
|
||||||
|
|
||||||
\item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion,
|
\item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion,
|
||||||
or `NULL` for nominal only.}
|
or `NULL` for nominal only.}
|
||||||
@@ -31,7 +34,7 @@ or `NULL` for nominal only.}
|
|||||||
Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||||
`revenue_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
`revenue_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
||||||
optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
||||||
`codes_included`, `aggregate_fallback`, `notes`.
|
optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Mirror of [cog_spending()] for revenue categories. One row per
|
Mirror of [cog_spending()] for revenue categories. One row per
|
||||||
|
|||||||
+7
-4
@@ -21,8 +21,11 @@ cog_spending(
|
|||||||
`summary_categories.category`), or `NULL` for all categories.}
|
`summary_categories.category`), or `NULL` for all categories.}
|
||||||
|
|
||||||
\item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and
|
\item{per_capita}{If `TRUE`, adds `amt_per_capita_nominal` (and
|
||||||
`amt_per_capita_real` when `adjust_to_year` is set) using
|
`amt_per_capita_real` when `adjust_to_year` is set) using the per-year
|
||||||
`population_acs` from the canonical xwalk.}
|
Census F-33 population from `gov_population_yearly`. Result also gains
|
||||||
|
a `pop_source` column with values `"census_f33"` or `"unavailable"`
|
||||||
|
(the latter for gov types 4/5 and any row whose population is missing
|
||||||
|
in that year).}
|
||||||
|
|
||||||
\item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion,
|
\item{adjust_to_year}{Integer base year for CPI-U real-dollar conversion,
|
||||||
or `NULL` for nominal only.}
|
or `NULL` for nominal only.}
|
||||||
@@ -31,8 +34,8 @@ or `NULL` for nominal only.}
|
|||||||
Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
Tibble with columns `year`, `canonical_govid`, `gov_name`,
|
||||||
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real`,
|
||||||
optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
optional `amt_per_capita_nominal`, optional `amt_per_capita_real`,
|
||||||
`codes_included`, `aggregate_fallback`, `notes`. Carries a `provenance`
|
optional `pop_source`, `codes_included`, `aggregate_fallback`, `notes`.
|
||||||
attribute matching `inst/schemas/provenance-v1.json`.
|
Carries a `provenance` attribute matching `inst/schemas/provenance-v1.json`.
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
One row per `(year, canonical_govid, spend_subtype, category)`. Amounts are
|
One row per `(year, canonical_govid, spend_subtype, category)`. Amounts are
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,285 @@
|
|||||||
|
# Per-year population denominators in uscogdata
|
||||||
|
|
||||||
|
**Date:** 2026-04-29
|
||||||
|
**Status:** Design — pending implementation
|
||||||
|
**Scope:** uscogdata 0.1 (pre-release; no version bump)
|
||||||
|
**Related:** cog_pipeline (data dictionary updates)
|
||||||
|
|
||||||
|
## Problem
|
||||||
|
|
||||||
|
`uscogdata::cog_spending(per_capita = TRUE)` and `cog_revenue(per_capita = TRUE)`
|
||||||
|
currently divide every year's nominal amount by a single static population value
|
||||||
|
— `canonical_fips_xwalk.population_acs`, the ACS 2018-2022 5-year estimate.
|
||||||
|
|
||||||
|
For a 24-year corpus (2000–2023) this introduces a systematic bias proportional
|
||||||
|
to each government's population change over that span. Fast-growing places have
|
||||||
|
their early-year per-capita numbers understated; shrinking places have theirs
|
||||||
|
overstated. The bias commonly exceeds 20% and can exceed 50% for cities like
|
||||||
|
Detroit. Provenance currently advertises this denominator explicitly, so the
|
||||||
|
error is visible to careful users — but the default behavior produces wrong
|
||||||
|
numbers.
|
||||||
|
|
||||||
|
`cog_geographic_rollup()` has the same bug. `cog_find_peers()` /
|
||||||
|
`cog_peer_compare()` use the same static value to define peer cohorts, which
|
||||||
|
is defensible for matching but is no longer necessary now that per-year
|
||||||
|
population is available.
|
||||||
|
|
||||||
|
## Background — population sources
|
||||||
|
|
||||||
|
| Source | What it is | Where it lives |
|
||||||
|
|---|---|---|
|
||||||
|
| **Census F-33 `population`** | Population value Census uses on each COG row to compute its own per-capita tables. Almost always a Population Estimates Program (PEP) estimate; sometimes lagged a year for fiscal-year alignment, recorded in `popyear` | `long.population`, `long.popyear` (per row) |
|
||||||
|
| **PEP** (raw) | Census Bureau's official annual intercensal estimates. Distinct from F-33 because F-33 sometimes uses a lagged vintage | Not in corpus; available via tidycensus |
|
||||||
|
| **ACS 5-year** | American Community Survey 5-year rolling average. Different methodology, includes margin of error, only available 2005-2009 onward | `canonical_fips_xwalk.population_acs` (one fixed vintage) |
|
||||||
|
| **Decennial** | Actual count, every 10 years | Not in corpus |
|
||||||
|
|
||||||
|
F-33 `population` is the right default: it's what Census itself uses, so per-
|
||||||
|
capita results published by uscogdata reconcile with Census's own published
|
||||||
|
tables.
|
||||||
|
|
||||||
|
## Approach
|
||||||
|
|
||||||
|
Use the per-row `population` already present in `long`, joined on
|
||||||
|
`(canonical_govid, year)`. No new external data dependency. Coverage:
|
||||||
|
|
||||||
|
- **Types 0–3** (state, county, city, township): observed every year by design
|
||||||
|
- **Types 4–5** (special districts, schools): always NA — masked in
|
||||||
|
`cog_pipeline/R/read_modern.R` because the F-33 schema does not carry a
|
||||||
|
population value for these gov types
|
||||||
|
|
||||||
|
Type-4 and type-5 govs return `NA` per-capita with a `pop_source = "unavailable"`
|
||||||
|
flag and a note. No silent substitution.
|
||||||
|
|
||||||
|
The architecture leaves the door open for future denominators (PEP, ACS,
|
||||||
|
decennial) by surfacing `pop_source` as a first-class result column. Adding a
|
||||||
|
new source later is a join change, not an API change.
|
||||||
|
|
||||||
|
## Detailed design
|
||||||
|
|
||||||
|
### New view: `gov_population_yearly`
|
||||||
|
|
||||||
|
```sql
|
||||||
|
-- inst/sql/32-gov_population_yearly.sql
|
||||||
|
CREATE OR REPLACE VIEW gov_population_yearly AS
|
||||||
|
SELECT DISTINCT
|
||||||
|
year,
|
||||||
|
canonical_govid,
|
||||||
|
population,
|
||||||
|
popyear
|
||||||
|
FROM long
|
||||||
|
WHERE population IS NOT NULL;
|
||||||
|
```
|
||||||
|
|
||||||
|
`SELECT DISTINCT` collapses the metadata column duplicated across each gov-year's
|
||||||
|
item rows. A test asserts `(year, canonical_govid)` is unique to catch any
|
||||||
|
future source-data divergence.
|
||||||
|
|
||||||
|
### `cog_spending()` and `cog_revenue()`
|
||||||
|
|
||||||
|
`.attach_per_capita()` (in `R/spending.R`) is rewritten to:
|
||||||
|
|
||||||
|
1. Query `gov_population_yearly` for the requested govids and years.
|
||||||
|
2. `LEFT JOIN` on `(canonical_govid, year)` so missing rows produce NA.
|
||||||
|
3. Compute `amt_per_capita_nominal = amt_nominal / population`. NA when
|
||||||
|
population is NA.
|
||||||
|
4. Drop `population` from the returned tibble (keep `pop_source` instead).
|
||||||
|
|
||||||
|
Result tibble gains one new column when `per_capita = TRUE`:
|
||||||
|
|
||||||
|
- `pop_source`: `"census_f33"` when a denominator was found, `"unavailable"`
|
||||||
|
when NA.
|
||||||
|
|
||||||
|
`notes` is extended: when `pop_source == "unavailable"`, append
|
||||||
|
`"No population denominator available for this gov type"`. The `notes` column
|
||||||
|
is updated to concatenate multiple notes with `"; "` (it currently holds at
|
||||||
|
most one).
|
||||||
|
|
||||||
|
`amt_per_capita_real` is NA whenever `amt_per_capita_nominal` is NA.
|
||||||
|
|
||||||
|
### `cog_geographic_rollup()`
|
||||||
|
|
||||||
|
The current implementation does **not** sum amounts within a layer — it returns
|
||||||
|
one row per `(year, canonical_govid, subtype, category)` tagged with its
|
||||||
|
layer, intended for side-by-side "place portrait" comparisons (a city, the
|
||||||
|
county containing it, the state containing both). That semantics is preserved.
|
||||||
|
|
||||||
|
The only behavior change in this work is per-row exclusion when `per_capita = TRUE`:
|
||||||
|
|
||||||
|
1. After `cog_spending()` returns with the per-row per-year denominator from
|
||||||
|
Task 3, drop rows where `pop_source == "unavailable"` so the result never
|
||||||
|
contains NA per-capita rows.
|
||||||
|
2. Record the dropped `canonical_govid`s in `provenance$rollup$excluded_govids`
|
||||||
|
and the kept ones in `provenance$rollup$included_govids`.
|
||||||
|
|
||||||
|
Documentation states explicitly: *Per-capita rollups include only governments
|
||||||
|
observed in both the finance and population panels for the given year. Special
|
||||||
|
districts and school districts (gov types 4 and 5) are therefore excluded from
|
||||||
|
per-capita rollups by design.*
|
||||||
|
|
||||||
|
Provenance gains:
|
||||||
|
|
||||||
|
- `rollup.included_govids` — `canonical_govid`s present in the result
|
||||||
|
- `rollup.excluded_govids` — `canonical_govid`s dropped for missing pop
|
||||||
|
|
||||||
|
### `cog_find_peers()`
|
||||||
|
|
||||||
|
Signature: `cog_find_peers(target_govid, year = NULL, pop_range = c(0.5, 2), ...)`
|
||||||
|
|
||||||
|
- `year` is a single integer. When `NULL`, defaults to the most recent year
|
||||||
|
present in `gov_population_yearly` for the target.
|
||||||
|
- Looks up target's `population` at `year`. Errors if NA, with a message
|
||||||
|
listing nearby years where target *is* observed.
|
||||||
|
- Filters candidates by `gov_population_yearly.population` at the same `year`,
|
||||||
|
within `pop_range[1] * target_pop` and `pop_range[2] * target_pop`.
|
||||||
|
- Orders by `|log(pop_ratio)|` ascending.
|
||||||
|
|
||||||
|
Returned columns: `canonical_govid`, `gov_name`, `govs_type`, `fips_state`,
|
||||||
|
`population`, `pop_ratio`, `rank`. The column previously named `population_acs`
|
||||||
|
is renamed to `population`.
|
||||||
|
|
||||||
|
The cohort year is attached as a tibble attribute: `attr(x, "cohort_year")`.
|
||||||
|
|
||||||
|
### `cog_peer_compare()`
|
||||||
|
|
||||||
|
Existing signature unchanged:
|
||||||
|
`cog_peer_compare(target_govid, peers, category, years, per_capita = TRUE, adjust_to_year = NULL)`.
|
||||||
|
The caller supplies `peers` (either a `cog_find_peers()` result tibble or a
|
||||||
|
character vector of `canonical_govid`). The cohort year is implicit in
|
||||||
|
whichever year the caller used to call `cog_find_peers()`.
|
||||||
|
|
||||||
|
Behavior changes:
|
||||||
|
|
||||||
|
- When `peers` is a tibble carrying `attr(peers, "cohort_year")`,
|
||||||
|
`cog_peer_compare()` reads it and stamps every result row with a constant
|
||||||
|
`cohort_year` column.
|
||||||
|
- When `peers` is a bare character vector, `cohort_year` in the result is `NA`.
|
||||||
|
- Provenance gets `cohort_year` (scalar or NA) and the cohort govids list.
|
||||||
|
|
||||||
|
Users who want time-varying cohorts call `cog_find_peers()` per year and
|
||||||
|
stitch the `cog_peer_compare()` results themselves — documented in the
|
||||||
|
vignette with a worked example.
|
||||||
|
|
||||||
|
### Provenance updates
|
||||||
|
|
||||||
|
`provenance$transformations$per_capita` becomes:
|
||||||
|
|
||||||
|
```r
|
||||||
|
list(
|
||||||
|
applied = TRUE,
|
||||||
|
denominator_source = "Census F-33 population (per-year, from long.population)",
|
||||||
|
popyear_range = c(<min>, <max>),
|
||||||
|
pop_source_counts = list(census_f33 = N1, unavailable = N2)
|
||||||
|
)
|
||||||
|
```
|
||||||
|
|
||||||
|
For peer compare results, additional provenance:
|
||||||
|
|
||||||
|
```r
|
||||||
|
list(
|
||||||
|
cohort_year = <int>,
|
||||||
|
cohort_govids = <character>,
|
||||||
|
pop_range = c(<lo>, <hi>)
|
||||||
|
)
|
||||||
|
```
|
||||||
|
|
||||||
|
For rollup results, additional provenance:
|
||||||
|
|
||||||
|
```r
|
||||||
|
list(
|
||||||
|
rollup = list(
|
||||||
|
included_govids = <character>,
|
||||||
|
excluded_govids = <character>
|
||||||
|
)
|
||||||
|
)
|
||||||
|
```
|
||||||
|
|
||||||
|
`R/explain.R` is updated to render the new fields.
|
||||||
|
|
||||||
|
### Documentation
|
||||||
|
|
||||||
|
**New vignette** `vignettes/population-denominators.Rmd`:
|
||||||
|
|
||||||
|
1. The four population sources explained
|
||||||
|
2. Why F-33 is the default — and how it reconciles with Census's own per-capita
|
||||||
|
tables
|
||||||
|
3. The `popyear` quirk: Census sometimes uses a lagged estimate for fiscal-year
|
||||||
|
alignment. Recorded in provenance, not in the result.
|
||||||
|
4. Worked example showing the bias from the old static-ACS approach versus
|
||||||
|
per-year F-33 (e.g., Detroit 2003 vs. 2023)
|
||||||
|
5. Worked example of a rolling-cohort peer comparison built by looping
|
||||||
|
`cog_peer_compare()` per year
|
||||||
|
6. Future direction: `pop_source` is structured so PEP, ACS time-series, or
|
||||||
|
decennial denominators can be added later without API changes
|
||||||
|
|
||||||
|
**`cog_pipeline/docs/data_dictionary.md`** entry for `long.population` and
|
||||||
|
`long.popyear`: definition, source (F-33 fixed-width files, byte ranges),
|
||||||
|
type-4/5 masking rule, relationship to PEP.
|
||||||
|
|
||||||
|
### Tests
|
||||||
|
|
||||||
|
- `gov_population_yearly` returns one row per `(year, canonical_govid)` (uniqueness)
|
||||||
|
- `cog_spending(per_capita = TRUE)` returns different denominators for
|
||||||
|
different years for a known gov in the fixture (use any gov whose population
|
||||||
|
changes between 2019 and 2020)
|
||||||
|
- Type-4 and type-5 govids in the fixture return `pop_source = "unavailable"`
|
||||||
|
and `NA` per-capita with the expected note
|
||||||
|
- `cog_geographic_rollup(per_capita = TRUE)` excludes missing-pop govs and
|
||||||
|
records them in provenance
|
||||||
|
- `cog_find_peers()` defaults `year` to the most recent year for a target
|
||||||
|
with known population history
|
||||||
|
- `cog_find_peers()` errors with a helpful message when target has no observed
|
||||||
|
population in the requested year
|
||||||
|
- `cog_peer_compare()` defaults `cohort_year` and produces a result with a
|
||||||
|
constant `cohort_year` column
|
||||||
|
- Provenance carries `denominator_source`, `popyear_range`, and
|
||||||
|
`pop_source_counts`
|
||||||
|
- Regression test against a fixed govid+year showing the new per-capita value
|
||||||
|
differs from the old (static-ACS) by exactly the ratio of `population_acs`
|
||||||
|
to `long.population` for that gov-year
|
||||||
|
|
||||||
|
### Migration
|
||||||
|
|
||||||
|
Pre-release; no version bump. `NEWS.md` Unreleased entry:
|
||||||
|
|
||||||
|
> **Per-capita denominators now use per-year Census F-33 population.**
|
||||||
|
> Previously, `cog_spending()` and `cog_revenue()` divided all years' amounts
|
||||||
|
> by a single ACS 2018-2022 population, producing biased per-capita values
|
||||||
|
> for time-series. They now divide by the F-33 `population` recorded for each
|
||||||
|
> gov-year. Type-4 (special districts) and type-5 (school districts) govs
|
||||||
|
> return `NA` per-capita with `pop_source = "unavailable"`.
|
||||||
|
>
|
||||||
|
> **Peer matching now uses per-year population.** `cog_find_peers()` gains a
|
||||||
|
> `year` argument (defaults to most recent observed year). `cog_peer_compare()`
|
||||||
|
> gains `cohort_year`. Cohorts are still fixed for a single peer-compare call;
|
||||||
|
> users wanting moving cohorts loop themselves.
|
||||||
|
>
|
||||||
|
> **Rollups exclude govs with missing population.** `cog_geographic_rollup()`
|
||||||
|
> per-capita totals include only govs where both the finance variable and
|
||||||
|
> population are observed in that year; excluded govids are recorded in
|
||||||
|
> provenance.
|
||||||
|
>
|
||||||
|
> Returned column `population_acs` from `cog_find_peers()` is renamed to
|
||||||
|
> `population` and reflects the cohort-year vintage.
|
||||||
|
|
||||||
|
### File impact
|
||||||
|
|
||||||
|
| File | Change |
|
||||||
|
|---|---|
|
||||||
|
| `inst/sql/32-gov_population_yearly.sql` | New |
|
||||||
|
| `R/spending.R` (`.attach_per_capita`, `.notes_column`) | Per-year join, `pop_source`, multi-note concat |
|
||||||
|
| `R/peers.R` (`cog_find_peers`, `cog_peer_compare`) | `year` / `cohort_year` args, query new view, column rename |
|
||||||
|
| `R/rollup.R` | Skip-with-record for missing-pop govs |
|
||||||
|
| `R/provenance.R` | New denominator/cohort/rollup fields |
|
||||||
|
| `R/explain.R` | Render new fields |
|
||||||
|
| `vignettes/population-denominators.Rmd` | New |
|
||||||
|
| `tests/testthat/` | Per-year denominator, type-4/5, rollup exclusion, peer cohort, provenance |
|
||||||
|
| `cog_pipeline/docs/data_dictionary.md` | Document `long.population`, `long.popyear`, masking |
|
||||||
|
| `NEWS.md` | Unreleased entry |
|
||||||
|
|
||||||
|
## Out of scope
|
||||||
|
|
||||||
|
- PEP/ACS/decennial denominators — architected for, not implemented
|
||||||
|
- `per_pupil` denominator using `long.enrollment` for type-5 — deferred
|
||||||
|
- Covering-county fallback for type-4 — deliberately not done
|
||||||
|
- Backfilling population for type-4/5 from any external source
|
||||||
|
- Changes to `cog_explorer` callers — separate follow-up, after this lands
|
||||||
@@ -41,3 +41,10 @@ test_that(".inflate preserves NA amounts", {
|
|||||||
expect_true(is.na(result[2]))
|
expect_true(is.na(result[2]))
|
||||||
expect_false(any(is.na(result[c(1, 3)])))
|
expect_false(any(is.na(result[c(1, 3)])))
|
||||||
})
|
})
|
||||||
|
|
||||||
|
test_that("bundled CPI covers the full 1967+ corpus era through this year", {
|
||||||
|
cpi <- .cpi_table()
|
||||||
|
expect_lte(min(cpi$year), 1967L)
|
||||||
|
expect_gte(max(cpi$year), as.integer(format(Sys.Date(), "%Y")))
|
||||||
|
expect_false(any(is.na(cpi$cpi)))
|
||||||
|
})
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
test_that("cog_explain prints verb header and target", {
|
test_that("cog_explain prints verb header and target", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||||
# cli writes to stderr; capture both stdout and message streams.
|
# cli writes to stderr; capture both stdout and message streams.
|
||||||
txt <- paste(c(
|
txt <- paste(c(
|
||||||
capture.output(cog_explain(r)),
|
capture.output(cog_explain(r)),
|
||||||
@@ -8,19 +8,19 @@ test_that("cog_explain prints verb header and target", {
|
|||||||
), collapse = "\n")
|
), collapse = "\n")
|
||||||
expect_true(grepl("cog_spending", txt))
|
expect_true(grepl("cog_spending", txt))
|
||||||
expect_true(grepl("Corrections", txt))
|
expect_true(grepl("Corrections", txt))
|
||||||
expect_true(grepl("101006006", txt))
|
expect_true(grepl("121011212191", txt))
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_explain format='list' returns structured provenance", {
|
test_that("cog_explain format='list' returns structured provenance", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||||
prov <- cog_explain(r, format = "list")
|
prov <- cog_explain(r, format = "list")
|
||||||
expect_identical(prov, attr(r, "provenance"))
|
expect_identical(prov, attr(r, "provenance"))
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_explain returns result invisibly for chaining", {
|
test_that("cog_explain returns result invisibly for chaining", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||||
res <- withVisible(cog_explain(r))
|
res <- withVisible(cog_explain(r))
|
||||||
expect_false(res$visible)
|
expect_false(res$visible)
|
||||||
expect_identical(res$value, r)
|
expect_identical(res$value, r)
|
||||||
@@ -30,3 +30,21 @@ test_that("cog_explain errors on non-verb input", {
|
|||||||
df <- tibble::tibble(a = 1)
|
df <- tibble::tibble(a = 1)
|
||||||
expect_error(cog_explain(df), "provenance")
|
expect_error(cog_explain(df), "provenance")
|
||||||
})
|
})
|
||||||
|
|
||||||
|
test_that("cog_explain prints 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()
|
cog_close()
|
||||||
options(uscogdata.url = paste0(normalizePath(tmp), "/"))
|
options(uscogdata.url = paste0(normalizePath(tmp), "/"))
|
||||||
|
|
||||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||||
expect_gt(nrow(r), 0L)
|
expect_gt(nrow(r), 0L)
|
||||||
expect_equal(unique(r$canonical_govid), "101006006")
|
expect_equal(unique(r$canonical_govid), "121011212191")
|
||||||
})
|
})
|
||||||
|
|||||||
+64
-16
@@ -1,29 +1,29 @@
|
|||||||
test_that("cog_find_peers returns same-type peers in the default pop band", {
|
test_that("cog_find_peers returns same-type peers in the default pop band", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
peers <- cog_find_peers("101006006") # Broward County
|
peers <- cog_find_peers("121011212191") # Broward County
|
||||||
expect_s3_class(peers, "tbl_df")
|
expect_s3_class(peers, "tbl_df")
|
||||||
expected_cols <- c("canonical_govid", "gov_name", "fips_state",
|
expected_cols <- c("canonical_govid", "gov_name", "fips_state",
|
||||||
"population_acs", "pop_ratio", "rank")
|
"population", "pop_ratio", "rank")
|
||||||
expect_true(all(expected_cols %in% names(peers)))
|
expect_true(all(expected_cols %in% names(peers)))
|
||||||
expect_true(all(peers$pop_ratio >= 0.7 & peers$pop_ratio <= 1.3))
|
expect_true(all(peers$pop_ratio >= 0.7 & peers$pop_ratio <= 1.3))
|
||||||
expect_false("101006006" %in% peers$canonical_govid)
|
expect_false("121011212191" %in% peers$canonical_govid)
|
||||||
expect_equal(peers$rank, seq_len(nrow(peers)))
|
expect_equal(peers$rank, seq_len(nrow(peers)))
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_find_peers respects same_state restriction", {
|
test_that("cog_find_peers respects same_state restriction", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
peers <- cog_find_peers("101006006", same_state = TRUE,
|
peers <- cog_find_peers("121011212191", same_state = TRUE,
|
||||||
pop_range = c(0.1, 10))
|
pop_range = c(0.1, 10))
|
||||||
expect_true(all(peers$fips_state == "12"))
|
expect_true(all(peers$fips_state == "12"))
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_find_peers absolute pop range works", {
|
test_that("cog_find_peers absolute pop range works", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
peers <- cog_find_peers("101006006",
|
peers <- cog_find_peers("121011212191",
|
||||||
pop_range = c(1.5e6, 2.5e6),
|
pop_range = c(1.5e6, 2.5e6),
|
||||||
is_ratio = FALSE, max_peers = 20L)
|
is_ratio = FALSE, max_peers = 20L)
|
||||||
expect_true(all(peers$population_acs >= 1.5e6 &
|
expect_true(all(peers$population >= 1.5e6 &
|
||||||
peers$population_acs <= 2.5e6))
|
peers$population <= 2.5e6))
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_find_peers errors cleanly on unknown govid", {
|
test_that("cog_find_peers errors cleanly on unknown govid", {
|
||||||
@@ -33,8 +33,8 @@ test_that("cog_find_peers errors cleanly on unknown govid", {
|
|||||||
|
|
||||||
test_that("cog_peer_compare accepts a cog_find_peers result directly", {
|
test_that("cog_peer_compare accepts a cog_find_peers result directly", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
peers <- cog_find_peers("101006006", max_peers = 4L)
|
peers <- cog_find_peers("121011212191", max_peers = 4L)
|
||||||
r <- cog_peer_compare("101006006", peers, "Police", years = 2020L)
|
r <- cog_peer_compare("121011212191", peers, "Police", years = 2020L)
|
||||||
expect_s3_class(r, "tbl_df")
|
expect_s3_class(r, "tbl_df")
|
||||||
expect_true("role" %in% names(r))
|
expect_true("role" %in% names(r))
|
||||||
expect_setequal(
|
expect_setequal(
|
||||||
@@ -47,8 +47,8 @@ test_that("cog_peer_compare accepts a cog_find_peers result directly", {
|
|||||||
test_that("cog_peer_compare accepts a character vector of govids", {
|
test_that("cog_peer_compare accepts a character vector of govids", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_peer_compare(
|
r <- cog_peer_compare(
|
||||||
"101006006",
|
"121011212191",
|
||||||
peers = c("441015015", "441220220"), # Bexar, Tarrant
|
peers = c("481029175853", "481439135072"), # Bexar, Tarrant
|
||||||
category = "Police", years = 2020L
|
category = "Police", years = 2020L
|
||||||
)
|
)
|
||||||
expect_true("peer" %in% r$role)
|
expect_true("peer" %in% r$role)
|
||||||
@@ -58,8 +58,8 @@ test_that("cog_peer_compare accepts a character vector of govids", {
|
|||||||
test_that("cog_peer_compare summary rows use real per-capita when requested", {
|
test_that("cog_peer_compare summary rows use real per-capita when requested", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_peer_compare(
|
r <- cog_peer_compare(
|
||||||
"101006006",
|
"121011212191",
|
||||||
peers = c("441015015", "441220220", "231082082"),
|
peers = c("481029175853", "481439135072", "261163166615"),
|
||||||
category = "Police", years = 2019:2020,
|
category = "Police", years = 2019:2020,
|
||||||
per_capita = TRUE, adjust_to_year = 2022L
|
per_capita = TRUE, adjust_to_year = 2022L
|
||||||
)
|
)
|
||||||
@@ -72,8 +72,8 @@ test_that("cog_peer_compare summary rows use real per-capita when requested", {
|
|||||||
|
|
||||||
test_that("cog_peer_compare provenance reports the outer verb + peer count", {
|
test_that("cog_peer_compare provenance reports the outer verb + peer count", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_peer_compare("101006006",
|
r <- cog_peer_compare("121011212191",
|
||||||
peers = c("441015015", "441220220"),
|
peers = c("481029175853", "481439135072"),
|
||||||
category = "Police", years = 2020L)
|
category = "Police", years = 2020L)
|
||||||
prov <- attr(r, "provenance")
|
prov <- attr(r, "provenance")
|
||||||
expect_equal(prov$verb, "cog_peer_compare")
|
expect_equal(prov$verb, "cog_peer_compare")
|
||||||
@@ -82,9 +82,57 @@ test_that("cog_peer_compare provenance reports the outer verb + peer count", {
|
|||||||
|
|
||||||
test_that("cog_peer_compare handles zero peers gracefully", {
|
test_that("cog_peer_compare handles zero peers gracefully", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_peer_compare("101006006",
|
r <- cog_peer_compare("121011212191",
|
||||||
peers = character(0),
|
peers = character(0),
|
||||||
category = "Police", years = 2020L)
|
category = "Police", years = 2020L)
|
||||||
expect_true(all(r$role == "target"))
|
expect_true(all(r$role == "target"))
|
||||||
expect_equal(sum(grepl("^summary_", r$role)), 0L)
|
expect_equal(sum(grepl("^summary_", r$role)), 0L)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
test_that("cog_find_peers defaults `year` to most recent observed year for target", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
peers <- cog_find_peers("121011212191")
|
||||||
|
expect_equal(attr(peers, "cohort_year"), 2020L)
|
||||||
|
# Returned column is now `population`, not `population_acs`
|
||||||
|
expect_true("population" %in% names(peers))
|
||||||
|
expect_false("population_acs" %in% names(peers))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_find_peers honors an explicit `year`", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
peers <- cog_find_peers("121011212191", year = 2019L)
|
||||||
|
expect_equal(attr(peers, "cohort_year"), 2019L)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_find_peers errors when target has no observed pop in `year`", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
expect_error(
|
||||||
|
cog_find_peers("121011212191", year = 1999L),
|
||||||
|
"no observed population"
|
||||||
|
)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_peer_compare stamps cohort_year from peers attribute", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
peers <- cog_find_peers("121011212191", year = 2019L, max_peers = 4L,
|
||||||
|
pop_range = c(0.5, 1.5))
|
||||||
|
r <- cog_peer_compare("121011212191", peers, "Police", years = 2020L)
|
||||||
|
expect_true("cohort_year" %in% names(r))
|
||||||
|
expect_true(all(r$cohort_year == 2019L))
|
||||||
|
prov <- attr(r, "provenance")
|
||||||
|
expect_equal(prov$cohort_year, 2019L)
|
||||||
|
expect_equal(length(prov$cohort_govids), nrow(peers))
|
||||||
|
# pop_range and is_ratio propagate from cog_find_peers attrs
|
||||||
|
expect_equal(prov$pop_range, c(0.5, 1.5))
|
||||||
|
expect_true(prov$is_ratio)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_peer_compare cohort_year is NA for bare character peers", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_peer_compare(
|
||||||
|
"121011212191",
|
||||||
|
peers = c("481029175853", "481439135072"),
|
||||||
|
category = "Police", years = 2020L
|
||||||
|
)
|
||||||
|
expect_true(all(is.na(r$cohort_year)))
|
||||||
|
})
|
||||||
|
|||||||
@@ -1,24 +1,24 @@
|
|||||||
test_that("cog_revenue returns expected shape for Broward Property Tax 2020", {
|
test_that("cog_revenue returns expected shape for Broward Property Tax 2020", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_revenue("101006006", years = 2020L, category = "Property Tax")
|
r <- cog_revenue("121011212191", years = 2020L, category = "Property Tax")
|
||||||
expect_s3_class(r, "tbl_df")
|
expect_s3_class(r, "tbl_df")
|
||||||
expected_cols <- c("year", "canonical_govid", "gov_name", "revenue_subtype",
|
expected_cols <- c("year", "canonical_govid", "gov_name", "revenue_subtype",
|
||||||
"category", "amt_nominal", "codes_included",
|
"category", "amt_nominal", "codes_included",
|
||||||
"aggregate_fallback", "notes")
|
"aggregate_fallback", "notes")
|
||||||
expect_true(all(expected_cols %in% names(r)))
|
expect_true(all(expected_cols %in% names(r)))
|
||||||
expect_equal(unique(r$canonical_govid), "101006006")
|
expect_equal(unique(r$canonical_govid), "121011212191")
|
||||||
expect_equal(unique(r$year), 2020L)
|
expect_equal(unique(r$year), 2020L)
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_revenue with no category filter returns multiple categories", {
|
test_that("cog_revenue with no category filter returns multiple categories", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_revenue("101006006", years = 2020L)
|
r <- cog_revenue("121011212191", years = 2020L)
|
||||||
expect_gt(length(unique(r$category)), 1L)
|
expect_gt(length(unique(r$category)), 1L)
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_revenue with per_capita + adjust_to_year adds all columns", {
|
test_that("cog_revenue with per_capita + adjust_to_year adds all columns", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_revenue("101006006", 2020L,
|
r <- cog_revenue("121011212191", 2020L,
|
||||||
per_capita = TRUE, adjust_to_year = 2022L)
|
per_capita = TRUE, adjust_to_year = 2022L)
|
||||||
expect_true(all(c("amt_nominal", "amt_real",
|
expect_true(all(c("amt_nominal", "amt_real",
|
||||||
"amt_per_capita_nominal", "amt_per_capita_real") %in%
|
"amt_per_capita_nominal", "amt_per_capita_real") %in%
|
||||||
@@ -27,7 +27,7 @@ test_that("cog_revenue with per_capita + adjust_to_year adds all columns", {
|
|||||||
|
|
||||||
test_that("cog_revenue result has provenance attribute", {
|
test_that("cog_revenue result has provenance attribute", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_revenue("101006006", 2020L)
|
r <- cog_revenue("121011212191", 2020L)
|
||||||
prov <- attr(r, "provenance")
|
prov <- attr(r, "provenance")
|
||||||
expect_equal(prov$verb, "cog_revenue")
|
expect_equal(prov$verb, "cog_revenue")
|
||||||
expect_true(grepl("revenue_annotated", prov$sql_query))
|
expect_true(grepl("revenue_annotated", prov$sql_query))
|
||||||
|
|||||||
@@ -2,9 +2,9 @@ test_that("cog_geographic_rollup aggregates state + county + city layers", {
|
|||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_geographic_rollup(
|
r <- cog_geographic_rollup(
|
||||||
govids = list(
|
govids = list(
|
||||||
state = "100000000", # Florida state govt
|
state = "120000226351", # Florida state govt
|
||||||
county = "101006006", # Broward County
|
county = "121011212191", # Broward County
|
||||||
city = "102006004" # Fort Lauderdale City
|
city = "122011161585" # Fort Lauderdale City
|
||||||
),
|
),
|
||||||
category = "Police",
|
category = "Police",
|
||||||
years = 2019:2020
|
years = 2019:2020
|
||||||
@@ -23,7 +23,7 @@ test_that("cog_geographic_rollup aggregates state + county + city layers", {
|
|||||||
test_that("cog_geographic_rollup respects per_capita + adjust_to_year", {
|
test_that("cog_geographic_rollup respects per_capita + adjust_to_year", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_geographic_rollup(
|
r <- cog_geographic_rollup(
|
||||||
govids = list(county = "101006006", city = "102006004"),
|
govids = list(county = "121011212191", city = "122011161585"),
|
||||||
category = "Police",
|
category = "Police",
|
||||||
years = 2020L,
|
years = 2020L,
|
||||||
per_capita = TRUE,
|
per_capita = TRUE,
|
||||||
@@ -43,8 +43,8 @@ test_that("cog_geographic_rollup respects per_capita + adjust_to_year", {
|
|||||||
test_that("cog_geographic_rollup scope_notes describe each layer", {
|
test_that("cog_geographic_rollup scope_notes describe each layer", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_geographic_rollup(
|
r <- cog_geographic_rollup(
|
||||||
govids = list(state = "100000000", county = "101006006",
|
govids = list(state = "120000226351", county = "121011212191",
|
||||||
city = "102006004"),
|
city = "122011161585"),
|
||||||
category = "Police", years = 2020L
|
category = "Police", years = 2020L
|
||||||
)
|
)
|
||||||
state_notes <- unique(r$scope_note[r$layer == "state"])
|
state_notes <- unique(r$scope_note[r$layer == "state"])
|
||||||
@@ -58,7 +58,7 @@ test_that("cog_geographic_rollup scope_notes describe each layer", {
|
|||||||
test_that("cog_geographic_rollup single-layer call works", {
|
test_that("cog_geographic_rollup single-layer call works", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_geographic_rollup(
|
r <- cog_geographic_rollup(
|
||||||
govids = list(county = c("101006006")),
|
govids = list(county = c("121011212191")),
|
||||||
category = "Corrections",
|
category = "Corrections",
|
||||||
years = 2020L
|
years = 2020L
|
||||||
)
|
)
|
||||||
@@ -69,7 +69,7 @@ test_that("cog_geographic_rollup single-layer call works", {
|
|||||||
test_that("cog_geographic_rollup provenance reports the outer verb", {
|
test_that("cog_geographic_rollup provenance reports the outer verb", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_geographic_rollup(
|
r <- cog_geographic_rollup(
|
||||||
govids = list(state = "100000000", county = "101006006"),
|
govids = list(state = "120000226351", county = "121011212191"),
|
||||||
category = "Police", years = 2020L
|
category = "Police", years = 2020L
|
||||||
)
|
)
|
||||||
prov <- attr(r, "provenance")
|
prov <- attr(r, "provenance")
|
||||||
@@ -80,7 +80,7 @@ test_that("cog_geographic_rollup provenance reports the outer verb", {
|
|||||||
|
|
||||||
test_that("cog_geographic_rollup accepts data.frames per layer", {
|
test_that("cog_geographic_rollup accepts data.frames per layer", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
fl_state <- cog_gov_search("^FLORIDA STATE GOVT$", type = "state")
|
fl_state <- cog_gov_search("^FLORIDA$", type = "state")
|
||||||
broward <- cog_gov_search("^BROWARD COUNTY$", state = "FL", type = "county")
|
broward <- cog_gov_search("^BROWARD COUNTY$", state = "FL", type = "county")
|
||||||
r <- cog_geographic_rollup(
|
r <- cog_geographic_rollup(
|
||||||
govids = list(state = fl_state, county = broward),
|
govids = list(state = fl_state, county = broward),
|
||||||
@@ -92,9 +92,47 @@ test_that("cog_geographic_rollup accepts data.frames per layer", {
|
|||||||
|
|
||||||
test_that("cog_geographic_rollup rejects invalid inputs", {
|
test_that("cog_geographic_rollup rejects invalid inputs", {
|
||||||
expect_error(cog_geographic_rollup(list(), "Police", 2020L), "length")
|
expect_error(cog_geographic_rollup(list(), "Police", 2020L), "length")
|
||||||
expect_error(cog_geographic_rollup(c("101006006"), "Police", 2020L), "list")
|
expect_error(cog_geographic_rollup(c("121011212191"), "Police", 2020L), "list")
|
||||||
expect_error(
|
expect_error(
|
||||||
cog_geographic_rollup(list(planet = "100000000"), "Police", 2020L),
|
cog_geographic_rollup(list(planet = "120000226351"), "Police", 2020L),
|
||||||
"state|county|city"
|
"state|county|city"
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
test_that("cog_geographic_rollup per-capita uses summed per-year populations", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
with_fixture_corpus({
|
||||||
|
r <- cog_geographic_rollup(
|
||||||
|
govids = list(state = "010000226085",
|
||||||
|
county = "121011212191"),
|
||||||
|
category = "Police",
|
||||||
|
years = 2019:2020,
|
||||||
|
per_capita = TRUE
|
||||||
|
)
|
||||||
|
state_ops <- r[r$layer == "state" & r$spend_subtype == "operations", ]
|
||||||
|
county_ops <- r[r$layer == "county" & r$spend_subtype == "operations", ]
|
||||||
|
state_implied <- state_ops$amt_nominal / state_ops$amt_per_capita_nominal
|
||||||
|
county_implied <- county_ops$amt_nominal /
|
||||||
|
county_ops$amt_per_capita_nominal
|
||||||
|
# Per-year, per-layer denominator is the layer's own per-year population
|
||||||
|
expect_equal(state_implied[state_ops$year == 2019], 4874747, tolerance = 1)
|
||||||
|
expect_equal(state_implied[state_ops$year == 2020], 4903185, tolerance = 1)
|
||||||
|
expect_equal(county_implied[county_ops$year == 2019], 1935878, tolerance = 1)
|
||||||
|
})
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_geographic_rollup records included/excluded govids in provenance", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
with_fixture_corpus({
|
||||||
|
r <- cog_geographic_rollup(
|
||||||
|
govids = list(county = "121011212191"),
|
||||||
|
category = "Police",
|
||||||
|
years = 2019:2020,
|
||||||
|
per_capita = TRUE
|
||||||
|
)
|
||||||
|
prov <- attr(r, "provenance")
|
||||||
|
expect_true("rollup" %in% names(prov))
|
||||||
|
expect_true("121011212191" %in% prov$rollup$included_govids)
|
||||||
|
expect_true(is.character(prov$rollup$excluded_govids))
|
||||||
|
})
|
||||||
|
})
|
||||||
|
|||||||
@@ -146,7 +146,7 @@ test_that(".resolve_basket_row exact match returns one row", {
|
|||||||
expect_equal(out$match_method, "exact")
|
expect_equal(out$match_method, "exact")
|
||||||
expect_equal(out$n_candidates, 1L)
|
expect_equal(out$n_candidates, 1L)
|
||||||
expect_equal(nrow(out$row), 1L)
|
expect_equal(nrow(out$row), 1L)
|
||||||
expect_equal(out$row$canonical_govid, "101006006")
|
expect_equal(out$row$canonical_govid, "121011212191")
|
||||||
expect_equal(out$row$gov_name, "BROWARD COUNTY")
|
expect_equal(out$row$gov_name, "BROWARD COUNTY")
|
||||||
})
|
})
|
||||||
|
|
||||||
@@ -157,7 +157,7 @@ test_that(".resolve_basket_row exact match is case-insensitive", {
|
|||||||
)
|
)
|
||||||
expect_equal(out$status, "resolved")
|
expect_equal(out$status, "resolved")
|
||||||
expect_equal(out$match_method, "exact")
|
expect_equal(out$match_method, "exact")
|
||||||
expect_equal(out$row$canonical_govid, "101006006")
|
expect_equal(out$row$canonical_govid, "121011212191")
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that(".resolve_basket_row exact match honors per-row type", {
|
test_that(".resolve_basket_row exact match honors per-row type", {
|
||||||
@@ -166,7 +166,7 @@ test_that(".resolve_basket_row exact match honors per-row type", {
|
|||||||
name = "SAN DIEGO CITY", state = "CA", type = "city", con = con
|
name = "SAN DIEGO CITY", state = "CA", type = "city", con = con
|
||||||
)
|
)
|
||||||
expect_equal(out$status, "resolved")
|
expect_equal(out$status, "resolved")
|
||||||
expect_equal(out$row$canonical_govid, "052037010")
|
expect_equal(out$row$canonical_govid, "062073207598")
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that(".resolve_basket_row substring fallback resolves single match", {
|
test_that(".resolve_basket_row substring fallback resolves single match", {
|
||||||
@@ -177,7 +177,7 @@ test_that(".resolve_basket_row substring fallback resolves single match", {
|
|||||||
expect_equal(out$status, "resolved")
|
expect_equal(out$status, "resolved")
|
||||||
expect_equal(out$match_method, "substring")
|
expect_equal(out$match_method, "substring")
|
||||||
expect_equal(out$n_candidates, 1L)
|
expect_equal(out$n_candidates, 1L)
|
||||||
expect_equal(out$row$canonical_govid, "101006006")
|
expect_equal(out$row$canonical_govid, "121011212191")
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that(".resolve_basket_row no_match returns 0-row tibble", {
|
test_that(".resolve_basket_row no_match returns 0-row tibble", {
|
||||||
@@ -207,15 +207,19 @@ test_that(".resolve_basket_row treats empty/whitespace name as no_match", {
|
|||||||
|
|
||||||
test_that(".resolve_basket_row largest_pop within single type", {
|
test_that(".resolve_basket_row largest_pop within single type", {
|
||||||
# FL Miami substring matches 10 cities (all govs_type = 2), largest pop
|
# FL Miami substring matches 10 cities (all govs_type = 2), largest pop
|
||||||
# is MIAMI CITY at 443665.
|
# is MIAMI CITY at 443665. Under Phase P canonical naming, MIAMI-DADE
|
||||||
|
# COUNTY (govs_type = 1) also contains "Miami", so `type = "city"` pins
|
||||||
|
# the match set to a single type (as the query docs promise it will for
|
||||||
|
# per-row `type`), keeping this test's original intent: multiple
|
||||||
|
# same-type name matches resolve to the largest-population row.
|
||||||
con <- uscogdata:::.ensure_session()
|
con <- uscogdata:::.ensure_session()
|
||||||
out <- uscogdata:::.resolve_basket_row(
|
out <- uscogdata:::.resolve_basket_row(
|
||||||
name = "Miami", state = "FL", type = NA_character_, con = con
|
name = "Miami", state = "FL", type = "city", con = con
|
||||||
)
|
)
|
||||||
expect_equal(out$status, "largest_pop")
|
expect_equal(out$status, "largest_pop")
|
||||||
expect_equal(out$match_method, "substring")
|
expect_equal(out$match_method, "substring")
|
||||||
expect_gte(out$n_candidates, 2L)
|
expect_gte(out$n_candidates, 2L)
|
||||||
expect_equal(out$row$canonical_govid, "102013013")
|
expect_equal(out$row$canonical_govid, "122086194757")
|
||||||
expect_equal(out$row$gov_name, "MIAMI CITY")
|
expect_equal(out$row$gov_name, "MIAMI CITY")
|
||||||
})
|
})
|
||||||
|
|
||||||
@@ -241,7 +245,7 @@ test_that(".resolve_basket_row resolves with type override on ambiguous case", {
|
|||||||
)
|
)
|
||||||
expect_equal(out$status, "resolved")
|
expect_equal(out$status, "resolved")
|
||||||
expect_equal(out$match_method, "substring")
|
expect_equal(out$match_method, "substring")
|
||||||
expect_equal(out$row$canonical_govid, "052037010")
|
expect_equal(out$row$canonical_govid, "062073207598")
|
||||||
})
|
})
|
||||||
|
|
||||||
# ---- basket mode public surface ----
|
# ---- basket mode public surface ----
|
||||||
@@ -254,7 +258,7 @@ test_that("cog_gov_search basket mode resolves clean inputs in input order", {
|
|||||||
)
|
)
|
||||||
expect_s3_class(basket, "tbl_df")
|
expect_s3_class(basket, "tbl_df")
|
||||||
expect_equal(nrow(basket), 3L)
|
expect_equal(nrow(basket), 3L)
|
||||||
expect_equal(basket$canonical_govid, c("101006006", "052037010", "442227001"))
|
expect_equal(basket$canonical_govid, c("121011212191", "062073207598", "482453176394"))
|
||||||
expect_equal(basket$gov_name, c("BROWARD COUNTY", "SAN DIEGO CITY", "AUSTIN CITY"))
|
expect_equal(basket$gov_name, c("BROWARD COUNTY", "SAN DIEGO CITY", "AUSTIN CITY"))
|
||||||
})
|
})
|
||||||
|
|
||||||
@@ -284,7 +288,7 @@ test_that("cog_gov_search basket mode skips ambiguous and no_match rows", {
|
|||||||
))
|
))
|
||||||
# Broward resolves; San Diego ambiguous; Notarealplace no_match.
|
# Broward resolves; San Diego ambiguous; Notarealplace no_match.
|
||||||
expect_equal(nrow(basket), 1L)
|
expect_equal(nrow(basket), 1L)
|
||||||
expect_equal(basket$canonical_govid, "101006006")
|
expect_equal(basket$canonical_govid, "121011212191")
|
||||||
res <- attr(basket, "resolution")
|
res <- attr(basket, "resolution")
|
||||||
expect_equal(nrow(res), 3L)
|
expect_equal(nrow(res), 3L)
|
||||||
expect_equal(res$status, c("resolved", "ambiguous", "no_match"))
|
expect_equal(res$status, c("resolved", "ambiguous", "no_match"))
|
||||||
@@ -306,20 +310,24 @@ test_that("cog_gov_search basket mode recycles single state", {
|
|||||||
state = "CA"
|
state = "CA"
|
||||||
)
|
)
|
||||||
expect_equal(nrow(basket), 2L)
|
expect_equal(nrow(basket), 2L)
|
||||||
expect_equal(basket$canonical_govid, c("052037010", "052001009"))
|
expect_equal(basket$canonical_govid, c("062073207598", "062001123093"))
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_gov_search basket mode within-type largest_pop records candidates", {
|
test_that("cog_gov_search basket mode within-type largest_pop records candidates", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
|
# `type = "city"` for the Miami row pins the match set to govs_type = 2;
|
||||||
|
# under Phase P canonical naming MIAMI-DADE COUNTY also contains "Miami"
|
||||||
|
# and would otherwise make this an ambiguous (cross-type) match.
|
||||||
basket <- suppressMessages(cog_gov_search(
|
basket <- suppressMessages(cog_gov_search(
|
||||||
name = c("Miami", "OAKLAND CITY"),
|
name = c("Miami", "OAKLAND CITY"),
|
||||||
state = c("FL", "CA")
|
state = c("FL", "CA"),
|
||||||
|
type = c("city", NA)
|
||||||
))
|
))
|
||||||
expect_equal(nrow(basket), 2L)
|
expect_equal(nrow(basket), 2L)
|
||||||
res <- attr(basket, "resolution")
|
res <- attr(basket, "resolution")
|
||||||
miami_row <- res[res$query_name == "Miami", ]
|
miami_row <- res[res$query_name == "Miami", ]
|
||||||
expect_equal(miami_row$status, "largest_pop")
|
expect_equal(miami_row$status, "largest_pop")
|
||||||
expect_equal(miami_row$canonical_govid, "102013013")
|
expect_equal(miami_row$canonical_govid, "122086194757")
|
||||||
expect_gte(miami_row$n_candidates, 2L)
|
expect_gte(miami_row$n_candidates, 2L)
|
||||||
expect_gte(nrow(miami_row$candidates[[1]]), 2L)
|
expect_gte(nrow(miami_row$candidates[[1]]), 2L)
|
||||||
})
|
})
|
||||||
@@ -396,7 +404,7 @@ test_that("cog_gov_search basket mode skips per-row excluded type without aborti
|
|||||||
))
|
))
|
||||||
# Broward should resolve; the special_district row should be no_match.
|
# Broward should resolve; the special_district row should be no_match.
|
||||||
expect_equal(nrow(basket), 1L)
|
expect_equal(nrow(basket), 1L)
|
||||||
expect_equal(basket$canonical_govid, "101006006")
|
expect_equal(basket$canonical_govid, "121011212191")
|
||||||
res <- attr(basket, "resolution")
|
res <- attr(basket, "resolution")
|
||||||
expect_equal(res$status, c("resolved", "no_match"))
|
expect_equal(res$status, c("resolved", "no_match"))
|
||||||
# query_type should record what the user passed for the excluded-type row
|
# query_type should record what the user passed for the excluded-type row
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
test_that("cog_spending returns expected shape for Broward Corrections 2020", {
|
test_that("cog_spending returns expected shape for Broward Corrections 2020", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", years = 2020L, category = "Corrections")
|
r <- cog_spending("121011212191", years = 2020L, category = "Corrections")
|
||||||
expect_s3_class(r, "tbl_df")
|
expect_s3_class(r, "tbl_df")
|
||||||
expected_cols <- c("year", "canonical_govid", "gov_name", "spend_subtype",
|
expected_cols <- c("year", "canonical_govid", "gov_name", "spend_subtype",
|
||||||
"category", "amt_nominal", "codes_included",
|
"category", "amt_nominal", "codes_included",
|
||||||
"aggregate_fallback", "notes")
|
"aggregate_fallback", "notes")
|
||||||
expect_true(all(expected_cols %in% names(r)))
|
expect_true(all(expected_cols %in% names(r)))
|
||||||
expect_equal(unique(r$canonical_govid), "101006006")
|
expect_equal(unique(r$canonical_govid), "121011212191")
|
||||||
expect_equal(unique(r$year), 2020L)
|
expect_equal(unique(r$year), 2020L)
|
||||||
expect_equal(unique(r$category), "Corrections")
|
expect_equal(unique(r$category), "Corrections")
|
||||||
expect_true(all(r$spend_subtype %in% c("operations", "capital")))
|
expect_true(all(r$spend_subtype %in% c("operations", "capital")))
|
||||||
@@ -15,7 +15,7 @@ test_that("cog_spending returns expected shape for Broward Corrections 2020", {
|
|||||||
|
|
||||||
test_that("cog_spending vectorised years + categories", {
|
test_that("cog_spending vectorised years + categories", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", 2019:2020,
|
r <- cog_spending("121011212191", 2019:2020,
|
||||||
category = c("Corrections", "Police"))
|
category = c("Corrections", "Police"))
|
||||||
expect_true(all(r$year %in% 2019:2020))
|
expect_true(all(r$year %in% 2019:2020))
|
||||||
expect_true(all(r$category %in% c("Corrections", "Police")))
|
expect_true(all(r$category %in% c("Corrections", "Police")))
|
||||||
@@ -24,7 +24,7 @@ test_that("cog_spending vectorised years + categories", {
|
|||||||
|
|
||||||
test_that("cog_spending with per_capita adds per-capita nominal column", {
|
test_that("cog_spending with per_capita adds per-capita nominal column", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", 2020L, "Corrections", per_capita = TRUE)
|
r <- cog_spending("121011212191", 2020L, "Corrections", per_capita = TRUE)
|
||||||
expect_true("amt_per_capita_nominal" %in% names(r))
|
expect_true("amt_per_capita_nominal" %in% names(r))
|
||||||
expect_false("amt_real" %in% names(r))
|
expect_false("amt_real" %in% names(r))
|
||||||
expect_false("amt_per_capita_real" %in% names(r))
|
expect_false("amt_per_capita_real" %in% names(r))
|
||||||
@@ -34,7 +34,7 @@ test_that("cog_spending with per_capita adds per-capita nominal column", {
|
|||||||
|
|
||||||
test_that("cog_spending with adjust_to_year adds real column", {
|
test_that("cog_spending with adjust_to_year adds real column", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", 2019:2020, "Corrections",
|
r <- cog_spending("121011212191", 2019:2020, "Corrections",
|
||||||
adjust_to_year = 2022L)
|
adjust_to_year = 2022L)
|
||||||
expect_true("amt_real" %in% names(r))
|
expect_true("amt_real" %in% names(r))
|
||||||
r2019 <- dplyr::filter(r, year == 2019L)
|
r2019 <- dplyr::filter(r, year == 2019L)
|
||||||
@@ -43,7 +43,7 @@ test_that("cog_spending with adjust_to_year adds real column", {
|
|||||||
|
|
||||||
test_that("cog_spending with per_capita + adjust_to_year adds all columns", {
|
test_that("cog_spending with per_capita + adjust_to_year adds all columns", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", 2020L, "Corrections",
|
r <- cog_spending("121011212191", 2020L, "Corrections",
|
||||||
per_capita = TRUE, adjust_to_year = 2022L)
|
per_capita = TRUE, adjust_to_year = 2022L)
|
||||||
expect_true(all(c("amt_nominal", "amt_real",
|
expect_true(all(c("amt_nominal", "amt_real",
|
||||||
"amt_per_capita_nominal", "amt_per_capita_real") %in%
|
"amt_per_capita_nominal", "amt_per_capita_real") %in%
|
||||||
@@ -68,16 +68,16 @@ test_that("cog_spending for unknown govid returns empty tibble + informs", {
|
|||||||
test_that("cog_spending records found + missing govids in provenance", {
|
test_that("cog_spending records found + missing govids in provenance", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
suppressMessages(
|
suppressMessages(
|
||||||
r <- cog_spending(c("101006006", "XXXINVALID"), 2020L, "Corrections")
|
r <- cog_spending(c("121011212191", "XXXINVALID"), 2020L, "Corrections")
|
||||||
)
|
)
|
||||||
prov <- attr(r, "provenance")
|
prov <- attr(r, "provenance")
|
||||||
expect_equal(sort(prov$scope$govids_found), "101006006")
|
expect_equal(sort(prov$scope$govids_found), "121011212191")
|
||||||
expect_equal(sort(prov$scope$govids_missing), "XXXINVALID")
|
expect_equal(sort(prov$scope$govids_missing), "XXXINVALID")
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_spending result has provenance attribute matching schema", {
|
test_that("cog_spending result has provenance attribute matching schema", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_spending("101006006", 2020L, "Corrections")
|
r <- cog_spending("121011212191", 2020L, "Corrections")
|
||||||
prov <- attr(r, "provenance")
|
prov <- attr(r, "provenance")
|
||||||
expect_type(prov, "list")
|
expect_type(prov, "list")
|
||||||
expect_equal(prov$verb, "cog_spending")
|
expect_equal(prov$verb, "cog_spending")
|
||||||
@@ -93,7 +93,7 @@ test_that("cog_spending result has provenance attribute matching schema", {
|
|||||||
|
|
||||||
test_that("cog_spending rejects invalid inputs", {
|
test_that("cog_spending rejects invalid inputs", {
|
||||||
expect_error(cog_spending(list(), 2020L), "character|data frame")
|
expect_error(cog_spending(list(), 2020L), "character|data frame")
|
||||||
expect_error(cog_spending("101006006", "2020"), "years")
|
expect_error(cog_spending("121011212191", "2020"), "years")
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_spending accepts a cog_gov_search result directly", {
|
test_that("cog_spending accepts a cog_gov_search result directly", {
|
||||||
@@ -101,12 +101,12 @@ test_that("cog_spending accepts a cog_gov_search result directly", {
|
|||||||
picks <- cog_gov_search("^BROWARD COUNTY$", state = "FL", type = "county")
|
picks <- cog_gov_search("^BROWARD COUNTY$", state = "FL", type = "county")
|
||||||
expect_gt(nrow(picks), 0L)
|
expect_gt(nrow(picks), 0L)
|
||||||
r <- cog_spending(picks, 2020L, "Corrections")
|
r <- cog_spending(picks, 2020L, "Corrections")
|
||||||
expect_equal(unique(r$canonical_govid), "101006006")
|
expect_equal(unique(r$canonical_govid), "121011212191")
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("cog_spending accepts a cog_find_peers result directly", {
|
test_that("cog_spending accepts a cog_find_peers result directly", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
peers <- cog_find_peers("101006006", max_peers = 3L)
|
peers <- cog_find_peers("121011212191", max_peers = 3L)
|
||||||
r <- cog_spending(peers, 2020L, "Police")
|
r <- cog_spending(peers, 2020L, "Police")
|
||||||
expect_setequal(unique(r$canonical_govid),
|
expect_setequal(unique(r$canonical_govid),
|
||||||
sort(peers$canonical_govid))
|
sort(peers$canonical_govid))
|
||||||
@@ -128,3 +128,64 @@ test_that("cog_spending accepts a basket-mode cog_gov_search result", {
|
|||||||
expect_s3_class(spending, "tbl_df")
|
expect_s3_class(spending, "tbl_df")
|
||||||
expect_setequal(unique(spending$canonical_govid), basket$canonical_govid)
|
expect_setequal(unique(spending$canonical_govid), basket$canonical_govid)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
test_that("per_capita denominator is the per-year F-33 population", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
with_fixture_corpus({
|
||||||
|
r <- cog_spending("121011212191", years = 2019:2020,
|
||||||
|
category = "Police", per_capita = TRUE)
|
||||||
|
r_ops <- r[r$spend_subtype == "operations", ]
|
||||||
|
# Implied denominator from amt_nominal / amt_per_capita_nominal
|
||||||
|
implied_pop <- r_ops$amt_nominal / r_ops$amt_per_capita_nominal
|
||||||
|
names(implied_pop) <- r_ops$year
|
||||||
|
# Use absolute tolerance: within 1 person of per-year F-33 values.
|
||||||
|
# Hardcoded values are Broward County's per-year Census F-33 population
|
||||||
|
# from the bundled fixture (regenerated 2026-07-11 against cog_pipeline
|
||||||
|
# publish tree, pipeline_commit 1a00925, Phase P schema_version 4).
|
||||||
|
# 1,940,907 is the static ACS 2018-2022 5-year value the legacy
|
||||||
|
# implementation would use; we assert it is NOT what we get.
|
||||||
|
expect_true(abs(implied_pop[["2019"]] - 1935878) < 1)
|
||||||
|
expect_true(abs(implied_pop[["2020"]] - 1952778) < 1)
|
||||||
|
expect_false(all(abs(implied_pop - 1940907) < 1))
|
||||||
|
})
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("pop_source = 'census_f33' does not produce unavailable-pop note", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
with_fixture_corpus({
|
||||||
|
r <- cog_spending("121011212191", years = 2019L,
|
||||||
|
category = "Police", per_capita = TRUE)
|
||||||
|
expect_true(all(r$pop_source == "census_f33"))
|
||||||
|
expect_true(all(is.na(r$notes) | r$notes == "" |
|
||||||
|
!grepl("No population denominator", r$notes)))
|
||||||
|
})
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("aggregate fallback + unavailable pop produce concatenated notes", {
|
||||||
|
# Unit-level test of .notes_column with a synthetic data frame so we don't
|
||||||
|
# depend on having a type-4/5 gov in the fixture.
|
||||||
|
result <- tibble::tibble(
|
||||||
|
aggregate_fallback = c(FALSE, TRUE, TRUE),
|
||||||
|
pop_source = c("census_f33", "census_f33", "unavailable")
|
||||||
|
)
|
||||||
|
notes <- uscogdata:::.notes_column(result)
|
||||||
|
expect_equal(notes[1], "")
|
||||||
|
expect_equal(notes[2], "Aggregate fallback applied; see cog_explain()")
|
||||||
|
expect_equal(notes[3],
|
||||||
|
"Aggregate fallback applied; see cog_explain(); No population denominator available for this gov type")
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("provenance records per-year denominator metadata", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
with_fixture_corpus({
|
||||||
|
r <- cog_spending("121011212191", years = 2019:2020,
|
||||||
|
category = "Police", per_capita = TRUE)
|
||||||
|
pc <- attr(r, "provenance")$transformations$per_capita
|
||||||
|
expect_true(pc$applied)
|
||||||
|
expect_match(pc$denominator_source, "Census F-33", fixed = FALSE)
|
||||||
|
expect_match(pc$denominator_source, "per-year", fixed = TRUE)
|
||||||
|
expect_equal(pc$pop_source_counts$census_f33, nrow(r))
|
||||||
|
expect_equal(pc$pop_source_counts$unavailable, 0L)
|
||||||
|
expect_equal(length(pc$popyear_range), 2L)
|
||||||
|
})
|
||||||
|
})
|
||||||
|
|||||||
@@ -57,3 +57,34 @@ test_that("spending_annotated carries category + xwalk columns", {
|
|||||||
expect_true(nm %in% names(row), info = paste("missing column:", nm))
|
expect_true(nm %in% names(row), info = paste("missing column:", nm))
|
||||||
}
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
|
test_that("gov_population_yearly exposes one row per (year, canonical_govid)", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
with_fixture_corpus({
|
||||||
|
con <- uscogdata:::.ensure_session()
|
||||||
|
df <- DBI::dbGetQuery(
|
||||||
|
con,
|
||||||
|
"SELECT year, canonical_govid, population, popyear
|
||||||
|
FROM gov_population_yearly
|
||||||
|
WHERE canonical_govid = '121011212191'
|
||||||
|
ORDER BY year"
|
||||||
|
)
|
||||||
|
expect_setequal(df$year, c(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