polish(per-year-pop): expand popyear in cog_explain + propagate pop_range
R-CMD-check / check (push) Failing after 1m30s
R-CMD-check / check (push) Failing after 1m30s
Final-review followups:
1. cog_explain rendered the popyear range as raw 2-digit values
("popyear range: 19-20"), which a user could read as the years 19-20.
Added .expand_popyear() helper to format as 4-digit calendar years
(2019-2020). Pivot at 70 to handle pre-2000 vintages if the corpus
ever extends backward.
2. cog_peer_compare provenance was missing pop_range and is_ratio,
omitted from the spec-required reproducibility metadata.
cog_find_peers now stamps both as tibble attributes; cog_peer_compare
reads them through to provenance$pop_range and provenance$is_ratio.
Test coverage extended: explain test asserts the 4-digit format and
rejects the old 2-digit form; peer-compare test asserts pop_range +
is_ratio propagate end-to-end.
326 PASS / 0 FAIL.
This commit is contained in:
@@ -105,6 +105,8 @@ cog_find_peers <- function(target_govid,
|
||||
peers <- tibble::as_tibble(DBI::dbGetQuery(con, peers_sql))
|
||||
peers$rank <- if (nrow(peers) > 0L) seq_len(nrow(peers)) else integer(0)
|
||||
attr(peers, "cohort_year") <- as.integer(cohort_year)
|
||||
attr(peers, "pop_range") <- as.numeric(pop_range)
|
||||
attr(peers, "is_ratio") <- isTRUE(is_ratio)
|
||||
peers
|
||||
}
|
||||
|
||||
@@ -162,6 +164,8 @@ cog_peer_compare <- function(target_govid, peers, category, years,
|
||||
} else {
|
||||
NA_integer_
|
||||
}
|
||||
pop_range <- if (is.data.frame(peers)) attr(peers, "pop_range") else NULL
|
||||
is_ratio <- if (is.data.frame(peers)) attr(peers, "is_ratio") else NULL
|
||||
peer_govids <- if (is.data.frame(peers)) {
|
||||
as.character(peers$canonical_govid)
|
||||
} else {
|
||||
@@ -187,6 +191,8 @@ cog_peer_compare <- function(target_govid, peers, category, years,
|
||||
prov$peer_count <- length(peer_govids)
|
||||
prov$cohort_year <- cohort_year
|
||||
prov$cohort_govids <- peer_govids
|
||||
prov$pop_range <- pop_range
|
||||
prov$is_ratio <- is_ratio
|
||||
prov$target <- list(
|
||||
canonical_govid = target_govid,
|
||||
gov_name = unique(r$gov_name[r$role == "target"])
|
||||
|
||||
Reference in New Issue
Block a user