CI failed on the previous commit. testthat::test_local() from a checkout was
green, but rcmdcheck was not: under R CMD check the suite runs against the
INSTALLED package, where README.md, vignettes/ and man/ do not exist. Both
newly-activated tests read them through test_path("..", "..", ...) and died
on `cannot open the connection`.
The defect was latent in the committed tests, not introduced here -- they
shipped skip()ped, so CI had never executed either one. Removing the skips
is what exposed it, which is the mechanism working as intended.
Guarded with skip_if_no_source_tree(), so they skip in the installed-package
context that structurally cannot satisfy them. They are NOT thereby unchecked
in CI: the workflow runs testthat::test_local() from the checkout as its own
step before rcmdcheck, and there the paths resolve and the assertions run.
Deliberately not split: test-peer-summary-scope.R's numeric pin needs only
the corpus and would survive check on its own, but it exists to protect the
sentence above it. Separating them would let the prose drift while the pin
kept passing.
Verified locally: test_local 629 pass / 0 fail / 3 skip; rcmdcheck
0 errors / 0 warnings / 0 notes.
52 lines
2.8 KiB
R
52 lines
2.8 KiB
R
# Madison walkthrough audit -- finding F-021. Tracked as uscogdata#14.
|
|
# See docs/walkthroughs/FINDINGS.md in cog_explorer.
|
|
#
|
|
# .peer_summary_rows() computes stats::quantile() separately INSIDE each
|
|
# (year, spend_subtype, category) cell. A summary_p50 row is therefore "the
|
|
# median peer's value in that one category", not "the value of the median
|
|
# peer's total". Summing those rows across categories -- the obvious move for a
|
|
# caller who wants one peer-median total line and reads only the column names --
|
|
# misstated a total-spending band by -32.7% to +251.0% across the 24 years the
|
|
# audit tested, with a sign flip at FY2012.
|
|
#
|
|
# The verb is not wrong and its documented use (faceting by role AND category)
|
|
# is unaffected, so the fix is documentation: one sentence in @return.
|
|
|
|
test_that("cog_peer_compare() documents that summary_* rows are per-category quantiles", {
|
|
|
|
# man/ ships only in the source tree (the installed package carries a
|
|
# compiled help database instead), so the prose assertions below cannot run
|
|
# under R CMD check -- CI's earlier testthat::test_local() step enforces
|
|
# them. The numeric pin further down needs only the corpus, but it lives in
|
|
# the same test_that() as the sentence it protects, deliberately: they are
|
|
# one claim, and splitting them would let the prose drift while a separate
|
|
# test kept passing.
|
|
rd_path <- skip_if_no_source_tree(c("man", "cog_peer_compare.Rd"))
|
|
rd <- paste(readLines(rd_path, warn = FALSE), collapse = " ")
|
|
|
|
# The @return section must say the quantile is computed within each cell...
|
|
expect_match(rd, "within each|per-category|per category", ignore.case = TRUE)
|
|
# ...and must warn that the rows are not additive across category.
|
|
expect_match(rd, "not additive|do(es)? not sum|cannot be summed", ignore.case = TRUE)
|
|
# ...naming the grouping explicitly.
|
|
expect_match(rd, "spend_subtype", fixed = TRUE)
|
|
|
|
# Pin the mechanism numerically so a future refactor that quietly changes the
|
|
# quantile grouping fails here rather than silently invalidating the sentence
|
|
# above. Fixture: Madison, 10 peers found at FY2020, category = NULL.
|
|
peers <- cog_find_peers("552025209777", year = 2020L, max_peers = 10L)
|
|
cmp <- cog_peer_compare(target_govid = "552025209777", peers = peers,
|
|
category = NULL, years = 2020L, per_capita = TRUE)
|
|
|
|
naive <- sum(cmp$amt_per_capita_nominal[cmp$role == "summary_p50"], na.rm = TRUE)
|
|
|
|
peer_rows <- cmp[cmp$role == "peer", ]
|
|
per_gov <- tapply(peer_rows$amt_per_capita_nominal, peer_rows$canonical_govid,
|
|
sum, na.rm = TRUE)
|
|
correct <- unname(stats::quantile(per_gov, 0.5, na.rm = TRUE))
|
|
|
|
expect_equal(round(naive), 6180) # summing the built-in summary rows
|
|
expect_equal(round(correct), 2043) # quantile of each peer's OWN total
|
|
expect_gt(naive / correct, 2) # a +200% misstatement on this cohort
|
|
})
|