feat: cog_geographic_rollup
Wraps cog_spending across a named list of state/county/city layers, tagging each row with its `layer` and attaching a scope_note that documents geographic-scope caveats (state totals are statewide, county totals include areas outside a listed city, city proper excludes special districts). Per-capita uses each layer's own population from the canonical_fips_xwalk. Provenance is inherited from cog_spending but rewritten to reflect the outer verb (verb, call, layers). Tests: 19 new / 99 total pass. devtools::check() 0E/0W/2N.
This commit is contained in:
@@ -1,5 +1,6 @@
|
|||||||
# Generated by roxygen2: do not edit by hand
|
# Generated by roxygen2: do not edit by hand
|
||||||
|
|
||||||
export(cog_explain)
|
export(cog_explain)
|
||||||
|
export(cog_geographic_rollup)
|
||||||
export(cog_revenue)
|
export(cog_revenue)
|
||||||
export(cog_spending)
|
export(cog_spending)
|
||||||
|
|||||||
+95
@@ -0,0 +1,95 @@
|
|||||||
|
# R/rollup.R
|
||||||
|
|
||||||
|
#' Aggregate spending across state/county/city layers for a place
|
||||||
|
#'
|
||||||
|
#' Wraps [cog_spending()], tags each row with its layer, and attaches a
|
||||||
|
#' human-readable `scope_note` documenting geographic-scope caveats (e.g.
|
||||||
|
#' "county totals include areas outside the listed city"). Useful for
|
||||||
|
#' "place portraits" that compare a city to the surrounding county and
|
||||||
|
#' containing state on one set of axes.
|
||||||
|
#'
|
||||||
|
#' @param govids Named list with any non-empty subset of elements named
|
||||||
|
#' `state`, `county`, `city`. Each element is a character vector of
|
||||||
|
#' `canonical_govid` values. At least one layer required.
|
||||||
|
#' @param category Single category name or character vector (passed through
|
||||||
|
#' to [cog_spending()]).
|
||||||
|
#' @param years Integer vector of years.
|
||||||
|
#' @param per_capita If `TRUE`, per-capita uses each layer's own population
|
||||||
|
#' from `canonical_fips_xwalk.population_acs`.
|
||||||
|
#' @param adjust_to_year Integer base year for CPI-U conversion, or `NULL`.
|
||||||
|
#' @return Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
||||||
|
#' `spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
||||||
|
#' `amt_per_capita_nominal` / `amt_per_capita_real`, `codes_included`,
|
||||||
|
#' `aggregate_fallback`, `scope_note`, `notes`. Carries a `provenance`
|
||||||
|
#' attribute with `verb = "cog_geographic_rollup"` and `layers`.
|
||||||
|
#' @export
|
||||||
|
cog_geographic_rollup <- function(govids, category, years,
|
||||||
|
per_capita = FALSE, adjust_to_year = NULL) {
|
||||||
|
call <- match.call()
|
||||||
|
.validate_rollup_govids(govids)
|
||||||
|
|
||||||
|
layer_names <- names(govids)
|
||||||
|
all_govids <- unlist(govids, use.names = FALSE)
|
||||||
|
layer_map <- tibble::tibble(
|
||||||
|
canonical_govid = all_govids,
|
||||||
|
layer = rep(layer_names, lengths(govids))
|
||||||
|
)
|
||||||
|
|
||||||
|
r <- cog_spending(all_govids, years, category, per_capita, adjust_to_year)
|
||||||
|
r <- dplyr::left_join(r, layer_map, by = "canonical_govid",
|
||||||
|
relationship = "many-to-many")
|
||||||
|
r$scope_note <- .rollup_scope_note(r$layer)
|
||||||
|
r <- .reorder_rollup_cols(r)
|
||||||
|
|
||||||
|
prov <- attr(r, "provenance")
|
||||||
|
prov$verb <- "cog_geographic_rollup"
|
||||||
|
prov$call <- paste(deparse(call), collapse = " ")
|
||||||
|
prov$layers <- layer_names
|
||||||
|
attr(r, "provenance") <- prov
|
||||||
|
|
||||||
|
r
|
||||||
|
}
|
||||||
|
|
||||||
|
#' @noRd
|
||||||
|
.validate_rollup_govids <- function(govids) {
|
||||||
|
if (!is.list(govids) || is.data.frame(govids)) {
|
||||||
|
cli::cli_abort("`govids` must be a named list.")
|
||||||
|
}
|
||||||
|
if (length(govids) == 0L) {
|
||||||
|
cli::cli_abort("`govids` must have non-zero length (at least one layer).")
|
||||||
|
}
|
||||||
|
nms <- names(govids)
|
||||||
|
if (is.null(nms) || any(!nzchar(nms))) {
|
||||||
|
cli::cli_abort("`govids` must be fully named.")
|
||||||
|
}
|
||||||
|
bad <- setdiff(nms, c("state", "county", "city"))
|
||||||
|
if (length(bad) > 0L) {
|
||||||
|
cli::cli_abort(
|
||||||
|
"`govids` names must be one of 'state', 'county', 'city'. Got: {bad}."
|
||||||
|
)
|
||||||
|
}
|
||||||
|
if (any(lengths(govids) == 0L)) {
|
||||||
|
cli::cli_abort("Each layer in `govids` must be non-empty.")
|
||||||
|
}
|
||||||
|
invisible(TRUE)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' @noRd
|
||||||
|
.rollup_scope_note <- function(layer) {
|
||||||
|
dplyr::case_when(
|
||||||
|
layer == "state" ~ "state total; not limited to geography served by listed city/county",
|
||||||
|
layer == "county" ~ "county totals include areas outside the listed city",
|
||||||
|
layer == "city" ~ "city proper only; excludes special districts in the same county",
|
||||||
|
TRUE ~ NA_character_
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' @noRd
|
||||||
|
.reorder_rollup_cols <- function(r) {
|
||||||
|
front <- c("year", "layer", "canonical_govid", "gov_name",
|
||||||
|
"spend_subtype", "category", "amt_nominal")
|
||||||
|
back <- c("codes_included", "aggregate_fallback", "scope_note", "notes")
|
||||||
|
middle <- setdiff(names(r), c(front, back))
|
||||||
|
desired <- c(front, middle, back)
|
||||||
|
r[, desired[desired %in% names(r)], drop = FALSE]
|
||||||
|
}
|
||||||
@@ -0,0 +1,43 @@
|
|||||||
|
% Generated by roxygen2: do not edit by hand
|
||||||
|
% Please edit documentation in R/rollup.R
|
||||||
|
\name{cog_geographic_rollup}
|
||||||
|
\alias{cog_geographic_rollup}
|
||||||
|
\title{Aggregate spending across state/county/city layers for a place}
|
||||||
|
\usage{
|
||||||
|
cog_geographic_rollup(
|
||||||
|
govids,
|
||||||
|
category,
|
||||||
|
years,
|
||||||
|
per_capita = FALSE,
|
||||||
|
adjust_to_year = NULL
|
||||||
|
)
|
||||||
|
}
|
||||||
|
\arguments{
|
||||||
|
\item{govids}{Named list with any non-empty subset of elements named
|
||||||
|
`state`, `county`, `city`. Each element is a character vector of
|
||||||
|
`canonical_govid` values. At least one layer required.}
|
||||||
|
|
||||||
|
\item{category}{Single category name or character vector (passed through
|
||||||
|
to [cog_spending()]).}
|
||||||
|
|
||||||
|
\item{years}{Integer vector of years.}
|
||||||
|
|
||||||
|
\item{per_capita}{If `TRUE`, per-capita uses each layer's own population
|
||||||
|
from `canonical_fips_xwalk.population_acs`.}
|
||||||
|
|
||||||
|
\item{adjust_to_year}{Integer base year for CPI-U conversion, or `NULL`.}
|
||||||
|
}
|
||||||
|
\value{
|
||||||
|
Tibble with columns `year`, `layer`, `canonical_govid`, `gov_name`,
|
||||||
|
`spend_subtype`, `category`, `amt_nominal`, optional `amt_real` /
|
||||||
|
`amt_per_capita_nominal` / `amt_per_capita_real`, `codes_included`,
|
||||||
|
`aggregate_fallback`, `scope_note`, `notes`. Carries a `provenance`
|
||||||
|
attribute with `verb = "cog_geographic_rollup"` and `layers`.
|
||||||
|
}
|
||||||
|
\description{
|
||||||
|
Wraps [cog_spending()], tags each row with its layer, and attaches a
|
||||||
|
human-readable `scope_note` documenting geographic-scope caveats (e.g.
|
||||||
|
"county totals include areas outside the listed city"). Useful for
|
||||||
|
"place portraits" that compare a city to the surrounding county and
|
||||||
|
containing state on one set of axes.
|
||||||
|
}
|
||||||
@@ -0,0 +1,88 @@
|
|||||||
|
test_that("cog_geographic_rollup aggregates state + county + city layers", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_geographic_rollup(
|
||||||
|
govids = list(
|
||||||
|
state = "100000000", # Florida state govt
|
||||||
|
county = "101006006", # Broward County
|
||||||
|
city = "102006004" # Fort Lauderdale City
|
||||||
|
),
|
||||||
|
category = "Police",
|
||||||
|
years = 2019:2020
|
||||||
|
)
|
||||||
|
expect_s3_class(r, "tbl_df")
|
||||||
|
expected_cols <- c("year", "layer", "canonical_govid", "gov_name",
|
||||||
|
"spend_subtype", "category", "amt_nominal",
|
||||||
|
"codes_included", "aggregate_fallback",
|
||||||
|
"scope_note", "notes")
|
||||||
|
expect_true(all(expected_cols %in% names(r)))
|
||||||
|
expect_setequal(unique(r$layer), c("state", "county", "city"))
|
||||||
|
expect_true(all(r$category == "Police"))
|
||||||
|
expect_true(all(r$year %in% 2019:2020))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_geographic_rollup respects per_capita + adjust_to_year", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_geographic_rollup(
|
||||||
|
govids = list(county = "101006006", city = "102006004"),
|
||||||
|
category = "Police",
|
||||||
|
years = 2020L,
|
||||||
|
per_capita = TRUE,
|
||||||
|
adjust_to_year = 2022L
|
||||||
|
)
|
||||||
|
expect_true(all(c("amt_nominal", "amt_real",
|
||||||
|
"amt_per_capita_nominal", "amt_per_capita_real") %in%
|
||||||
|
names(r)))
|
||||||
|
# Each layer's per-capita uses its own population: city pop < county pop,
|
||||||
|
# so per_capita_nominal for city rows should differ meaningfully from county.
|
||||||
|
city_pc <- r$amt_per_capita_nominal[r$layer == "city"]
|
||||||
|
cty_pc <- r$amt_per_capita_nominal[r$layer == "county"]
|
||||||
|
expect_true(length(city_pc) > 0L)
|
||||||
|
expect_true(length(cty_pc) > 0L)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_geographic_rollup scope_notes describe each layer", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_geographic_rollup(
|
||||||
|
govids = list(state = "100000000", county = "101006006",
|
||||||
|
city = "102006004"),
|
||||||
|
category = "Police", years = 2020L
|
||||||
|
)
|
||||||
|
state_notes <- unique(r$scope_note[r$layer == "state"])
|
||||||
|
expect_true(any(grepl("state total", state_notes)))
|
||||||
|
county_notes <- unique(r$scope_note[r$layer == "county"])
|
||||||
|
expect_true(any(grepl("county", county_notes)))
|
||||||
|
city_notes <- unique(r$scope_note[r$layer == "city"])
|
||||||
|
expect_true(any(grepl("city proper", city_notes)))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_geographic_rollup single-layer call works", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_geographic_rollup(
|
||||||
|
govids = list(county = c("101006006")),
|
||||||
|
category = "Corrections",
|
||||||
|
years = 2020L
|
||||||
|
)
|
||||||
|
expect_true(all(r$layer == "county"))
|
||||||
|
expect_gt(nrow(r), 0L)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_geographic_rollup provenance reports the outer verb", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_geographic_rollup(
|
||||||
|
govids = list(state = "100000000", county = "101006006"),
|
||||||
|
category = "Police", years = 2020L
|
||||||
|
)
|
||||||
|
prov <- attr(r, "provenance")
|
||||||
|
expect_equal(prov$verb, "cog_geographic_rollup")
|
||||||
|
expect_setequal(prov$layers, c("state", "county"))
|
||||||
|
expect_true(grepl("cog_geographic_rollup", prov$call))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_geographic_rollup rejects invalid inputs", {
|
||||||
|
expect_error(cog_geographic_rollup(list(), "Police", 2020L), "length")
|
||||||
|
expect_error(cog_geographic_rollup(c("101006006"), "Police", 2020L), "list")
|
||||||
|
expect_error(
|
||||||
|
cog_geographic_rollup(list(planet = "100000000"), "Police", 2020L),
|
||||||
|
"state|county|city"
|
||||||
|
)
|
||||||
|
})
|
||||||
Reference in New Issue
Block a user