feat: add coarse-vs-per-code signposting rate measurement harness

data-raw/measure_signposting_rate.R runs every summary_categories
category x a (seeded, deterministic) sample of up to 20 governments x
the widest pre/post-2012 year span the active corpus actually supports,
through both the R2 coarse .build_suggestions() (pulled verbatim from
git ref b0df1ec, evaluated in an isolated env parented on the uscogdata
namespace) and the current per-code version, and reports the suggestion
rate and delta under each, overall and by category.

Parameterized by USCOGDATA_URL (defaults to the bundled fixture when
unset) so it can be re-run against the staged/full corpus later. Detects
and reports when the active corpus can't fill a full 3-year pre/3-year
post-2012 design instead of padding or fabricating years. This script
measures the coarse-vs-per-code tradeoff; it does not rule on what
suggestion-rate increase is an acceptable amount of added noise -- that
is Jared's call at Checkpoint R3.

data-raw/measure_signposting_rate.R

@@ -0,0 +1,324 @@
+# data-raw/measure_signposting_rate.R
+#
+# Phase R3 Task 19c: measures the harmonization-signposting suggestion rate
+# under BOTH the R2 "coarse" (whole-result) gap check and the R3 "per-code"
+# gap check now shipped in R/suggestions.R, over a realistic query battery:
+#   every summary_categories category
+#     x a 3-year pre/post-2012 span (the wide-aggregate -> modern-leaf
+#       format-boundary window; falls back to the widest span the corpus
+#       actually supports if it can't fill a full 3+3 design -- see
+#       .measure_year_span())
+#     x up to N_GOV sampled governments (seeded, deterministic)
+#
+# This script MEASURES the coarse-vs-per-code delta; it does not decide
+# whether that much added signposting "noise" is acceptable. That is
+# Jared's ruling at Checkpoint R3 (see
+# cog_pipeline/.superpowers/sdd/phase-r-task-19c-brief.md).
+#
+# The R2 "coarse" implementation no longer exists in R/suggestions.R (Task
+# 19c replaced it in place with the per-code version), so this script pulls
+# it VERBATIM from git history (default ref: b0df1ec, the merged tip of the
+# R2 branch) and evaluates it in an isolated environment parented on the
+# uscogdata namespace, so it still resolves unchanged helpers it depends on
+# (.sql_lit_chr()) exactly as the live package does. This guarantees the
+# "coarse" arm is the actual shipped R2 code, not a hand-reconstruction of
+# it that could silently drift from what really shipped.
+#
+# Usage (from the uscogdata package root; a git checkout, not a tarball):
+#   Rscript data-raw/measure_signposting_rate.R
+#   USCOGDATA_URL=<staged-corpus-url> Rscript data-raw/measure_signposting_rate.R
+#
+# Or from R:
+#   source("data-raw/measure_signposting_rate.R")
+#   res <- measure_signposting_rate(corpus_url = "<url>")
+#   res$summary; res$by_category
+
+#' Pull the R2-era (coarse, whole-result) `.build_suggestions()` verbatim
+#' from git history and evaluate it in an isolated environment parented on
+#' the uscogdata namespace, so it resolves unchanged sibling helpers
+#' (`.sql_lit_chr()`) the same way the live package does.
+#' @noRd
+.measure_load_coarse_impl <- function(git_ref = "b0df1ec",
+                                       git_path = "R/suggestions.R") {
+  old_src <- tryCatch(
+    system2("git", c("show", sprintf("%s:%s", git_ref, git_path)),
+            stdout = TRUE, stderr = TRUE),
+    error = function(e) NULL
+  )
+  status <- attr(old_src, "status")
+  if (is.null(old_src) || (!is.null(status) && status != 0L) ||
+      !any(grepl("^\\.build_suggestions", old_src))) {
+    stop(
+      "Could not retrieve the R2 .build_suggestions() implementation from ",
+      "git ref '", git_ref, "' at '", git_path, "'. Run this script from ",
+      "inside the uscogdata git checkout (not a tarball/installed copy).",
+      call. = FALSE
+    )
+  }
+  env <- new.env(parent = asNamespace("uscogdata"))
+  # eval(parse()) here is safe: `old_src` is not external/untrusted input --
+  # it is this repo's OWN historical R/suggestions.R, fetched via `git show`
+  # from a fixed, hardcoded internal commit ref (default b0df1ec, the merged
+  # R2 tip; overridable only by a caller who already has R-level code
+  # execution in this dev-only measurement script). No network or
+  # user-supplied data reaches this call.
+  eval(parse(text = old_src), envir = env)
+  stopifnot(is.function(env$.build_suggestions))
+  env
+}
+
+#' Resolve the query battery's year span: a `pre_n`-year window immediately
+#' before `boundary_year` unioned with a `post_n`-year window starting at
+#' `boundary_year` (default 3+3 around 2012, the wide-aggregate ->
+#' modern-leaf format boundary). Falls back to every distinct year the
+#' corpus actually has in `long` when it can't fill that full design, and
+#' says so explicitly in `$note` rather than silently padding or
+#' fabricating years.
+#' @noRd
+.measure_year_span <- function(con, boundary_year = 2012L,
+                                pre_n = 3L, post_n = 3L) {
+  available <- sort(as.integer(
+    DBI::dbGetQuery(con, "SELECT DISTINCT year FROM long")$year
+  ))
+  desired_pre  <- (boundary_year - pre_n):(boundary_year - 1L)
+  desired_post <- boundary_year:(boundary_year + post_n - 1L)
+  actual_pre   <- intersect(desired_pre, available)
+  actual_post  <- intersect(desired_post, available)
+  full_design  <- length(actual_pre) == pre_n && length(actual_post) == post_n
+
+  if (full_design) {
+    years <- sort(c(actual_pre, actual_post))
+    note <- sprintf(
+      "Full %d-year pre/%d-year post-%d design available -- using years: %s.",
+      pre_n, post_n, boundary_year, paste(years, collapse = ", ")
+    )
+  } else {
+    years <- available
+    note <- sprintf(paste(
+      "Corpus does NOT support a full %d-year pre/%d-year post-%d span",
+      "(desired pre-window %s -> only %s present; desired post-window %s",
+      "-> only %s present). Falling back to the WIDEST span this corpus",
+      "supports: all %d distinct year(s) actually in `long`: %s.",
+      "This is NOT a 3-year pre/post-%d design -- reported as measured,",
+      "not padded or fabricated."
+    ),
+    pre_n, post_n, boundary_year,
+    paste(desired_pre, collapse = ","),
+    if (length(actual_pre)) paste(actual_pre, collapse = ",") else "none",
+    paste(desired_post, collapse = ","),
+    if (length(actual_post)) paste(actual_post, collapse = ",") else "none",
+    length(available), paste(available, collapse = ", "),
+    boundary_year)
+  }
+  list(years = years, full_design = full_design, note = note,
+       available = available)
+}
+
+#' Deterministically sample up to `n` distinct governments that actually
+#' report *something* in the battery's year span (querying a government
+#' with zero presence in every measured year isn't a realistic query).
+#' @noRd
+.measure_sample_govids <- function(con, years, n = 20L, seed = 19L) {
+  pool <- DBI::dbGetQuery(con, sprintf(
+    "SELECT DISTINCT canonical_govid FROM long WHERE year IN (%s)
+     ORDER BY canonical_govid",
+    paste(years, collapse = ",")
+  ))$canonical_govid
+  if (length(pool) <= n) return(sort(pool))
+  set.seed(seed)
+  sort(sample(pool, n))
+}
+
+#' Run one (category, government) query through both the coarse (git ref
+#' `coarse_env`) and current per-code `.build_suggestions()` and return a
+#' one-row summary of what each one fired.
+#' @noRd
+.measure_one_query <- function(con, coarse_env, category, category_type,
+                                govid, years) {
+  view        <- if (identical(category_type, "revenue")) {
+    "revenue_annotated_harmonized"
+  } else {
+    "spending_annotated_harmonized"
+  }
+  subtype_col <- if (identical(category_type, "revenue")) {
+    "revenue_subtype"
+  } else {
+    "spend_subtype"
+  }
+  sql    <- .build_verb_sql(view, subtype_col, govid, years, category)
+  result <- tibble::as_tibble(DBI::dbGetQuery(con, sql))
+
+  coarse_sugg  <- coarse_env$.build_suggestions(
+    con, govid, years, category, result, "harmonized"
+  )
+  percode_sugg <- .build_suggestions(con, govid, years, category, "harmonized")
+
+  data.frame(
+    category        = category,
+    category_type   = category_type,
+    canonical_govid = govid,
+    n_result_rows   = nrow(result),
+    n_coarse        = length(coarse_sugg),
+    n_percode       = length(percode_sugg),
+    fired_coarse    = length(coarse_sugg) > 0L,
+    fired_percode   = length(percode_sugg) > 0L,
+    stringsAsFactors = FALSE
+  )
+}
+
+#' Measure the coarse-vs-per-code signposting suggestion rate over a
+#' realistic query battery (every category x a pre/post-boundary_year span
+#' x up to n_gov sampled governments).
+#'
+#' @param corpus_url Corpus to measure against. Defaults to
+#'   `Sys.getenv("USCOGDATA_URL")`; if that's unset, falls back to the
+#'   bundled v5 fixture (so the script runs out of the box). Re-run with
+#'   `USCOGDATA_URL` pointed at the staged/full corpus later.
+#' @param n_gov Governments to sample (deterministically). "Up to" -- if
+#'   the corpus has fewer distinct governments in the measured years than
+#'   this, every one of them is used.
+#' @param seed Sampling seed (fixed for reproducibility).
+#' @param boundary_year,pre_years_n,post_years_n Define the desired query
+#'   span: `pre_years_n` years immediately before `boundary_year`, unioned
+#'   with `post_years_n` years starting at `boundary_year`. Falls back to
+#'   the corpus's widest actually-available span when this can't be filled
+#'   (see `.measure_year_span()`).
+#' @param git_ref Git ref to pull the R2 coarse `.build_suggestions()` from.
+#' @param verbose Print progress/notes as the battery runs.
+#' @return Invisibly, a list with `corpus_url`, `years`, `span_note`,
+#'   `full_design`, `govids`, `seed`, `detail` (one row per query),
+#'   `by_category`, and `summary`.
+#' @noRd
+measure_signposting_rate <- function(corpus_url = Sys.getenv("USCOGDATA_URL", unset = NA),
+                                      n_gov = 20L,
+                                      seed = 19L,
+                                      boundary_year = 2012L,
+                                      pre_years_n = 3L,
+                                      post_years_n = 3L,
+                                      git_ref = "b0df1ec",
+                                      verbose = TRUE) {
+  pkgload::load_all(".", quiet = TRUE)
+
+  if (is.na(corpus_url) || !nzchar(corpus_url)) {
+    corpus_url <- paste0(
+      system.file("extdata/fixture_corpus", package = "uscogdata"), "/"
+    )
+    if (verbose) {
+      message("No USCOGDATA_URL set; defaulting to the bundled v5 fixture: ",
+              corpus_url)
+    }
+  }
+
+  old_url <- Sys.getenv("USCOGDATA_URL", unset = NA)
+  cog_close()
+  Sys.setenv(USCOGDATA_URL = corpus_url)
+  on.exit({
+    cog_close()
+    if (is.na(old_url)) Sys.unsetenv("USCOGDATA_URL") else Sys.setenv(USCOGDATA_URL = old_url)
+  }, add = TRUE)
+
+  con <- cog_open()
+  coarse_env <- .measure_load_coarse_impl(git_ref = git_ref)
+
+  span   <- .measure_year_span(con, boundary_year, pre_years_n, post_years_n)
+  years  <- span$years
+  if (verbose) message(span$note)
+
+  govids <- .measure_sample_govids(con, years, n = n_gov, seed = seed)
+  if (verbose) {
+    message(sprintf("Sampled %d government(s) (seed = %d) from %d present in years %s.",
+                     length(govids), seed,
+                     length(DBI::dbGetQuery(con, sprintf(
+                       "SELECT DISTINCT canonical_govid FROM long WHERE year IN (%s)",
+                       paste(years, collapse = ",")))$canonical_govid),
+                     paste(years, collapse = ", ")))
+  }
+
+  categories <- DBI::dbGetQuery(con,
+    "SELECT DISTINCT category, category_type FROM summary_categories
+     WHERE category IS NOT NULL ORDER BY category_type, category")
+  if (verbose) {
+    message(sprintf("Battery: %d categories x %d governments = %d queries.",
+                     nrow(categories), length(govids),
+                     nrow(categories) * length(govids)))
+  }
+
+  rows <- vector("list", nrow(categories) * length(govids))
+  k <- 0L
+  for (ci in seq_len(nrow(categories))) {
+    for (gv in govids) {
+      k <- k + 1L
+      rows[[k]] <- .measure_one_query(
+        con, coarse_env,
+        category = categories$category[ci],
+        category_type = categories$category_type[ci],
+        govid = gv, years = years
+      )
+    }
+  }
+  detail <- do.call(rbind, rows)
+
+  by_category <- dplyr::summarise(
+    dplyr::group_by(detail, category, category_type),
+    n_queries      = dplyr::n(),
+    coarse_rate    = mean(fired_coarse),
+    percode_rate   = mean(fired_percode),
+    delta_pp       = (mean(fired_percode) - mean(fired_coarse)) * 100,
+    .groups = "drop"
+  )
+  by_category <- dplyr::arrange(by_category, dplyr::desc(delta_pp))
+
+  summary_overall <- data.frame(
+    n_queries     = nrow(detail),
+    n_categories  = nrow(categories),
+    n_governments = length(govids),
+    coarse_fired  = sum(detail$fired_coarse),
+    percode_fired = sum(detail$fired_percode),
+    coarse_rate   = mean(detail$fired_coarse),
+    percode_rate  = mean(detail$fired_percode)
+  )
+  summary_overall$delta_pp <- (summary_overall$percode_rate - summary_overall$coarse_rate) * 100
+  summary_overall$relative_increase <- if (summary_overall$coarse_rate > 0) {
+    summary_overall$percode_rate / summary_overall$coarse_rate - 1
+  } else {
+    NA_real_
+  }
+
+  if (verbose) {
+    message(sprintf(
+      "Coarse rate: %.4f (%d/%d)  |  Per-code rate: %.4f (%d/%d)  |  Delta: %+.2f pp",
+      summary_overall$coarse_rate, summary_overall$coarse_fired, summary_overall$n_queries,
+      summary_overall$percode_rate, summary_overall$percode_fired, summary_overall$n_queries,
+      summary_overall$delta_pp
+    ))
+  }
+
+  invisible(list(
+    corpus_url   = corpus_url,
+    years        = years,
+    span_note    = span$note,
+    full_design  = span$full_design,
+    govids       = govids,
+    seed         = seed,
+    n_categories = nrow(categories),
+    detail       = detail,
+    by_category  = by_category,
+    summary      = summary_overall
+  ))
+}
+
+if (identical(environment(), globalenv()) && sys.nframe() == 0L) {
+  res <- measure_signposting_rate()
+  cat("\n==== Query battery ====\n")
+  cat("Corpus:", res$corpus_url, "\n")
+  cat("Years:", paste(res$years, collapse = ", "), "\n")
+  cat("Full 3-year pre/post-2012 design achieved:", res$full_design, "\n")
+  cat(res$span_note, "\n")
+  cat("Governments sampled:", length(res$govids), "\n\n")
+
+  cat("==== Overall summary ====\n")
+  print(res$summary)
+
+  cat("\n==== By category (sorted by delta, descending) ====\n")
+  print(as.data.frame(res$by_category), row.names = FALSE)
+}