From 54dd40a61decdb22d86c079b5491516c05d106c1 Mon Sep 17 00:00:00 2001 From: Jared Knowles Date: Wed, 29 Apr 2026 17:26:32 -0400 Subject: [PATCH] feat(peers): cog_find_peers uses per-year population Adds optional 'year' argument (defaults to most recent observed year for the target). Filters and ranks candidates by gov_population_yearly.population at that year. Returned column renamed population_acs -> population. Cohort year attached as attr(x, 'cohort_year'). Adds .resolve_cohort_year() helper. Updates test assertions to use 'population' column name. Regenerates man/cog_find_peers.Rd. --- R/peers.R | 94 ++++++++++++++++++++++++++----------- man/cog_find_peers.Rd | 20 ++++---- tests/testthat/test-peers.R | 6 +-- 3 files changed, 80 insertions(+), 40 deletions(-) diff --git a/R/peers.R b/R/peers.R index aadfb3c..c237dfe 100644 --- a/R/peers.R +++ b/R/peers.R @@ -2,31 +2,33 @@ #' Find peer governments by similarity criteria #' -#' Selects peer governments from `canonical_fips_xwalk` by combinations of -#' government type, state, and population range. Peers are ordered by -#' `|log(pop_ratio)|` ascending (closest to the target's population first). +#' Selects peer governments by combinations of government type, state, and +#' population range at a chosen `year`. Peers are ordered by `|log(pop_ratio)|` +#' ascending (closest to the target's population first). #' #' @param target_govid Character scalar — `canonical_govid` of the target. +#' @param year Integer scalar. Cohort vintage. When `NULL` (default), uses the +#' most recent year for which the target has an observed population in +#' `gov_population_yearly`. #' @param same_type If `TRUE` (default) restrict peers to the target's #' `govs_type`. #' @param same_state If `TRUE` restrict peers to the target's `fips_state`. #' Default `FALSE`. #' @param pop_range Length-2 numeric vector giving lower/upper bounds. #' @param is_ratio If `TRUE` (default) `pop_range` is multiplied by the -#' target's `population_acs` to produce absolute bounds. If `FALSE`, +#' target's population at `year` to produce absolute bounds. If `FALSE`, #' `pop_range` is interpreted as absolute population counts. -#' @param pop_year Reserved for future use (selecting ACS vintage). Currently -#' the corpus has a single snapshot so this argument has no effect. #' @param max_peers Integer cap on the number of peers returned. #' @return Tibble with columns `canonical_govid`, `gov_name`, `fips_state`, -#' `population_acs`, `pop_ratio`, `rank`. +#' `population`, `pop_ratio`, `rank`. The cohort year is attached as +#' `attr(x, "cohort_year")`. #' @export cog_find_peers <- function(target_govid, + year = NULL, same_type = TRUE, same_state = FALSE, pop_range = c(0.7, 1.3), is_ratio = TRUE, - pop_year = NULL, max_peers = 10L) { if (!is.character(target_govid) || length(target_govid) != 1L) { cli::cli_abort("`target_govid` must be a length-1 character string.") @@ -35,58 +37,94 @@ cog_find_peers <- function(target_govid, pop_range[1] >= pop_range[2]) { cli::cli_abort("`pop_range` must be a length-2 numeric with lo < hi.") } + if (!is.null(year) && + (!(is.numeric(year) || is.integer(year)) || length(year) != 1L)) { + cli::cli_abort("`year` must be NULL or a length-1 integer.") + } con <- .ensure_session() - target_sql <- sprintf( - "SELECT canonical_govid, gov_name, govs_type, fips_state, population_acs + # Confirm target exists in the xwalk and pull govs_type / fips_state. + meta_sql <- sprintf( + "SELECT canonical_govid, gov_name, govs_type, fips_state FROM canonical_fips_xwalk WHERE canonical_govid = %s", .sql_lit_chr(target_govid) ) - target <- DBI::dbGetQuery(con, target_sql) - if (nrow(target) == 0L) { + meta <- DBI::dbGetQuery(con, meta_sql) + if (nrow(meta) == 0L) { cli::cli_abort(c( "govid {target_govid} not found in corpus.", i = "v0.1 covers types 0-3 only (state/county/city/township); see vignette('coverage-scope')." )) } - if (is.na(target$population_acs) || target$population_acs <= 0) { - cli::cli_abort("Target {target_govid} has missing or non-positive population; cannot build pop_ratio band.") + + cohort_year <- .resolve_cohort_year(con, target_govid, year) + + pop_sql <- sprintf( + "SELECT population FROM gov_population_yearly + WHERE canonical_govid = %s AND year = %d", + .sql_lit_chr(target_govid), as.integer(cohort_year) + ) + target_pop <- DBI::dbGetQuery(con, pop_sql)$population + if (length(target_pop) == 0L || is.na(target_pop) || target_pop <= 0) { + cli::cli_abort(c( + "Target {target_govid} has no observed population in {cohort_year}.", + i = "Use a year for which population is observed; see gov_population_yearly." + )) } if (isTRUE(is_ratio)) { - lo <- target$population_acs * pop_range[1] - hi <- target$population_acs * pop_range[2] + lo <- target_pop * pop_range[1] + hi <- target_pop * pop_range[2] } else { lo <- pop_range[1]; hi <- pop_range[2] } preds <- c( - sprintf("canonical_govid != %s", .sql_lit_chr(target_govid)), - sprintf("population_acs BETWEEN %.6f AND %.6f", lo, hi) + sprintf("p.canonical_govid != %s", .sql_lit_chr(target_govid)), + sprintf("p.year = %d", as.integer(cohort_year)), + sprintf("p.population BETWEEN %.6f AND %.6f", lo, hi) ) - if (isTRUE(same_type)) preds <- c(preds, sprintf("govs_type = %d", target$govs_type)) - if (isTRUE(same_state)) preds <- c(preds, sprintf("fips_state = %s", .sql_lit_chr(target$fips_state))) + if (isTRUE(same_type)) preds <- c(preds, sprintf("x.govs_type = %d", meta$govs_type)) + if (isTRUE(same_state)) preds <- c(preds, sprintf("x.fips_state = %s", .sql_lit_chr(meta$fips_state))) peers_sql <- sprintf( - "SELECT canonical_govid, gov_name, fips_state, population_acs, - population_acs / %.6f AS pop_ratio - FROM canonical_fips_xwalk + "SELECT p.canonical_govid, x.gov_name, x.fips_state, p.population, + p.population / %.6f AS pop_ratio + FROM gov_population_yearly p + JOIN canonical_fips_xwalk x USING (canonical_govid) WHERE %s - ORDER BY ABS(LN(CAST(population_acs AS DOUBLE) / %.6f)) + ORDER BY ABS(LN(CAST(p.population AS DOUBLE) / %.6f)) LIMIT %d", - target$population_acs, + target_pop, paste(preds, collapse = " AND "), - target$population_acs, + target_pop, as.integer(max_peers) ) peers <- tibble::as_tibble(DBI::dbGetQuery(con, peers_sql)) - if (nrow(peers) > 0L) peers$rank <- seq_len(nrow(peers)) - else peers$rank <- integer(0) + peers$rank <- if (nrow(peers) > 0L) seq_len(nrow(peers)) else integer(0) + attr(peers, "cohort_year") <- as.integer(cohort_year) peers } +#' @noRd +.resolve_cohort_year <- function(con, target_govid, year) { + if (!is.null(year)) return(as.integer(year)) + sql <- sprintf( + "SELECT MAX(year) AS y FROM gov_population_yearly + WHERE canonical_govid = %s", + .sql_lit_chr(target_govid) + ) + y <- DBI::dbGetQuery(con, sql)$y + if (length(y) == 0L || is.na(y)) { + cli::cli_abort( + "Target {target_govid} has no observed population in any year." + ) + } + as.integer(y) +} + #' Compare a target government against a peer set #' #' Pulls spending for the target plus a peer set (either a diff --git a/man/cog_find_peers.Rd b/man/cog_find_peers.Rd index b9c3ad0..8a1444c 100644 --- a/man/cog_find_peers.Rd +++ b/man/cog_find_peers.Rd @@ -6,17 +6,21 @@ \usage{ cog_find_peers( target_govid, + year = NULL, same_type = TRUE, same_state = FALSE, pop_range = c(0.7, 1.3), is_ratio = TRUE, - pop_year = NULL, max_peers = 10L ) } \arguments{ \item{target_govid}{Character scalar — `canonical_govid` of the target.} +\item{year}{Integer scalar. Cohort vintage. When `NULL` (default), uses the +most recent year for which the target has an observed population in +`gov_population_yearly`.} + \item{same_type}{If `TRUE` (default) restrict peers to the target's `govs_type`.} @@ -26,20 +30,18 @@ Default `FALSE`.} \item{pop_range}{Length-2 numeric vector giving lower/upper bounds.} \item{is_ratio}{If `TRUE` (default) `pop_range` is multiplied by the -target's `population_acs` to produce absolute bounds. If `FALSE`, +target's population at `year` to produce absolute bounds. If `FALSE`, `pop_range` is interpreted as absolute population counts.} -\item{pop_year}{Reserved for future use (selecting ACS vintage). Currently -the corpus has a single snapshot so this argument has no effect.} - \item{max_peers}{Integer cap on the number of peers returned.} } \value{ Tibble with columns `canonical_govid`, `gov_name`, `fips_state`, - `population_acs`, `pop_ratio`, `rank`. + `population`, `pop_ratio`, `rank`. The cohort year is attached as + `attr(x, "cohort_year")`. } \description{ -Selects peer governments from `canonical_fips_xwalk` by combinations of -government type, state, and population range. Peers are ordered by -`|log(pop_ratio)|` ascending (closest to the target's population first). +Selects peer governments by combinations of government type, state, and +population range at a chosen `year`. Peers are ordered by `|log(pop_ratio)|` +ascending (closest to the target's population first). } diff --git a/tests/testthat/test-peers.R b/tests/testthat/test-peers.R index f393cb6..e54a438 100644 --- a/tests/testthat/test-peers.R +++ b/tests/testthat/test-peers.R @@ -3,7 +3,7 @@ test_that("cog_find_peers returns same-type peers in the default pop band", { peers <- cog_find_peers("101006006") # Broward County expect_s3_class(peers, "tbl_df") expected_cols <- c("canonical_govid", "gov_name", "fips_state", - "population_acs", "pop_ratio", "rank") + "population", "pop_ratio", "rank") expect_true(all(expected_cols %in% names(peers))) expect_true(all(peers$pop_ratio >= 0.7 & peers$pop_ratio <= 1.3)) expect_false("101006006" %in% peers$canonical_govid) @@ -22,8 +22,8 @@ test_that("cog_find_peers absolute pop range works", { peers <- cog_find_peers("101006006", pop_range = c(1.5e6, 2.5e6), is_ratio = FALSE, max_peers = 20L) - expect_true(all(peers$population_acs >= 1.5e6 & - peers$population_acs <= 2.5e6)) + expect_true(all(peers$population >= 1.5e6 & + peers$population <= 2.5e6)) }) test_that("cog_find_peers errors cleanly on unknown govid", {