From a92450ff766e66a23e8b0a7887588e026c78d462 Mon Sep 17 00:00:00 2001 From: Jared Knowles Date: Wed, 29 Apr 2026 17:44:25 -0400 Subject: [PATCH] feat(peers): stamp cohort_year on cog_peer_compare results Reads attr(peers, 'cohort_year') when the caller passed a cog_find_peers() tibble; NA when the caller passed a bare character vector. Stamped as a constant column on the result and recorded in provenance alongside the cohort govids. --- R/peers.R | 15 ++++++++++++--- tests/testthat/test-peers.R | 20 ++++++++++++++++++++ 2 files changed, 32 insertions(+), 3 deletions(-) diff --git a/R/peers.R b/R/peers.R index c237dfe..66e52ad 100644 --- a/R/peers.R +++ b/R/peers.R @@ -153,6 +153,12 @@ cog_peer_compare <- function(target_govid, peers, category, years, if (!is.character(target_govid) || length(target_govid) != 1L) { cli::cli_abort("`target_govid` must be a length-1 character string.") } + cohort_year <- if (is.data.frame(peers)) { + ay <- attr(peers, "cohort_year") + if (is.null(ay)) NA_integer_ else as.integer(ay) + } else { + NA_integer_ + } peer_govids <- if (is.data.frame(peers)) { as.character(peers$canonical_govid) } else { @@ -170,11 +176,14 @@ cog_peer_compare <- function(target_govid, peers, category, years, out <- dplyr::bind_rows(r, summary_rows) rank_val <- .peer_target_rank(r, target_govid, years, value_col) out$target_rank <- ifelse(out$role == "target", rank_val, NA_integer_) + out$cohort_year <- cohort_year prov <- attr(r, "provenance") %||% list() - prov$verb <- "cog_peer_compare" - prov$call <- paste(deparse(call), collapse = " ") - prov$peer_count <- length(peer_govids) + prov$verb <- "cog_peer_compare" + prov$call <- paste(deparse(call), collapse = " ") + prov$peer_count <- length(peer_govids) + prov$cohort_year <- cohort_year + prov$cohort_govids <- peer_govids prov$target <- list( canonical_govid = target_govid, gov_name = unique(r$gov_name[r$role == "target"]) diff --git a/tests/testthat/test-peers.R b/tests/testthat/test-peers.R index e54a438..01e9aac 100644 --- a/tests/testthat/test-peers.R +++ b/tests/testthat/test-peers.R @@ -111,3 +111,23 @@ test_that("cog_find_peers errors when target has no observed pop in `year`", { "no observed population" ) }) + +test_that("cog_peer_compare stamps cohort_year from peers attribute", { + skip_if_no_corpus() + peers <- cog_find_peers("101006006", year = 2019L, max_peers = 4L) + r <- cog_peer_compare("101006006", peers, "Police", years = 2020L) + expect_true("cohort_year" %in% names(r)) + expect_true(all(r$cohort_year == 2019L)) + prov <- attr(r, "provenance") + expect_equal(prov$cohort_year, 2019L) +}) + +test_that("cog_peer_compare cohort_year is NA for bare character peers", { + skip_if_no_corpus() + r <- cog_peer_compare( + "101006006", + peers = c("441015015", "441220220"), + category = "Police", years = 2020L + ) + expect_true(all(is.na(r$cohort_year))) +})