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

@@ -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$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"])

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)))
+})