feat: cog_categories
Discovery verb over the summary_categories view, grouped one row per (category, subtype). Parallels cog_gov_search: analysts use it to find the valid `category` values to pass into cog_spending(), cog_revenue(), cog_geographic_rollup(). Columns: category, category_type, subtype, n_codes, item_codes (comma-separated, alphabetical). Optional filters: type = NULL | "spending" | "revenue" pattern = regex matched case-insensitively on category The user-facing "spending" alias is translated internally to the corpus-native "expenditure" so callers don't have to learn Census vocabulary, while the returned category_type column preserves the native value for auditability. Also: fix @noRd placement in session.R so devtools::document() stops warning. Tests: +16 new / 181 total pass. check 0E/0W/0N.
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_categories)
|
||||||
export(cog_explain)
|
export(cog_explain)
|
||||||
export(cog_find_peers)
|
export(cog_find_peers)
|
||||||
export(cog_geographic_rollup)
|
export(cog_geographic_rollup)
|
||||||
|
|||||||
@@ -0,0 +1,60 @@
|
|||||||
|
# R/categories.R
|
||||||
|
|
||||||
|
#' List available spending / revenue categories
|
||||||
|
#'
|
||||||
|
#' Returns the category taxonomy exposed by the corpus's
|
||||||
|
#' `summary_categories` view, grouped to one row per
|
||||||
|
#' `(category, subtype)` pair. Use this to discover valid `category`
|
||||||
|
#' values for [cog_spending()] / [cog_revenue()] /
|
||||||
|
#' [cog_geographic_rollup()] and to audit which Census item codes feed
|
||||||
|
#' each category.
|
||||||
|
#'
|
||||||
|
#' @param type Either `NULL` (default, return both spending and revenue
|
||||||
|
#' rows), `"spending"`, or `"revenue"`.
|
||||||
|
#' @param pattern Optional regex matched case-insensitively against the
|
||||||
|
#' `category` column (e.g. `"Police"` or `"Tax"`).
|
||||||
|
#' @return Tibble with columns `category`, `category_type`, `subtype`,
|
||||||
|
#' `n_codes`, `item_codes` (comma-separated, alphabetical). Sorted by
|
||||||
|
#' `category_type`, `category`, `subtype`.
|
||||||
|
#' @export
|
||||||
|
cog_categories <- function(type = NULL, pattern = NULL) {
|
||||||
|
if (!is.null(type)) {
|
||||||
|
if (!is.character(type) || length(type) != 1L ||
|
||||||
|
!type %in% c("spending", "revenue")) {
|
||||||
|
cli::cli_abort('`type` must be NULL, "spending", or "revenue".')
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (!is.null(pattern) &&
|
||||||
|
(!is.character(pattern) || length(pattern) != 1L)) {
|
||||||
|
cli::cli_abort("`pattern` must be a length-1 character string or NULL.")
|
||||||
|
}
|
||||||
|
|
||||||
|
con <- .ensure_session()
|
||||||
|
|
||||||
|
preds <- character(0)
|
||||||
|
if (!is.null(type)) {
|
||||||
|
# Translate user-facing "spending" to the corpus's native "expenditure"
|
||||||
|
# value so callers don't have to learn Census vocabulary. "revenue" is
|
||||||
|
# the same in both.
|
||||||
|
db_type <- if (type == "spending") "expenditure" else type
|
||||||
|
preds <- c(preds, sprintf("category_type = %s", .sql_lit_chr(db_type)))
|
||||||
|
}
|
||||||
|
if (!is.null(pattern)) {
|
||||||
|
preds <- c(preds,
|
||||||
|
sprintf("regexp_matches(category, %s, 'i')",
|
||||||
|
.sql_lit_chr(pattern)))
|
||||||
|
}
|
||||||
|
where <- if (length(preds) == 0L) "" else paste("WHERE", paste(preds, collapse = " AND "))
|
||||||
|
|
||||||
|
sql <- paste(
|
||||||
|
"SELECT category, category_type,
|
||||||
|
COALESCE(spend_subtype, revenue_subtype) AS subtype,
|
||||||
|
COUNT(DISTINCT item_code) AS n_codes,
|
||||||
|
string_agg(DISTINCT item_code, ',' ORDER BY item_code) AS item_codes
|
||||||
|
FROM summary_categories",
|
||||||
|
where,
|
||||||
|
"GROUP BY category, category_type, subtype
|
||||||
|
ORDER BY category_type, category, subtype"
|
||||||
|
)
|
||||||
|
tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
||||||
|
}
|
||||||
+10
-10
@@ -33,13 +33,13 @@ cog_open <- function(url = .resolve_url(),
|
|||||||
.uscogdata_env$con
|
.uscogdata_env$con
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Coerce an input to a character vector of canonical_govid values.
|
||||||
|
# Accepts either a character vector (returned as-is after `as.character`)
|
||||||
|
# or a data.frame / tibble with a `canonical_govid` column (such as the
|
||||||
|
# output of cog_gov_search() or cog_find_peers()) — in that case the
|
||||||
|
# column is extracted so results from discovery verbs can pipe directly
|
||||||
|
# into the query verbs.
|
||||||
#' @noRd
|
#' @noRd
|
||||||
#' Coerce an input to a character vector of canonical_govid values.
|
|
||||||
#' Accepts either a character vector (returned as-is after `as.character`)
|
|
||||||
#' or a data.frame / tibble with a `canonical_govid` column (such as the
|
|
||||||
#' output of [cog_gov_search()] or [cog_find_peers()]) — in that case the
|
|
||||||
#' column is extracted so results from discovery verbs can pipe directly
|
|
||||||
#' into the query verbs.
|
|
||||||
.coerce_govid_input <- function(x, arg = "govid") {
|
.coerce_govid_input <- function(x, arg = "govid") {
|
||||||
if (is.data.frame(x)) {
|
if (is.data.frame(x)) {
|
||||||
if (!"canonical_govid" %in% names(x)) {
|
if (!"canonical_govid" %in% names(x)) {
|
||||||
@@ -58,11 +58,11 @@ cog_open <- function(url = .resolve_url(),
|
|||||||
as.character(x)
|
as.character(x)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Check which of the supplied govids exist in canonical_fips_xwalk.
|
||||||
|
# Emits a cli message listing any missing ones alongside a pointer to the
|
||||||
|
# v0.1 scope explanation; returns both sets so callers can attach them to
|
||||||
|
# provenance.
|
||||||
#' @noRd
|
#' @noRd
|
||||||
#' Check which of the supplied govids exist in canonical_fips_xwalk.
|
|
||||||
#' Emits a cli message listing any missing ones alongside a pointer to the
|
|
||||||
#' v0.1 scope explanation; returns both sets so callers can attach them to
|
|
||||||
#' provenance.
|
|
||||||
.check_govids_in_scope <- function(govids) {
|
.check_govids_in_scope <- function(govids) {
|
||||||
govids <- unique(as.character(govids))
|
govids <- unique(as.character(govids))
|
||||||
if (length(govids) == 0L) return(list(found = character(0), missing = character(0)))
|
if (length(govids) == 0L) return(list(found = character(0), missing = character(0)))
|
||||||
|
|||||||
@@ -0,0 +1,28 @@
|
|||||||
|
% Generated by roxygen2: do not edit by hand
|
||||||
|
% Please edit documentation in R/categories.R
|
||||||
|
\name{cog_categories}
|
||||||
|
\alias{cog_categories}
|
||||||
|
\title{List available spending / revenue categories}
|
||||||
|
\usage{
|
||||||
|
cog_categories(type = NULL, pattern = NULL)
|
||||||
|
}
|
||||||
|
\arguments{
|
||||||
|
\item{type}{Either `NULL` (default, return both spending and revenue
|
||||||
|
rows), `"spending"`, or `"revenue"`.}
|
||||||
|
|
||||||
|
\item{pattern}{Optional regex matched case-insensitively against the
|
||||||
|
`category` column (e.g. `"Police"` or `"Tax"`).}
|
||||||
|
}
|
||||||
|
\value{
|
||||||
|
Tibble with columns `category`, `category_type`, `subtype`,
|
||||||
|
`n_codes`, `item_codes` (comma-separated, alphabetical). Sorted by
|
||||||
|
`category_type`, `category`, `subtype`.
|
||||||
|
}
|
||||||
|
\description{
|
||||||
|
Returns the category taxonomy exposed by the corpus's
|
||||||
|
`summary_categories` view, grouped to one row per
|
||||||
|
`(category, subtype)` pair. Use this to discover valid `category`
|
||||||
|
values for [cog_spending()] / [cog_revenue()] /
|
||||||
|
[cog_geographic_rollup()] and to audit which Census item codes feed
|
||||||
|
each category.
|
||||||
|
}
|
||||||
@@ -0,0 +1,62 @@
|
|||||||
|
test_that("cog_categories returns all categories grouped by subtype", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_categories()
|
||||||
|
expect_s3_class(r, "tbl_df")
|
||||||
|
expected <- c("category", "category_type", "subtype",
|
||||||
|
"n_codes", "item_codes")
|
||||||
|
expect_true(all(expected %in% names(r)))
|
||||||
|
expect_gt(nrow(r), 10L)
|
||||||
|
# corpus preserves Census-native "expenditure" vocabulary; the API takes
|
||||||
|
# "spending" as a friendlier alias.
|
||||||
|
expect_setequal(unique(r$category_type), c("expenditure", "revenue"))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_categories(type = 'spending') returns only expenditure rows", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_categories(type = "spending")
|
||||||
|
expect_true(all(r$category_type == "expenditure"))
|
||||||
|
expect_true(all(r$subtype %in% c("operations", "capital")))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_categories(type = 'revenue') returns only revenue rows", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_categories(type = "revenue")
|
||||||
|
expect_true(all(r$category_type == "revenue"))
|
||||||
|
expect_true(all(r$subtype %in%
|
||||||
|
c("own_source", "federal", "state", "local_aid")))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_categories(pattern = ...) filters case-insensitively", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_categories(pattern = "police")
|
||||||
|
expect_gt(nrow(r), 0L)
|
||||||
|
expect_true(all(grepl("Police", r$category, ignore.case = TRUE)))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_categories has one row per (category, subtype)", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_categories()
|
||||||
|
key <- paste(r$category, r$subtype, sep = "|")
|
||||||
|
expect_equal(length(key), length(unique(key)))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_categories item_codes is non-empty comma-separated string", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_categories()
|
||||||
|
expect_true(all(nzchar(r$item_codes)))
|
||||||
|
expect_true(all(r$n_codes >= 1L))
|
||||||
|
# n_codes should equal count of commas + 1
|
||||||
|
expect_equal(r$n_codes,
|
||||||
|
vapply(strsplit(r$item_codes, ","), length, integer(1)))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_categories sorted by category_type, category, subtype", {
|
||||||
|
skip_if_no_corpus()
|
||||||
|
r <- cog_categories()
|
||||||
|
sorted <- r[order(r$category_type, r$category, r$subtype), ]
|
||||||
|
expect_identical(r, sorted)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("cog_categories rejects invalid type", {
|
||||||
|
expect_error(cog_categories(type = "both"), "type")
|
||||||
|
})
|
||||||
Reference in New Issue
Block a user