From a6b53de2a70b239a704cf79b562e978cae1eafc3 Mon Sep 17 00:00:00 2001 From: Jared Knowles Date: Fri, 24 Apr 2026 11:00:20 -0400 Subject: [PATCH] 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. --- NAMESPACE | 1 + R/rollup.R | 95 ++++++++++++++++++++++++++++++++++++ man/cog_geographic_rollup.Rd | 43 ++++++++++++++++ tests/testthat/test-rollup.R | 88 +++++++++++++++++++++++++++++++++ 4 files changed, 227 insertions(+) create mode 100644 R/rollup.R create mode 100644 man/cog_geographic_rollup.Rd create mode 100644 tests/testthat/test-rollup.R diff --git a/NAMESPACE b/NAMESPACE index ac2f7cf..18c275e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand export(cog_explain) +export(cog_geographic_rollup) export(cog_revenue) export(cog_spending) diff --git a/R/rollup.R b/R/rollup.R new file mode 100644 index 0000000..d5b58ab --- /dev/null +++ b/R/rollup.R @@ -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] +} diff --git a/man/cog_geographic_rollup.Rd b/man/cog_geographic_rollup.Rd new file mode 100644 index 0000000..ada1003 --- /dev/null +++ b/man/cog_geographic_rollup.Rd @@ -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. +} diff --git a/tests/testthat/test-rollup.R b/tests/testthat/test-rollup.R new file mode 100644 index 0000000..06dbd55 --- /dev/null +++ b/tests/testthat/test-rollup.R @@ -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" + ) +})