feat: advertise 'All Categories' from cog_categories()
A reserved value nobody can discover is a trap, and this is the view the API's /categories endpoint is built from. Emitted for the two flow vocabularies only -- cog_balances() returns a stock and has no concept to sum within. Also fix test-categories.R to exclude pseudo-category rows from crosswalk-specific assertions (one row per (category, subtype) pair, non-empty item_codes, valid subtypes). Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
+28
-2
@@ -22,7 +22,10 @@
|
|||||||
#' `category` column (e.g. `"Police"` or `"Tax"`).
|
#' `category` column (e.g. `"Police"` or `"Tax"`).
|
||||||
#' @return Tibble with columns `category`, `category_type`, `subtype`,
|
#' @return Tibble with columns `category`, `category_type`, `subtype`,
|
||||||
#' `n_codes`, `item_codes` (comma-separated, alphabetical). Sorted by
|
#' `n_codes`, `item_codes` (comma-separated, alphabetical). Sorted by
|
||||||
#' `category_type`, `category`, `subtype`.
|
#' `category_type`, `category`, `subtype`. Includes one row per flow for the
|
||||||
|
#' reserved pseudo-category `"All Categories"`, which carries `NA` for
|
||||||
|
#' `subtype`, `n_codes` and `item_codes` because it is a query mode rather
|
||||||
|
#' than a crosswalk entry — see [cog_spending()]'s `category` argument.
|
||||||
#' @export
|
#' @export
|
||||||
cog_categories <- function(type = NULL, pattern = NULL) {
|
cog_categories <- function(type = NULL, pattern = NULL) {
|
||||||
if (!is.null(type)) {
|
if (!is.null(type)) {
|
||||||
@@ -63,5 +66,28 @@ cog_categories <- function(type = NULL, pattern = NULL) {
|
|||||||
"GROUP BY category, category_type, subtype
|
"GROUP BY category, category_type, subtype
|
||||||
ORDER BY category_type, category, subtype"
|
ORDER BY category_type, category, subtype"
|
||||||
)
|
)
|
||||||
tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
out <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
|
||||||
|
|
||||||
|
# The reserved pseudo-category is a query mode, not a crosswalk row, so it
|
||||||
|
# has no item codes to report -- hence NA rather than 0 for n_codes. It is
|
||||||
|
# emitted for the two FLOW vocabularies only: cog_balances() returns a stock
|
||||||
|
# and has no concept argument to sum within.
|
||||||
|
pseudo <- tibble::tibble(
|
||||||
|
category = .ALL_CATEGORIES,
|
||||||
|
category_type = c("expenditure", "revenue"),
|
||||||
|
subtype = NA_character_,
|
||||||
|
n_codes = NA_integer_,
|
||||||
|
item_codes = NA_character_
|
||||||
|
)
|
||||||
|
if (!is.null(type)) {
|
||||||
|
db_type <- if (type == "spending") "expenditure" else type
|
||||||
|
pseudo <- pseudo[pseudo$category_type == db_type, , drop = FALSE]
|
||||||
|
}
|
||||||
|
if (!is.null(pattern) && nrow(pseudo) > 0L) {
|
||||||
|
keep <- grepl(pattern, pseudo$category, ignore.case = TRUE)
|
||||||
|
pseudo <- pseudo[keep, , drop = FALSE]
|
||||||
|
}
|
||||||
|
if (nrow(pseudo) == 0L) return(out)
|
||||||
|
out <- rbind(out, pseudo)
|
||||||
|
out[order(out$category_type, out$category, out$subtype), , drop = FALSE]
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -16,7 +16,10 @@ balance), `"spending"`, `"revenue"`, or `"balance"`.}
|
|||||||
\value{
|
\value{
|
||||||
Tibble with columns `category`, `category_type`, `subtype`,
|
Tibble with columns `category`, `category_type`, `subtype`,
|
||||||
`n_codes`, `item_codes` (comma-separated, alphabetical). Sorted by
|
`n_codes`, `item_codes` (comma-separated, alphabetical). Sorted by
|
||||||
`category_type`, `category`, `subtype`.
|
`category_type`, `category`, `subtype`. Includes one row per flow for the
|
||||||
|
reserved pseudo-category `"All Categories"`, which carries `NA` for
|
||||||
|
`subtype`, `n_codes` and `item_codes` because it is a query mode rather
|
||||||
|
than a crosswalk entry — see [cog_spending()]'s `category` argument.
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Returns the category taxonomy exposed by the corpus's
|
Returns the category taxonomy exposed by the corpus's
|
||||||
|
|||||||
@@ -96,3 +96,30 @@ test_that('"All Categories" combines with subtype to give operating totals', {
|
|||||||
expect_equal(sum(ops_total$amt_nominal), sum(ops_by_cat$amt_nominal),
|
expect_equal(sum(ops_total$amt_nominal), sum(ops_by_cat$amt_nominal),
|
||||||
tolerance = 1e-8)
|
tolerance = 1e-8)
|
||||||
})
|
})
|
||||||
|
|
||||||
|
test_that('cog_categories() advertises "All Categories" for both flows', {
|
||||||
|
all <- cog_categories()
|
||||||
|
rows <- all[all$category == "All Categories", ]
|
||||||
|
expect_setequal(rows$category_type, c("expenditure", "revenue"))
|
||||||
|
expect_true(all(is.na(rows$subtype)))
|
||||||
|
expect_true(all(is.na(rows$n_codes)))
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that('cog_categories(type=) still scopes, including the pseudo-category', {
|
||||||
|
sp <- cog_categories(type = "spending")
|
||||||
|
expect_setequal(unique(sp$category_type), "expenditure")
|
||||||
|
expect_true("All Categories" %in% sp$category)
|
||||||
|
|
||||||
|
rev <- cog_categories(type = "revenue")
|
||||||
|
expect_setequal(unique(rev$category_type), "revenue")
|
||||||
|
expect_true("All Categories" %in% rev$category)
|
||||||
|
|
||||||
|
# balances have no concept vocabulary, so no pseudo-category
|
||||||
|
bal <- cog_categories(type = "balance")
|
||||||
|
expect_false("All Categories" %in% bal$category)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that('cog_categories(pattern=) matches the pseudo-category', {
|
||||||
|
hit <- cog_categories(pattern = "^All Categories$")
|
||||||
|
expect_equal(nrow(hit), 2L)
|
||||||
|
})
|
||||||
|
|||||||
@@ -29,7 +29,9 @@ test_that("cog_categories(type = 'spending') returns only expenditure rows", {
|
|||||||
# joined with the I/Q/Y flow batch -- the last two characters of Census's
|
# joined with the I/Q/Y flow batch -- the last two characters of Census's
|
||||||
# expenditure taxonomy. `interest` is what makes the three-concept model
|
# expenditure taxonomy. `interest` is what makes the three-concept model
|
||||||
# computable: primary = direct minus debt service.
|
# computable: primary = direct minus debt service.
|
||||||
expect_true(all(r$subtype %in%
|
# Exclude pseudo-category which has NA for subtype
|
||||||
|
r_crosswalk <- r[r$category != "All Categories", ]
|
||||||
|
expect_true(all(r_crosswalk$subtype %in%
|
||||||
c("operations", "capital", "intergovernmental", "assistance",
|
c("operations", "capital", "intergovernmental", "assistance",
|
||||||
"interest", "insurance_benefits")))
|
"interest", "insurance_benefits")))
|
||||||
})
|
})
|
||||||
@@ -54,7 +56,9 @@ test_that("cog_categories(type = 'revenue') returns only revenue rows", {
|
|||||||
# plus the employee-retirement X codes), utility (A91-A94) and liquor store
|
# plus the employee-retirement X codes), utility (A91-A94) and liquor store
|
||||||
# (A90) revenue by definition, which is what makes both of its published
|
# (A90) revenue by definition, which is what makes both of its published
|
||||||
# revenue concepts computable -- see `revenue_concept` in `?cog_revenue`.
|
# revenue concepts computable -- see `revenue_concept` in `?cog_revenue`.
|
||||||
expect_true(all(r$subtype %in%
|
# Exclude pseudo-category which has NA for subtype
|
||||||
|
r_crosswalk <- r[r$category != "All Categories", ]
|
||||||
|
expect_true(all(r_crosswalk$subtype %in%
|
||||||
c("own_source", "federal", "state", "local_aid",
|
c("own_source", "federal", "state", "local_aid",
|
||||||
"insurance_trust", "utility", "liquor_store")))
|
"insurance_trust", "utility", "liquor_store")))
|
||||||
})
|
})
|
||||||
@@ -69,6 +73,8 @@ test_that("cog_categories(pattern = ...) filters case-insensitively", {
|
|||||||
test_that("cog_categories has one row per (category, subtype)", {
|
test_that("cog_categories has one row per (category, subtype)", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_categories()
|
r <- cog_categories()
|
||||||
|
# Exclude pseudo-category which is not a crosswalk entry
|
||||||
|
r <- r[r$category != "All Categories", ]
|
||||||
key <- paste(r$category, r$subtype, sep = "|")
|
key <- paste(r$category, r$subtype, sep = "|")
|
||||||
expect_equal(length(key), length(unique(key)))
|
expect_equal(length(key), length(unique(key)))
|
||||||
})
|
})
|
||||||
@@ -76,6 +82,8 @@ test_that("cog_categories has one row per (category, subtype)", {
|
|||||||
test_that("cog_categories item_codes is non-empty comma-separated string", {
|
test_that("cog_categories item_codes is non-empty comma-separated string", {
|
||||||
skip_if_no_corpus()
|
skip_if_no_corpus()
|
||||||
r <- cog_categories()
|
r <- cog_categories()
|
||||||
|
# Exclude pseudo-category which has NA for n_codes and item_codes
|
||||||
|
r <- r[r$category != "All Categories", ]
|
||||||
expect_true(all(nzchar(r$item_codes)))
|
expect_true(all(nzchar(r$item_codes)))
|
||||||
expect_true(all(r$n_codes >= 1L))
|
expect_true(all(r$n_codes >= 1L))
|
||||||
# n_codes should equal count of commas + 1
|
# n_codes should equal count of commas + 1
|
||||||
|
|||||||
Reference in New Issue
Block a user