# 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. #' #' When `per_capita = TRUE`, rows whose government has no observed #' population in that year (`pop_source == "unavailable"`) are dropped from #' the result. The dropped govids are recorded in #' `provenance$rollup$excluded_govids`. This excludes special districts #' (gov type 4) and school districts (gov type 5) from per-capita rollups #' by design — see `vignette('population-denominators')`. #' #' @param govids Named list with any non-empty subset of elements named #' `state`, `county`, `city`. Each element is a character vector of #' `canonical_govid` values. At least one layer required. #' @param category Single category name or character vector (passed through #' to [cog_spending()]), or the reserved `"All Categories"` for one summed #' row per `(year, canonical_govid, subtype)` covering every category in the #' concept's scope. `"All Categories"` is the efficient way to build a #' geographic total: without it a caller must issue one rollup per category #' and sum the results themselves. #' @param years Integer vector of years. #' @param per_capita If `TRUE`, per-capita uses each gov's own per-year #' population from `gov_population_yearly`. Govs with missing population #' are excluded from the result. #' @param adjust_to_year Integer base year for CPI-U conversion, or `NULL`. #' @param expenditure_concept `"primary"` (default), `"direct"`, or #' `"total"` -- see [cog_spending()] for the three concepts. `"total"` is #' refused here because combining Total across multiple layers of #' government double-counts intergovernmental transfers (a state's payment #' to a school district is the same dollar the district reports as its own #' Direct spending); `"primary"` and `"direct"` combine safely. #' @param coverage How to handle the Census of Governments survey cycle, #' which is a **complete census only in years ending in 2 and 7** -- every #' other year is a sample, and the sample varies enormously (on the bundled #' fixture, Wisconsin's 608-city universe reports 597 governments in FY2012 #' and 112 in FY2019). #' #' * `"all"` (default) -- every unit that reported that year. Unchanged #' behaviour, so existing code keeps working. #' * `"census"` -- census years only. Aborts if the requested range holds #' none, rather than silently returning nothing. #' * `"consistent"` -- only units reporting in *every* requested year, giving #' a balanced panel. #' #' Regardless of mode, `provenance$coverage` always carries per-year #' `n_units_expected`, `n_units_collected`, `n_units_reporting` and #' `is_census_year`, and `provenance$coverage_mode` records the mode. #' `is_census_year` is a statement about the **survey calendar**, never a #' claim of completeness: FY1967 is a census year in which only 97 of #' Wisconsin's 608 cities report. `n_units_reporting` is #' category-conditional and is not a response rate on its own -- see #' "Reading `coverage`" below for what each counter answers. #' @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`, optional `pop_source`, #' `codes_included`, `aggregate_fallback`, `scope_note`, `notes`. Carries a #' `provenance` attribute with `verb = "cog_geographic_rollup"`, `layers`, #' and `rollup$included_govids` / `rollup$excluded_govids`. #' @section Reading `coverage`: #' `provenance$coverage` carries three per-year counters: #' #' * `n_units_expected` -- how many governments you asked about. #' * `n_units_collected` -- how many of those appear in the corpus at all #' that year (in ANY category), separating sampling from real zeros. #' * `n_units_reporting` -- how many have rows for the SPECIFIC category you #' requested. This is always <= n_units_collected: a government can be #' collected but have no rows for "Police" because it contracts policing #' to the county sheriff, not because it wasn't surveyed. #' #' **`n_units_reporting` is category-conditional** and therefore **not a #' response rate**: `n_units_reporting / n_units_expected` conflates sampling #' (never collected) with real zeros (collected but spends nothing in your #' category). Use `n_units_collected / n_units_expected` for the true #' collection rate, and `n_units_reporting / n_units_collected` for category #' participation among collected units. #' #' In FY2022 — a complete census year — Georgia reports 393 of 567 cities for #' `category = "Police"`; the 174-city gap is overwhelmingly cities that #' contract policing to the county sheriff, not non-response. #' #' The comparison that *is* valid is the same category across a census year #' (ending in 2 or 7) and a sample year, where the real-zero component is #' roughly constant and the difference reflects the survey cycle. `is_census_year` #' marks which is which. #' @export cog_geographic_rollup <- function(govids, category, years, per_capita = FALSE, adjust_to_year = NULL, expenditure_concept = c("primary", "direct", "total"), coverage = c("all", "census", "consistent")) { call <- match.call() expenditure_concept <- match.arg(expenditure_concept) coverage <- .validate_coverage(coverage) if (identical(expenditure_concept, "total")) { .abort_concept_not_aggregatable("cog_geographic_rollup") } .validate_rollup_layers(govids) govids <- lapply(govids, .coerce_govid_input, arg = "govids[[layer]]") if (any(lengths(govids) == 0L)) { cli::cli_abort("Each layer in `govids` must be non-empty after coercion.") } 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)) ) # coverage = "census" drops non-census years BEFORE the query rather than # after: a sample year's rows are not wanted at all, and fetching them only # to discard them would also let them into the coverage table. years <- .apply_census_years(years, coverage, "cog_geographic_rollup") r <- cog_spending(all_govids, years, category, per_capita, adjust_to_year, expenditure_concept = expenditure_concept) r <- dplyr::left_join(r, layer_map, by = "canonical_govid", relationship = "many-to-many") r$scope_note <- .rollup_scope_note(r$layer) if (identical(coverage, "consistent")) { r <- .filter_consistent(r, years) } excluded <- character(0) if (isTRUE(per_capita) && "pop_source" %in% names(r)) { drop <- r$pop_source == "unavailable" excluded <- unique(r$canonical_govid[drop]) r <- r[!drop, , drop = FALSE] } included <- unique(r$canonical_govid) r <- .reorder_rollup_cols(r) prov <- attr(r, "provenance") prov$verb <- "cog_geographic_rollup" prov$call <- paste(deparse(call), collapse = " ") prov$layers <- layer_names prov$rollup <- list( included_govids = included, excluded_govids = excluded ) # n_units_expected is the universe the CALLER named -- the govids passed in # -- not the national universe. That is what makes the ratio meaningful: # "597 of the 608 Wisconsin cities you asked about reported in FY2012". # n_units_collected is looked up against the spending long view matching # whatever basis cog_spending() actually resolved above (prov$basis) -- # NOT hardcoded to spending_long_harmonized, which does not exist on a # corpus with schema_version < 5 (R/basis.R resolves basis = "raw" there, # and only *_long, not *_long_harmonized, is registered; see R/views.R). # The con comes from .ensure_session() already called inside cog_spending(). con <- .ensure_session() prov$coverage_mode <- coverage prov$coverage <- .coverage_table( r, years, length(unique(all_govids)), con = con, long_view = .select_long_view("spending_annotated", prov$basis), expected_ids = all_govids ) attr(r, "provenance") <- prov r } #' @noRd .validate_rollup_layers <- 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}." ) } 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] }